     (make-finger-tree-deep
         (:monoid a)
         (:l a)
-        (app3 (force (:m a)) (apply nodes (:monoid a) (concat (:r a) (:l b))) (force (:m b)))
+        (force-early (delay (app3 (force (:m a)) (apply nodes (:monoid a) (concat (:r a) (:l b))) (force (:m b)))))
         (:r b)))
+
+(defmulti to-list (fn [tree] (class tree)))
+(defmethod to-list node-2 [{a :a b :b}] [a b])
+(defmethod to-list node-3 [{a :a b :b c :c}] [a b c])
+
+(defn split-digit [p i [a & as] ems cfn]
+    (if (nil? as)
+        [[] a []]
+        (let [ip (cfn i (ems a))]
+            (if (p ip)
+                [[] a as]
+                (let [[l x r] (split-digit p ip as ems cfn)]
+                    [(cons a l) x r])))))
 
 (defmulti split-tree (fn [tree p i] (class tree)))
 (defmethod split-tree finger-tree-single [{e :e m :monoid} _ _]

(defmethod split-tree finger-tree-deep [{monoid :monoid l :l m :m r :r} p i]
    (let [cfn (:combine-fn monoid)
            ems (fn [v] (extract-measure v monoid))
            vl (cfn i (ems l))
            vm (cfn vl (ems m))]
        (if (p vl)
            (let [[a b c] (split-digit p i l)]
                [(to-tree a) b (make-finger-tree-deep monoid c m r)])
            (if (p vm)
                (let [[ma mb mc] (split-tree p vl m)
                        [a b c] (split-digit p (cfn vl (ems ma)) (to-list mb))]
                    [(make-finger-tree-deep monoid l ma a) b (make-finger-tree-deep c mc)])
                (let [[a b c] (split-digit p vm r)]
                    [(make-finger-tree-deep monoid l m a) b (to-tree c)])))))

; Functions to print finger-trees to graphviz
(defn object-id [x] (System/identityHashCode x))

(def count-monoid
    (monoid. (fn [_] 1) +))

(defn go [t vec func]
    (do
        (println t "\n")
        (if (empty? vec)
            t
            (go (func t (first vec)) (rest vec) func))))

(println "Forwards..")
(def t1 (go (make-finger-tree-empty count-monoid) (range 0 20) push-front))
(print-finger-tree-to-file t1 "/tmp/forwards.dot")

(println "Splitting")

(defn split-test [tree idx]
    (let [[l x r] (split-tree tree (fn [i] (< idx i)) 0)]
        (do
            (print-finger-tree-to-file l (str "/tmp/forwards-t1-" (print-str idx) "-l.dot"))
            (print-finger-tree-to-file r (str "/tmp/forwards-t1-" (print-str idx) "-r.dot"))
            x)))

(doall (map (fn [x] (split-test t1 x)) (range -3 23)))

(println "Backwards..")
(def t2 (go (make-finger-tree-empty count-monoid) (range 20 40) push-back))
(print-finger-tree-to-file t2 "/tmp/backwards.dot")

(print-finger-tree-to-file
    (concatenate t1 t2)
    "/tmp/concat1.dot")

(print-finger-tree-to-file
    (concatenate t2 t1)
    "/tmp/concat2.dot")
