* lisp/emacs-lisp/avl-tree.el (avl-tree--del-balance): Rename from

avl-tree--del-balance1 and make it work both ways.
(avl-tree--del-balance2): Remove.
(avl-tree--enter-balance): Rename from avl-tree--enter-balance1 and
make it work both ways.
(avl-tree--enter-balance2): Remove.
(avl-tree--switch-dir, avl-tree--dir-to-sign, avl-tree--sign-to-dir):
New macros.
(avl-tree--mapc, avl-tree-map): Add direction argument.

2 files changed, 228 insertions, 220 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 64dd2af280a..2b6e0dc41f9 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,15 @@
+2009-11-23  Toby Cubitt  <toby-predictive@dr-qubit.org>
+
+        * emacs-lisp/avl-tree.el (avl-tree--del-balance): Rename from
+        avl-tree--del-balance1 and make it work both ways.
+        (avl-tree--del-balance2): Remove.
+        (avl-tree--enter-balance): Rename from avl-tree--enter-balance1 and
+        make it work both ways.
+        (avl-tree--enter-balance2): Remove.
+        (avl-tree--switch-dir, avl-tree--dir-to-sign, avl-tree--sign-to-dir):
+        New macros.
+        (avl-tree--mapc, avl-tree-map): Add direction argument.
+
 2011-05-27  David Michael  <fedora.dm0@gmail.com>
 
         * files.el (interpreter-mode-alist): Add rbash (bug#8745).
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el
index 0a637da0bc1..82585fd4322 100644
--- a/lisp/emacs-lisp/avl-tree.el
+++ b/lisp/emacs-lisp/avl-tree.el
@@ -3,11 +3,12 @@
 ;; Copyright (C) 1995, 2007-2011  Free Software Foundation, Inc.
 
 ;; Author: Per Cederqvist <ceder@lysator.liu.se>
-;;      Inge Wallin <inge@lysator.liu.se>
-;;      Thomas Bellman <bellman@lysator.liu.se>
+;;         Inge Wallin <inge@lysator.liu.se>
+;;         Thomas Bellman <bellman@lysator.liu.se>
+;;         Toby Cubitt <toby-predictive@dr-qubit.org>
 ;; Maintainer: FSF
 ;; Created: 10 May 1991
-;; Keywords: extensions, data structures
+;; Keywords: extensions, data structures, AVL, tree
 
 ;; This file is part of GNU Emacs.
 
@@ -26,14 +27,24 @@
 
 ;;; Commentary:
 
-;; An AVL tree is a nearly-perfect balanced binary tree.  A tree consists of
-;; two elements, the root node and the compare function.  The actual tree
-;; has a dummy node as its root with the real root in the left pointer.
+;; An AVL tree is a self-balancing binary tree. As such, inserting,
+;; deleting, and retrieving data from an AVL tree containing n elements
+;; is O(log n). It is somewhat more rigidly balanced than other
+;; self-balancing binary trees (such as red-black trees and AA trees),
+;; making insertion slighty slower, deletion somewhat slower, and
+;; retrieval somewhat faster (the asymptotic scaling is of course the
+;; same for all types). Thus it may be a good choice when the tree will
+;; be relatively static, i.e. data will be retrieved more often than
+;; they are modified.
+;;
+;; Internally, a tree consists of two elements, the root node and the
+;; comparison function. The actual tree has a dummy node as its root
+;; with the real root in the left pointer, which allows the root node to
+;; be treated on a par with all other nodes.
 ;;
 ;; Each node of the tree consists of one data element, one left
-;; sub-tree and one right sub-tree.  Each node also has a balance
-;; count, which is the difference in depth of the left and right
-;; sub-trees.
+;; sub-tree, one right sub-tree, and a balance count. The latter is the
+;; difference in depth of the left and right sub-trees.
 ;;
 ;; The functions with names of the form "avl-tree--" are intended for
 ;; internal use only.
@@ -42,43 +53,21 @@
 
 (eval-when-compile (require 'cl))
 
-;; ================================================================
-;;; Functions and macros handling an AVL tree node.
 
-(defstruct (avl-tree--node
-            ;; We force a representation without tag so it matches the
-            ;; pre-defstruct representation.  Also we use the underlying
-            ;; representation in the implementation of avl-tree--node-branch.
-            (:type vector)
-            (:constructor nil)
-            (:constructor avl-tree--node-create (left right data balance))
-            (:copier nil))
-  left right data balance)
 
-(defalias 'avl-tree--node-branch 'aref
-  ;; This implementation is efficient but breaks the defstruct abstraction.
-  ;; An alternative could be
-  ;; (funcall (aref [avl-tree-left avl-tree-right avl-tree-data] branch) node)
-  "Get value of a branch of a node.
+;; ================================================================
+;;; Internal functions and macros for use in the AVL tree package
 
-NODE is the node, and BRANCH is the branch.
-0 for left pointer, 1 for right pointer and 2 for the data.\"
-\(fn node branch)")
-;; The funcall/aref trick doesn't work for the setf method, unless we try
-;; and access the underlying setter function, but this wouldn't be
-;; portable either.
-(defsetf avl-tree--node-branch aset)
 
-
-;; ================================================================
-;;; Internal functions for use in the AVL tree package
+;; ----------------------------------------------------------------
+;; Functions and macros handling an AVL tree.
 
 (defstruct (avl-tree-
             ;; A tagged list is the pre-defstruct representation.
             ;; (:type list)
             :named
             (:constructor nil)
-            (:constructor avl-tree-create (cmpfun))
+            (:constructor avl-tree--create (cmpfun))
             (:predicate avl-tree-p)
             (:copier nil))
   (dummyroot (avl-tree--node-create nil nil nil 0))
@@ -86,112 +75,129 @@ NODE is the node, and BRANCH is the branch.
 
 (defmacro avl-tree--root (tree)
   ;; Return the root node for an avl-tree.  INTERNAL USE ONLY.
-  `(avl-tree--node-left (avl-tree--dummyroot tree)))
+  `(avl-tree--node-left (avl-tree--dummyroot ,tree)))
+
 (defsetf avl-tree--root (tree) (node)
   `(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node))
 
+
+
 ;; ----------------------------------------------------------------
-;;                          Deleting data
+;; Functions and macros handling an AVL tree node.
 
-(defun avl-tree--del-balance1 (node branch)
-  ;; Rebalance a tree and return t if the height of the tree has shrunk.
-  (let ((br (avl-tree--node-branch node branch))
-        p1 b1 p2 b2 result)
-    (cond
-     ((< (avl-tree--node-balance br) 0)
-      (setf (avl-tree--node-balance br) 0)
-      t)
+(defstruct (avl-tree--node
+            ;; We force a representation without tag so it matches the
+            ;; pre-defstruct representation. Also we use the underlying
+            ;; representation in the implementation of
+            ;; avl-tree--node-branch.
+            (:type vector)
+            (:constructor nil)
+            (:constructor avl-tree--node-create (left right data balance))
+            (:copier nil))
+  left right data balance)
 
-     ((= (avl-tree--node-balance br) 0)
-      (setf (avl-tree--node-balance br) +1)
-      nil)
 
-     (t
-      ;; Rebalance.
-      (setq p1 (avl-tree--node-right br)
-            b1 (avl-tree--node-balance p1))
-      (if (>= b1 0)
-          ;; Single RR rotation.
-          (progn
-            (setf (avl-tree--node-right br) (avl-tree--node-left p1))
-            (setf (avl-tree--node-left p1) br)
-            (if (= 0 b1)
-                (progn
-                  (setf (avl-tree--node-balance br) +1)
-                  (setf (avl-tree--node-balance p1) -1)
-                  (setq result nil))
-              (setf (avl-tree--node-balance br) 0)
-              (setf (avl-tree--node-balance p1) 0)
-              (setq result t))
-            (setf (avl-tree--node-branch node branch) p1)
-            result)
-
-        ;; Double RL rotation.
-        (setq p2 (avl-tree--node-left p1)
-              b2 (avl-tree--node-balance p2))
-        (setf (avl-tree--node-left p1) (avl-tree--node-right p2))
-        (setf (avl-tree--node-right p2) p1)
-        (setf (avl-tree--node-right br) (avl-tree--node-left p2))
-        (setf (avl-tree--node-left p2) br)
-        (setf (avl-tree--node-balance br) (if (> b2 0) -1 0))
-        (setf (avl-tree--node-balance p1) (if (< b2 0) +1 0))
-        (setf (avl-tree--node-branch node branch) p2)
-        (setf (avl-tree--node-balance p2) 0)
-        t)))))
+(defalias 'avl-tree--node-branch 'aref
+  ;; This implementation is efficient but breaks the defstruct
+  ;; abstraction.  An alternative could be (funcall (aref [avl-tree-left
+  ;; avl-tree-right avl-tree-data] branch) node)
+  "Get value of a branch of a node.
+NODE is the node, and BRANCH is the branch.
+0 for left pointer, 1 for right pointer and 2 for the data.")
+
+
+;; The funcall/aref trick wouldn't work for the setf method, unless we
+;; tried to access the underlying setter function, but this wouldn't be
+;; portable either.
+(defsetf avl-tree--node-branch aset)
+
+
+
+;; ----------------------------------------------------------------
+;; Convenience macros
 
-(defun avl-tree--del-balance2 (node branch)
+(defmacro avl-tree--switch-dir (dir)
+  "Return opposite direction to DIR (0 = left, 1 = right)."
+  `(- 1 ,dir))
+
+(defmacro avl-tree--dir-to-sign (dir)
+  "Convert direction (0,1) to sign factor (-1,+1)."
+  `(1- (* 2 ,dir)))
+
+(defmacro avl-tree--sign-to-dir (dir)
+  "Convert sign factor (-x,+x) to direction (0,1)."
+  `(if (< ,dir 0) 0 1))
+
+
+;; ----------------------------------------------------------------
+;;                          Deleting data
+
+(defun avl-tree--del-balance (node branch dir)
+  "Rebalance a tree after deleting a node.
+The deletion was done from the left (DIR=0) or right (DIR=1) sub-tree of the
+left (BRANCH=0) or right (BRANCH=1) child of NODE.
+Return t if the height of the tree has shrunk."
+  ;; (or is it vice-versa for BRANCH?)
   (let ((br (avl-tree--node-branch node branch))
-        p1 b1 p2 b2 result)
+        ;; opposite direction: 0,1 -> 1,0
+        (opp (avl-tree--switch-dir dir))
+        ;; direction 0,1 -> sign factor -1,+1
+        (sgn (avl-tree--dir-to-sign dir))
+        p1 b1 p2 b2)
     (cond
-     ((> (avl-tree--node-balance br) 0)
+     ((> (* sgn (avl-tree--node-balance br)) 0)
       (setf (avl-tree--node-balance br) 0)
       t)
 
      ((= (avl-tree--node-balance br) 0)
-      (setf (avl-tree--node-balance br) -1)
+      (setf (avl-tree--node-balance br) (- sgn))
       nil)
 
      (t
       ;; Rebalance.
-      (setq p1 (avl-tree--node-left br)
+      (setq p1 (avl-tree--node-branch br opp)
             b1 (avl-tree--node-balance p1))
-      (if (<= b1 0)
-          ;; Single LL rotation.
+      (if (<= (* sgn b1) 0)
+          ;; Single rotation.
           (progn
-            (setf (avl-tree--node-left br) (avl-tree--node-right p1))
-            (setf (avl-tree--node-right p1) br)
+            (setf (avl-tree--node-branch br opp)
+                    (avl-tree--node-branch p1 dir)
+                  (avl-tree--node-branch p1 dir) br
+                  (avl-tree--node-branch node branch) p1)
             (if (= 0 b1)
                 (progn
-                  (setf (avl-tree--node-balance br) -1)
-                  (setf (avl-tree--node-balance p1) +1)
-                  (setq result nil))
+                  (setf (avl-tree--node-balance br) (- sgn)
+                        (avl-tree--node-balance p1) sgn)
+                  nil)  ; height hasn't changed
               (setf (avl-tree--node-balance br) 0)
               (setf (avl-tree--node-balance p1) 0)
-              (setq result t))
-            (setf (avl-tree--node-branch node branch) p1)
-            result)
-
-        ;; Double LR rotation.
-        (setq p2 (avl-tree--node-right p1)
-              b2 (avl-tree--node-balance p2))
-        (setf (avl-tree--node-right p1) (avl-tree--node-left p2))
-        (setf (avl-tree--node-left p2) p1)
-        (setf (avl-tree--node-left br) (avl-tree--node-right p2))
-        (setf (avl-tree--node-right p2) br)
-        (setf (avl-tree--node-balance br) (if (< b2 0) +1 0))
-        (setf (avl-tree--node-balance p1) (if (> b2 0) -1 0))
-        (setf (avl-tree--node-branch node branch) p2)
-        (setf (avl-tree--node-balance p2) 0)
+              t))  ; height has changed
+
+        ;; Double rotation.
+        (setf p2 (avl-tree--node-branch p1 dir)
+              b2 (avl-tree--node-balance p2)
+              (avl-tree--node-branch p1 dir)
+                (avl-tree--node-branch p2 opp)
+              (avl-tree--node-branch p2 opp) p1
+              (avl-tree--node-branch br opp)
+                (avl-tree--node-branch p2 dir)
+              (avl-tree--node-branch p2 dir) br
+              (avl-tree--node-balance br)
+                (if (< (* sgn b2) 0) sgn 0)
+              (avl-tree--node-balance p1)
+                (if (> (* sgn b2) 0) (- sgn) 0)
+              (avl-tree--node-branch node branch) p2
+              (avl-tree--node-balance p2) 0)
         t)))))
 
 (defun avl-tree--do-del-internal (node branch q)
   (let ((br (avl-tree--node-branch node branch)))
     (if (avl-tree--node-right br)
-        (if (avl-tree--do-del-internal br +1 q)
-            (avl-tree--del-balance2 node branch))
-      (setf (avl-tree--node-data q) (avl-tree--node-data br))
-      (setf (avl-tree--node-branch node branch)
-            (avl-tree--node-left br))
+        (if (avl-tree--do-del-internal br 1 q)
+            (avl-tree--del-balance node branch 1))
+      (setf (avl-tree--node-data q) (avl-tree--node-data br)
+            (avl-tree--node-branch node branch)
+              (avl-tree--node-left br))
       t)))
 
 (defun avl-tree--do-delete (cmpfun root branch data)
@@ -203,102 +209,79 @@ NODE is the node, and BRANCH is the branch.
 
      ((funcall cmpfun data (avl-tree--node-data br))
       (if (avl-tree--do-delete cmpfun br 0 data)
-          (avl-tree--del-balance1 root branch)))
+          (avl-tree--del-balance root branch 0)))
 
      ((funcall cmpfun (avl-tree--node-data br) data)
       (if (avl-tree--do-delete cmpfun br 1 data)
-          (avl-tree--del-balance2 root branch)))
+          (avl-tree--del-balance root branch 1)))
 
      (t
       ;; Found it.  Let's delete it.
       (cond
        ((null (avl-tree--node-right br))
-        (setf (avl-tree--node-branch root branch) (avl-tree--node-left br))
-        t)
+        (setf (avl-tree--node-branch root branch) (avl-tree--node-left br))
+        t)
 
        ((null (avl-tree--node-left br))
-        (setf (avl-tree--node-branch root branch) (avl-tree--node-right br))
-        t)
+        (setf (avl-tree--node-branch root branch)
+              (avl-tree--node-right br))
+        t)
 
        (t
-        (if (avl-tree--do-del-internal br 0 br)
-            (avl-tree--del-balance1 root branch))))))))
+        (if (avl-tree--do-del-internal br 0 br)
+            (avl-tree--del-balance root branch 0))))))))
 
 ;; ----------------------------------------------------------------
 ;;                           Entering data
 
-(defun avl-tree--enter-balance1 (node branch)
-  ;; Rebalance a tree and return t if the height of the tree has grown.
+(defun avl-tree--enter-balance (node branch dir)
+  "Rebalance tree after an insertion
+into the left (DIR=0) or right (DIR=1) sub-tree of the
+left (BRANCH=0) or right (BRANCH=1) child of NODE.
+Return t if the height of the tree has grown."
   (let ((br (avl-tree--node-branch node branch))
+        ;; opposite direction: 0,1 -> 1,0
+        (opp (avl-tree--switch-dir dir))
+        ;; direction 0,1 -> sign factor -1,+1
+        (sgn (avl-tree--dir-to-sign dir))
         p1 p2 b2 result)
     (cond
-     ((< (avl-tree--node-balance br) 0)
+     ((< (* sgn (avl-tree--node-balance br)) 0)
       (setf (avl-tree--node-balance br) 0)
       nil)
 
      ((= (avl-tree--node-balance br) 0)
-      (setf (avl-tree--node-balance br) +1)
+      (setf (avl-tree--node-balance br) sgn)
       t)
 
      (t
       ;; Tree has grown => Rebalance.
-      (setq p1 (avl-tree--node-right br))
-      (if (> (avl-tree--node-balance p1) 0)
-          ;; Single RR rotation.
+      (setq p1 (avl-tree--node-branch br dir))
+      (if (> (* sgn (avl-tree--node-balance p1)) 0)
+          ;; Single rotation.
           (progn
-            (setf (avl-tree--node-right br) (avl-tree--node-left p1))
-            (setf (avl-tree--node-left p1) br)
+            (setf (avl-tree--node-branch br dir)
+                  (avl-tree--node-branch p1 opp))
+            (setf (avl-tree--node-branch p1 opp) br)
             (setf (avl-tree--node-balance br) 0)
             (setf (avl-tree--node-branch node branch) p1))
 
-        ;; Double RL rotation.
-        (setq p2 (avl-tree--node-left p1)
-              b2 (avl-tree--node-balance p2))
-        (setf (avl-tree--node-left p1) (avl-tree--node-right p2))
-        (setf (avl-tree--node-right p2) p1)
-        (setf (avl-tree--node-right br) (avl-tree--node-left p2))
-        (setf (avl-tree--node-left p2) br)
-        (setf (avl-tree--node-balance br) (if (> b2 0) -1 0))
-        (setf (avl-tree--node-balance p1) (if (< b2 0) +1 0))
-        (setf (avl-tree--node-branch node branch) p2))
-      (setf (avl-tree--node-balance (avl-tree--node-branch node branch)) 0)
-      nil))))
-
-(defun avl-tree--enter-balance2 (node branch)
-  ;; Return t if the tree has grown.
-  (let ((br (avl-tree--node-branch node branch))
-        p1 p2 b2)
-    (cond
-     ((> (avl-tree--node-balance br) 0)
-      (setf (avl-tree--node-balance br) 0)
-      nil)
-
-     ((= (avl-tree--node-balance br) 0)
-      (setf (avl-tree--node-balance br) -1)
-      t)
-
-     (t
-      ;; Balance was -1 => Rebalance.
-      (setq p1 (avl-tree--node-left br))
-      (if (< (avl-tree--node-balance p1) 0)
-          ;; Single LL rotation.
-          (progn
-            (setf (avl-tree--node-left br) (avl-tree--node-right p1))
-            (setf (avl-tree--node-right p1) br)
-            (setf (avl-tree--node-balance br) 0)
-            (setf (avl-tree--node-branch node branch) p1))
-
-        ;; Double LR rotation.
-        (setq p2 (avl-tree--node-right p1)
-              b2 (avl-tree--node-balance p2))
-        (setf (avl-tree--node-right p1) (avl-tree--node-left p2))
-        (setf (avl-tree--node-left p2) p1)
-        (setf (avl-tree--node-left br) (avl-tree--node-right p2))
-        (setf (avl-tree--node-right p2) br)
-        (setf (avl-tree--node-balance br) (if (< b2 0) +1 0))
-        (setf (avl-tree--node-balance p1) (if (> b2 0) -1 0))
-        (setf (avl-tree--node-branch node branch) p2))
-      (setf (avl-tree--node-balance (avl-tree--node-branch node branch)) 0)
+        ;; Double rotation.
+        (setf p2 (avl-tree--node-branch p1 opp)
+              b2 (avl-tree--node-balance p2)
+              (avl-tree--node-branch p1 opp)
+                (avl-tree--node-branch p2 dir)
+              (avl-tree--node-branch p2 dir) p1
+              (avl-tree--node-branch br dir)
+                (avl-tree--node-branch p2 opp)
+              (avl-tree--node-branch p2 opp) br
+              (avl-tree--node-balance br)
+                (if (> (* sgn b2) 0) (- sgn) 0)
+              (avl-tree--node-balance p1)
+                (if (< (* sgn b2) 0) sgn 0)
+              (avl-tree--node-branch node branch) p2
+              (avl-tree--node-balance
+               (avl-tree--node-branch node branch)) 0))
       nil))))
 
 (defun avl-tree--do-enter (cmpfun root branch data)
@@ -313,11 +296,11 @@ NODE is the node, and BRANCH is the branch.
 
      ((funcall cmpfun data (avl-tree--node-data br))
       (and (avl-tree--do-enter cmpfun br 0 data)
-           (avl-tree--enter-balance2 root branch)))
+           (avl-tree--enter-balance root branch 0)))
 
      ((funcall cmpfun (avl-tree--node-data br) data)
       (and (avl-tree--do-enter cmpfun br 1 data)
-           (avl-tree--enter-balance1 root branch)))
+           (avl-tree--enter-balance root branch 1)))
 
      (t
       (setf (avl-tree--node-data br) data)
@@ -325,33 +308,38 @@ NODE is the node, and BRANCH is the branch.
 
 ;; ----------------------------------------------------------------
 
-(defun avl-tree--mapc (map-function root)
-  ;; Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
-  ;; The function is applied in-order.
-  ;;
-  ;; Note: MAP-FUNCTION is applied to the node and not to the data itself.
-  ;; INTERNAL USE ONLY.
+
+;;; INTERNAL USE ONLY
+(defun avl-tree--mapc (map-function root dir)
+  "Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
+The function is applied in-order, either ascending (DIR=0) or
+descending (DIR=1).
+
+Note: MAP-FUNCTION is applied to the node and not to the data
+itself."
   (let ((node root)
         (stack nil)
-        (go-left t))
+        (go-dir t))
     (push nil stack)
     (while node
-      (if (and go-left
-               (avl-tree--node-left node))
-          ;; Do the left subtree first.
+      (if (and go-dir
+               (avl-tree--node-branch node dir))
+          ;; Do the DIR subtree first.
           (progn
             (push node stack)
-            (setq node (avl-tree--node-left node)))
+            (setq node (avl-tree--node-branch node dir)))
         ;; Apply the function...
         (funcall map-function node)
-        ;; and do the right subtree.
-        (setq node (if (setq go-left (avl-tree--node-right node))
-                       (avl-tree--node-right node)
+        ;; and do the opposite subtree.
+        (setq node (if (setq go-dir (avl-tree--node-branch
+                                     node (avl-tree--switch-dir dir)))
+                       (avl-tree--node-branch
+                        node (avl-tree--switch-dir dir))
                      (pop stack)))))))
 
+;;; INTERNAL USE ONLY
 (defun avl-tree--do-copy (root)
-  ;; Copy the avl tree with ROOT as root.
-  ;; Highly recursive. INTERNAL USE ONLY.
+  "Copy the avl tree with ROOT as root. Highly recursive."
   (if (null root)
       nil
     (avl-tree--node-create
@@ -360,10 +348,16 @@ NODE is the node, and BRANCH is the branch.
      (avl-tree--node-data root)
      (avl-tree--node-balance root))))
 
-
+
 ;; ================================================================
 ;;; The public functions which operate on AVL trees.
 
+;; define public alias for constructors so that we can set docstring
+(defalias 'avl-tree-create 'avl-tree--create
+  "Create an empty avl tree.
+COMPARE-FUNCTION is a function which takes two arguments, A and B,
+and returns non-nil if A is less than B, and nil otherwise.")
+
 (defalias 'avl-tree-compare-function 'avl-tree--cmpfun
   "Return the comparison function for the avl tree TREE.
 
@@ -377,9 +371,9 @@ NODE is the node, and BRANCH is the branch.
   "In the avl tree TREE insert DATA.
 Return DATA."
   (avl-tree--do-enter (avl-tree--cmpfun tree)
-                      (avl-tree--dummyroot tree)
-                      0
-                      data)
+                      (avl-tree--dummyroot tree)
+                      0
+                      data)
   data)
 
 (defun avl-tree-delete (tree data)
@@ -398,28 +392,31 @@ Matching uses the compare function previously specified in
 
 If there is no such element in the tree, the value is nil."
   (let ((node (avl-tree--root tree))
-        (compare-function (avl-tree--cmpfun tree))
-        found)
-    (while (and node
-                (not found))
-      (cond
-       ((funcall compare-function data (avl-tree--node-data node))
-        (setq node (avl-tree--node-left node)))
-       ((funcall compare-function (avl-tree--node-data node) data)
-        (setq node (avl-tree--node-right node)))
-       (t
-        (setq found t))))
-    (if node
-        (avl-tree--node-data node)
+        (compare-function (avl-tree--cmpfun tree)))
+    (catch 'found
+      (while node
+        (cond
+         ((funcall compare-function data (avl-tree--node-data node))
+          (setq node (avl-tree--node-left node)))
+         ((funcall compare-function (avl-tree--node-data node) data)
+          (setq node (avl-tree--node-right node)))
+         (t (throw 'found (avl-tree--node-data node)))))
       nil)))
 
-(defun avl-tree-map (__map-function__ tree)
-  "Apply __MAP-FUNCTION__ to all elements in the avl tree TREE."
+(defun avl-tree-map (__map-function__ tree &optional reverse)
+  "Modify all elements in the avl tree TREE by applying FUNCTION.
+
+Each element is replaced by the return value of FUNCTION applied
+to that element.
+
+FUNCTION is applied to the elements in ascending order, or
+descending order if REVERSE is non-nil."
   (avl-tree--mapc
    (lambda (node)
      (setf (avl-tree--node-data node)
            (funcall __map-function__ (avl-tree--node-data node))))
-   (avl-tree--root tree)))
+   (avl-tree--root tree)
+   (if reverse 1 0)))
 
 (defun avl-tree-first (tree)
   "Return the first element in TREE, or nil if TREE is empty."
@@ -445,19 +442,18 @@ If there is no such element in the tree, the value is nil."
 
 (defun avl-tree-flatten (tree)
   "Return a sorted list containing all elements of TREE."
-  (nreverse
    (let ((treelist nil))
      (avl-tree--mapc
       (lambda (node) (push (avl-tree--node-data node) treelist))
-      (avl-tree--root tree))
-     treelist)))
+      (avl-tree--root tree) 1)
+     treelist))
 
 (defun avl-tree-size (tree)
   "Return the number of elements in TREE."
   (let ((treesize 0))
     (avl-tree--mapc
      (lambda (data) (setq treesize (1+ treesize)))
-     (avl-tree--root tree))
+     (avl-tree--root tree) 0)
     treesize))
 
 (defun avl-tree-clear (tree)