mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-29 11:02:01 +00:00
Code Issues Releases Activity

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

Browse Source 
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.
This commit is contained in:
Toby Cubitt 2011-05-27 16:58:19 -03:00 committed by Stefan Monnier
parent 18480f8fc0
commit 3769ddcf1e
2 changed files with 230 additions and 222 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
lisp/ChangeLog
View File

@ -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> 2011-05-27 David Michael <fedora.dm0@gmail.com>
* files.el (interpreter-mode-alist): Add rbash (bug#8745). * files.el (interpreter-mode-alist): Add rbash (bug#8745).

440
lisp/emacs-lisp/avl-tree.el
View File

@ -3,11 +3,12 @@
;; Copyright (C) 1995, 2007-2011 Free Software Foundation, Inc. ;; Copyright (C) 1995, 2007-2011 Free Software Foundation, Inc.
;; Author: Per Cederqvist <ceder@lysator.liu.se> ;; Author: Per Cederqvist <ceder@lysator.liu.se>
;; Inge Wallin <inge@lysator.liu.se> ;; Inge Wallin <inge@lysator.liu.se>
;; Thomas Bellman <bellman@lysator.liu.se> ;; Thomas Bellman <bellman@lysator.liu.se>
;; Toby Cubitt <toby-predictive@dr-qubit.org>
;; Maintainer: FSF ;; Maintainer: FSF
;; Created: 10 May 1991 ;; Created: 10 May 1991
;; Keywords: extensions, data structures ;; Keywords: extensions, data structures, AVL, tree
;; This file is part of GNU Emacs. ;; This file is part of GNU Emacs.
@ -26,14 +27,24 @@
;;; Commentary: ;;; Commentary:
;; An AVL tree is a nearly-perfect balanced binary tree. A tree consists of ;; An AVL tree is a self-balancing binary tree. As such, inserting,
;; two elements, the root node and the compare function. The actual tree ;; deleting, and retrieving data from an AVL tree containing n elements
;; has a dummy node as its root with the real root in the left pointer. ;; 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 ;; 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 ;; sub-tree, one right sub-tree, and a balance count. The latter is the
;; count, which is the difference in depth of the left and right ;; difference in depth of the left and right sub-trees.
;; sub-trees.
;; ;;
;; The functions with names of the form "avl-tree--" are intended for ;; The functions with names of the form "avl-tree--" are intended for
;; internal use only. ;; internal use only.
@ -42,43 +53,21 @@
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl))
;; ================================================================ ;; ================================================================
;;; Functions and macros handling an AVL tree node. ;;; Internal functions and macros for use in the AVL tree package
(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. ;; Functions and macros handling an AVL tree.
;; 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.\"
\(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
(defstruct (avl-tree- (defstruct (avl-tree-
;; A tagged list is the pre-defstruct representation. ;; A tagged list is the pre-defstruct representation.
;; (:type list) ;; (:type list)
:named :named
(:constructor nil) (:constructor nil)
(:constructor avl-tree-create (cmpfun)) (:constructor avl-tree--create (cmpfun))
(:predicate avl-tree-p) (:predicate avl-tree-p)
(:copier nil)) (:copier nil))
(dummyroot (avl-tree--node-create nil nil nil 0)) (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) (defmacro avl-tree--root (tree)
;; Return the root node for an avl-tree. INTERNAL USE ONLY. ;; 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) (defsetf avl-tree--root (tree) (node)
`(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node)) `(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node))
;; ----------------------------------------------------------------
;; 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.
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
(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 ;; Deleting data
(defun avl-tree--del-balance1 (node branch) (defun avl-tree--del-balance (node branch dir)
;; Rebalance a tree and return t if the height of the tree has shrunk. "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)) (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 (cond
((< (avl-tree--node-balance br) 0) ((> (* sgn (avl-tree--node-balance br)) 0)
(setf (avl-tree--node-balance br) 0) (setf (avl-tree--node-balance br) 0)
t) t)
((= (avl-tree--node-balance br) 0) ((= (avl-tree--node-balance br) 0)
(setf (avl-tree--node-balance br) +1) (setf (avl-tree--node-balance br) (- sgn))
nil) nil)
(t (t
;; Rebalance. ;; Rebalance.
(setq p1 (avl-tree--node-right br) (setq p1 (avl-tree--node-branch br opp)
b1 (avl-tree--node-balance p1)) b1 (avl-tree--node-balance p1))
(if (>= b1 0) (if (<= (* sgn b1) 0)
;; Single RR rotation. ;; Single rotation.
(progn (progn
(setf (avl-tree--node-right br) (avl-tree--node-left p1)) (setf (avl-tree--node-branch br opp)
(setf (avl-tree--node-left p1) br) (avl-tree--node-branch p1 dir)
(avl-tree--node-branch p1 dir) br
(avl-tree--node-branch node branch) p1)
(if (= 0 b1) (if (= 0 b1)
(progn (progn
(setf (avl-tree--node-balance br) +1) (setf (avl-tree--node-balance br) (- sgn)
(setf (avl-tree--node-balance p1) -1) (avl-tree--node-balance p1) sgn)
(setq result nil)) nil) ; height hasn't changed
(setf (avl-tree--node-balance br) 0) (setf (avl-tree--node-balance br) 0)
(setf (avl-tree--node-balance p1) 0) (setf (avl-tree--node-balance p1) 0)
(setq result t)) t)) ; height has changed
(setf (avl-tree--node-branch node branch) p1)
result)
;; Double RL rotation. ;; Double rotation.
(setq p2 (avl-tree--node-left p1) (setf p2 (avl-tree--node-branch p1 dir)
b2 (avl-tree--node-balance p2)) b2 (avl-tree--node-balance p2)
(setf (avl-tree--node-left p1) (avl-tree--node-right p2)) (avl-tree--node-branch p1 dir)
(setf (avl-tree--node-right p2) p1) (avl-tree--node-branch p2 opp)
(setf (avl-tree--node-right br) (avl-tree--node-left p2)) (avl-tree--node-branch p2 opp) p1
(setf (avl-tree--node-left p2) br) (avl-tree--node-branch br opp)
(setf (avl-tree--node-balance br) (if (> b2 0) -1 0)) (avl-tree--node-branch p2 dir)
(setf (avl-tree--node-balance p1) (if (< b2 0) +1 0)) (avl-tree--node-branch p2 dir) br
(setf (avl-tree--node-branch node branch) p2) (avl-tree--node-balance br)
(setf (avl-tree--node-balance p2) 0) (if (< (* sgn b2) 0) sgn 0)
t))))) (avl-tree--node-balance p1)
(if (> (* sgn b2) 0) (- sgn) 0)
(defun avl-tree--del-balance2 (node branch) (avl-tree--node-branch node branch) p2
(let ((br (avl-tree--node-branch node branch)) (avl-tree--node-balance p2) 0)
p1 b1 p2 b2 result)
(cond
((> (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)
nil)
(t
;; Rebalance.
(setq p1 (avl-tree--node-left br)
b1 (avl-tree--node-balance p1))
(if (<= b1 0)
;; Single LL rotation.
(progn
(setf (avl-tree--node-left br) (avl-tree--node-right p1))
(setf (avl-tree--node-right 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 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))))) t)))))
(defun avl-tree--do-del-internal (node branch q) (defun avl-tree--do-del-internal (node branch q)
(let ((br (avl-tree--node-branch node branch))) (let ((br (avl-tree--node-branch node branch)))
(if (avl-tree--node-right br) (if (avl-tree--node-right br)
(if (avl-tree--do-del-internal br +1 q) (if (avl-tree--do-del-internal br 1 q)
(avl-tree--del-balance2 node branch)) (avl-tree--del-balance node branch 1))
(setf (avl-tree--node-data q) (avl-tree--node-data br)) (setf (avl-tree--node-data q) (avl-tree--node-data br)
(setf (avl-tree--node-branch node branch) (avl-tree--node-branch node branch)
(avl-tree--node-left br)) (avl-tree--node-left br))
t))) t)))
(defun avl-tree--do-delete (cmpfun root branch data) (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)) ((funcall cmpfun data (avl-tree--node-data br))
(if (avl-tree--do-delete cmpfun br 0 data) (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) ((funcall cmpfun (avl-tree--node-data br) data)
(if (avl-tree--do-delete cmpfun br 1 data) (if (avl-tree--do-delete cmpfun br 1 data)
(avl-tree--del-balance2 root branch))) (avl-tree--del-balance root branch 1)))
(t (t
;; Found it. Let's delete it. ;; Found it. Let's delete it.
(cond (cond
((null (avl-tree--node-right br)) ((null (avl-tree--node-right br))
(setf (avl-tree--node-branch root branch) (avl-tree--node-left br)) (setf (avl-tree--node-branch root branch) (avl-tree--node-left br))
t) t)
((null (avl-tree--node-left br)) ((null (avl-tree--node-left br))
(setf (avl-tree--node-branch root branch) (avl-tree--node-right br)) (setf (avl-tree--node-branch root branch)
t) (avl-tree--node-right br))
t)
(t (t
(if (avl-tree--do-del-internal br 0 br) (if (avl-tree--do-del-internal br 0 br)
(avl-tree--del-balance1 root branch)))))))) (avl-tree--del-balance root branch 0))))))))
;; ---------------------------------------------------------------- ;; ----------------------------------------------------------------
;; Entering data ;; Entering data
(defun avl-tree--enter-balance1 (node branch) (defun avl-tree--enter-balance (node branch dir)
;; Rebalance a tree and return t if the height of the tree has grown. "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)) (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) p1 p2 b2 result)
(cond (cond
((< (avl-tree--node-balance br) 0) ((< (* sgn (avl-tree--node-balance br)) 0)
(setf (avl-tree--node-balance br) 0) (setf (avl-tree--node-balance br) 0)
nil) nil)
((= (avl-tree--node-balance br) 0) ((= (avl-tree--node-balance br) 0)
(setf (avl-tree--node-balance br) +1) (setf (avl-tree--node-balance br) sgn)
t) t)
(t (t
;; Tree has grown => Rebalance. ;; Tree has grown => Rebalance.
(setq p1 (avl-tree--node-right br)) (setq p1 (avl-tree--node-branch br dir))
(if (> (avl-tree--node-balance p1) 0) (if (> (* sgn (avl-tree--node-balance p1)) 0)
;; Single RR rotation. ;; Single rotation.
(progn (progn
(setf (avl-tree--node-right br) (avl-tree--node-left p1)) (setf (avl-tree--node-branch br dir)
(setf (avl-tree--node-left p1) br) (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-balance br) 0)
(setf (avl-tree--node-branch node branch) p1)) (setf (avl-tree--node-branch node branch) p1))
;; Double RL rotation. ;; Double rotation.
(setq p2 (avl-tree--node-left p1) (setf p2 (avl-tree--node-branch p1 opp)
b2 (avl-tree--node-balance p2)) b2 (avl-tree--node-balance p2)
(setf (avl-tree--node-left p1) (avl-tree--node-right p2)) (avl-tree--node-branch p1 opp)
(setf (avl-tree--node-right p2) p1) (avl-tree--node-branch p2 dir)
(setf (avl-tree--node-right br) (avl-tree--node-left p2)) (avl-tree--node-branch p2 dir) p1
(setf (avl-tree--node-left p2) br) (avl-tree--node-branch br dir)
(setf (avl-tree--node-balance br) (if (> b2 0) -1 0)) (avl-tree--node-branch p2 opp)
(setf (avl-tree--node-balance p1) (if (< b2 0) +1 0)) (avl-tree--node-branch p2 opp) br
(setf (avl-tree--node-branch node branch) p2)) (avl-tree--node-balance br)
(setf (avl-tree--node-balance (avl-tree--node-branch node branch)) 0) (if (> (* sgn b2) 0) (- sgn) 0)
nil)))) (avl-tree--node-balance p1)
(if (< (* sgn b2) 0) sgn 0)
(defun avl-tree--enter-balance2 (node branch) (avl-tree--node-branch node branch) p2
;; Return t if the tree has grown. (avl-tree--node-balance
(let ((br (avl-tree--node-branch node branch)) (avl-tree--node-branch node branch)) 0))
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)
nil)))) nil))))
(defun avl-tree--do-enter (cmpfun root branch data) (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)) ((funcall cmpfun data (avl-tree--node-data br))
(and (avl-tree--do-enter cmpfun br 0 data) (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) ((funcall cmpfun (avl-tree--node-data br) data)
(and (avl-tree--do-enter cmpfun br 1 data) (and (avl-tree--do-enter cmpfun br 1 data)
(avl-tree--enter-balance1 root branch))) (avl-tree--enter-balance root branch 1)))
(t (t
(setf (avl-tree--node-data br) data) (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. ;;; INTERNAL USE ONLY
;; The function is applied in-order. (defun avl-tree--mapc (map-function root dir)
;; "Apply MAP-FUNCTION to all nodes in the tree starting with ROOT.
;; Note: MAP-FUNCTION is applied to the node and not to the data itself. The function is applied in-order, either ascending (DIR=0) or
;; INTERNAL USE ONLY. descending (DIR=1).
Note: MAP-FUNCTION is applied to the node and not to the data
itself."
(let ((node root) (let ((node root)
(stack nil) (stack nil)
(go-left t)) (go-dir t))
(push nil stack) (push nil stack)
(while node (while node
(if (and go-left (if (and go-dir
(avl-tree--node-left node)) (avl-tree--node-branch node dir))
;; Do the left subtree first. ;; Do the DIR subtree first.
(progn (progn
(push node stack) (push node stack)
(setq node (avl-tree--node-left node))) (setq node (avl-tree--node-branch node dir)))
;; Apply the function... ;; Apply the function...
(funcall map-function node) (funcall map-function node)
;; and do the right subtree. ;; and do the opposite subtree.
(setq node (if (setq go-left (avl-tree--node-right node)) (setq node (if (setq go-dir (avl-tree--node-branch
(avl-tree--node-right node) node (avl-tree--switch-dir dir)))
(avl-tree--node-branch
node (avl-tree--switch-dir dir))
(pop stack))))))) (pop stack)))))))
;;; INTERNAL USE ONLY
(defun avl-tree--do-copy (root) (defun avl-tree--do-copy (root)
;; Copy the avl tree with ROOT as root. "Copy the avl tree with ROOT as root. Highly recursive."
;; Highly recursive. INTERNAL USE ONLY.
(if (null root) (if (null root)
nil nil
(avl-tree--node-create (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-data root)
(avl-tree--node-balance root)))) (avl-tree--node-balance root))))
;; ================================================================ ;; ================================================================
;;; The public functions which operate on AVL trees. ;;; 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 (defalias 'avl-tree-compare-function 'avl-tree--cmpfun
"Return the comparison function for the avl tree TREE. "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. "In the avl tree TREE insert DATA.
Return DATA." Return DATA."
(avl-tree--do-enter (avl-tree--cmpfun tree) (avl-tree--do-enter (avl-tree--cmpfun tree)
(avl-tree--dummyroot tree) (avl-tree--dummyroot tree)
0 0
data) data)
data) data)
(defun avl-tree-delete (tree 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." If there is no such element in the tree, the value is nil."
(let ((node (avl-tree--root tree)) (let ((node (avl-tree--root tree))
(compare-function (avl-tree--cmpfun tree)) (compare-function (avl-tree--cmpfun tree)))
found) (catch 'found
(while (and node (while node
(not found)) (cond
(cond ((funcall compare-function data (avl-tree--node-data node))
((funcall compare-function data (avl-tree--node-data node)) (setq node (avl-tree--node-left node)))
(setq node (avl-tree--node-left node))) ((funcall compare-function (avl-tree--node-data node) data)
((funcall compare-function (avl-tree--node-data node) data) (setq node (avl-tree--node-right node)))
(setq node (avl-tree--node-right node))) (t (throw 'found (avl-tree--node-data node)))))
(t
(setq found t))))
(if node
(avl-tree--node-data node)
nil))) nil)))
(defun avl-tree-map (__map-function__ tree) (defun avl-tree-map (__map-function__ tree &optional reverse)
"Apply __MAP-FUNCTION__ to all elements in the avl tree TREE." "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 (avl-tree--mapc
(lambda (node) (lambda (node)
(setf (avl-tree--node-data node) (setf (avl-tree--node-data node)
(funcall __map-function__ (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) (defun avl-tree-first (tree)
"Return the first element in TREE, or nil if TREE is empty." "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) (defun avl-tree-flatten (tree)
"Return a sorted list containing all elements of TREE." "Return a sorted list containing all elements of TREE."
(nreverse
(let ((treelist nil)) (let ((treelist nil))
(avl-tree--mapc (avl-tree--mapc
(lambda (node) (push (avl-tree--node-data node) treelist)) (lambda (node) (push (avl-tree--node-data node) treelist))
(avl-tree--root tree)) (avl-tree--root tree) 1)
treelist))) treelist))
(defun avl-tree-size (tree) (defun avl-tree-size (tree)
"Return the number of elements in TREE." "Return the number of elements in TREE."
(let ((treesize 0)) (let ((treesize 0))
(avl-tree--mapc (avl-tree--mapc
(lambda (data) (setq treesize (1+ treesize))) (lambda (data) (setq treesize (1+ treesize)))
(avl-tree--root tree)) (avl-tree--root tree) 0)
treesize)) treesize))
(defun avl-tree-clear (tree) (defun avl-tree-clear (tree)