                 (delay (push-back m-forced (apply make-node-3 (tser r)))))
             [(last r) a])))
 
+(defn nodes [a b & r]
+    (case (count r)
+        0 [(node-2. a b)]
+        1 [(node-3. a b (first r))]
+        2 [(node-2. a b) (apply make-node-2 r)]
+        (cons (node-3. a b (first r)) (apply nodes (rest r)))))
+
+(defmulti app3 (fn [l m r] [(class l) (class r)]))
+(defmethod app3 [finger-tree-empty ::any] [l m r]
+    (if (empty? m)
+        r
+        (app3
+            l
+            (tser m)
+            (push-front r (last m)))))
+(defmethod app3 [::any finger-tree-empty] [l m r]
+    (if (empty? m)
+        l
+        (app3
+            (push-back l (first m))
+            (rest m)
+            r)))
+(defmethod app3 [finger-tree-single ::any] [l m r]
+    (push-front (app3 (finger-tree-empty.) m r) (:v l)))
+(defmethod app3 [::any finger-tree-single] [l m r]
+    (push-back (app3 l m (finger-tree-empty.)) (:v r)))
+(defmethod app3 [finger-tree-deep finger-tree-deep] [l m r]
+    (finger-tree-deep.
+        (:l l)
+        (app3
+            (force (:m l))
+            (apply nodes (concat (:r l) m (:l r)))
+            (force (:m r)))
+        (:r r)))
+
+(prefer-method app3 [finger-tree-empty ::any] [::any finger-tree-empty])
+(prefer-method app3 [finger-tree-single ::any] [::any finger-tree-single])
+(prefer-method app3 [finger-tree-empty ::any] [::any finger-tree-single])
+
+(defmulti concatenate (fn [a b] [(class a) (class b)]))
+(defmethod concatenate [::any finger-tree-empty] [a _] a)
+(defmethod concatenate [finger-tree-empty ::any] [_ b] b)
+(defmethod concatenate [::any finger-tree-single] [a b]
+    (push-back a (:v b)))
+(defmethod concatenate [finger-tree-single ::any] [a b]
+    (push-front (:v a) b))
+(defmethod concatenate [finger-tree-deep finger-tree-deep] [a b]
+    (finger-tree-deep.
+        (:l a)
+        (app3 (force (:m a)) (apply nodes (concat (:r a) (:l b))) (force (:m b)))
+        (:r b)))
 
 ; Functions to print finger-trees to graphviz
 (defn object-id [x] (System/identityHashCode x))

(defrecord finger-tree-single [v])
(defrecord finger-tree-deep [l m r])

(defn make-node-3 [a b c] (node-3. a b c))

; Reverse cons
(defn snoc [a lst] (concat lst [a]))

(defmethod print-entry node-2 [node parent-id]
    (do
        (println (object-id node) " [label=\"Node2\"]")
        (println parent-id " -> " (object-id node) " [weight=2]")
        (print-entry (:a node) (object-id node))
        (print-entry (:b node) (object-id node))))
(defmethod print-entry node-3 [node parent-id]
    (do
        (println (object-id node) " [label=\"Node3\"]")
        (println parent-id " -> " (object-id node) " [weight=2]")
        (print-entry (:a node) (object-id node))
        (print-entry (:b node) (object-id node))
        (print-entry (:c node) (object-id node))))
(defmethod print-entry :default [entry parent-id]
    (do
        (println (object-id entry) " [label=\"" entry "\"]")
        (when parent-id (println parent-id " -> " (object-id entry) " [weight=1]"))))

(defn print-digits [node parent-id]
    (do
        (println (object-id node) " [label=\"Digits\"]")
        (when parent-id (println parent-id " -> " (object-id node) " [weight=3]"))
        (dorun (map (fn [x] (print-entry x (object-id node))) node))))

(defmulti print-finger-tree (fn [node parent-id] (class node)))
(defmethod print-finger-tree finger-tree-empty [_ _] nil)
(defmethod print-finger-tree finger-tree-single [node parent-id]
    (do
        (println (object-id node) " [label=\"Single\"]")
        (when parent-id (println parent-id " -> " (object-id node) " [weight=4]"))
        (print-entry (:v node) (object-id node))))
(defmethod print-finger-tree finger-tree-deep [node parent-id]
    (do
        (println (object-id node) " [label=\"Deep\"]")
        (when parent-id (println parent-id " -> " (object-id node) " [weight=4]"))
        (print-digits (:l node) (object-id node))
        (print-finger-tree (force (:m node)) (object-id node))
        (print-digits (:r node) (object-id node))))
