Mercurial > emacs
changeset 83827:17a8beea7b8c
Use defstruct rather than macros.
Change naming to use "avl-tree--" for internal functions.
| author | Stefan Monnier <monnier@iro.umontreal.ca> |
|---|---|
| date | Fri, 31 Aug 2007 20:15:34 +0000 |
| parents | 41451b9525da |
| children | 5b40159df290 |
| files | lisp/ChangeLog lisp/emacs-lisp/avl-tree.el |
| diffstat | 2 files changed, 233 insertions(+), 290 deletions(-) [+] |
line wrap: on
line diff
--- a/lisp/ChangeLog Fri Aug 31 19:15:07 2007 +0000 +++ b/lisp/ChangeLog Fri Aug 31 20:15:34 2007 +0000 @@ -1,3 +1,8 @@ +2007-08-31 Stefan Monnier <monnier@iro.umontreal.ca> + + * emacs-lisp/avl-tree.el: Use defstruct rather than macros. + Change naming to use "avl-tree--" for internal functions. + 2007-08-31 Dan Nicolaescu <dann@ics.uci.edu> * term/x-win.el (x-menu-bar-open): Delete duplicated function from
--- a/lisp/emacs-lisp/avl-tree.el Fri Aug 31 19:15:07 2007 +0000 +++ b/lisp/emacs-lisp/avl-tree.el Fri Aug 31 20:15:34 2007 +0000 @@ -28,345 +28,306 @@ ;;; Commentary: -;; An AVL tree is a nearly-perfect balanced binary tree. A tree -;; consists of two cons cells, the first one holding the tag -;; 'AVL-TREE in the car cell, and the second one having the tree -;; in the car and the compare function in the cdr cell. The tree has -;; a dummy node as its root with the real tree in the left pointer. +;; 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. ;; ;; 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. ;; -;; The "public" functions (prefixed with "avl-tree") are: -;; -create, -p, -compare-function, -empty, -enter, -delete, -;; -member, -map, -first, -last, -copy, -flatten, -size, -clear. +;; The functions with names of the form "avl-tree--" are intended for +;; internal use only. ;;; Code: -;;; ================================================================ -;;; Functions and macros handling an AVL tree node. - -(defmacro avl-tree-node-create (left right data balance) - ;; Create and return an avl-tree node. - `(vector ,left ,right ,data ,balance)) +(eval-when-compile (require 'cl)) -(defmacro avl-tree-node-left (node) - ;; Return the left pointer of NODE. - `(aref ,node 0)) - -(defmacro avl-tree-node-right (node) - ;; Return the right pointer of NODE. - `(aref ,node 1)) +;; ================================================================ +;;; Functions and macros handling an AVL tree node. -(defmacro avl-tree-node-data (node) - ;; Return the data of NODE. - `(aref ,node 2)) - -(defmacro avl-tree-node-set-left (node newleft) - ;; Set the left pointer of NODE to NEWLEFT. - `(aset ,node 0 ,newleft)) +(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) -(defmacro avl-tree-node-set-right (node newright) - ;; Set the right pointer of NODE to NEWRIGHT. - `(aset ,node 1 ,newright)) - -(defmacro avl-tree-node-set-data (node newdata) - ;; Set the data of NODE to NEWDATA. - `(aset ,node 2 ,newdata)) - -(defmacro avl-tree-node-branch (node branch) +(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.\"" - `(aref ,node ,branch)) - -(defmacro avl-tree-node-set-branch (node branch newval) - "Set value of a branch of a node. - -NODE is the node, and BRANCH is the branch. -0 for left pointer, 1 for the right pointer and 2 for the data. -NEWVAL is new value of the branch.\"" - `(aset ,node ,branch ,newval)) - -(defmacro avl-tree-node-balance (node) - ;; Return the balance field of a node. - `(aref ,node 3)) - -(defmacro avl-tree-node-set-balance (node newbal) - ;; Set the balance field of a node. - `(aset ,node 3 ,newbal)) +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 - -(defmacro avl-tree-root (tree) - ;; Return the root node for an avl-tree. INTERNAL USE ONLY. - `(avl-tree-node-left (car (cdr ,tree)))) +;; ================================================================ +;;; Internal functions for use in the AVL tree package -(defmacro avl-tree-dummyroot (tree) - ;; Return the dummy node of an avl-tree. INTERNAL USE ONLY. - `(car (cdr ,tree))) +(defstruct (avl-tree- + ;; A tagged list is the pre-defstruct representation. + ;; (:type list) + :named + (:constructor nil) + (:constructor avl-tree-create (cmpfun)) + (:predicate avl-tree-p) + (:copier nil)) + (dummyroot (avl-tree--node-create nil nil nil 0)) + cmpfun) -(defmacro avl-tree-cmpfun (tree) - ;; Return the compare function of AVL tree TREE. INTERNAL USE ONLY. - `(cdr (cdr ,tree))) +(defmacro avl-tree--root (tree) + ;; Return the root node for an avl-tree. INTERNAL USE ONLY. + `(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 -(defun avl-tree-del-balance1 (node branch) +(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)) + (let ((br (avl-tree--node-branch node branch)) p1 b1 p2 b2 result) (cond - ((< (avl-tree-node-balance br) 0) - (avl-tree-node-set-balance br 0) + ((< (avl-tree--node-balance br) 0) + (setf (avl-tree--node-balance br) 0) t) - ((= (avl-tree-node-balance br) 0) - (avl-tree-node-set-balance br +1) + ((= (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)) + (setq p1 (avl-tree--node-right br) + b1 (avl-tree--node-balance p1)) (if (>= b1 0) ;; Single RR rotation. (progn - (avl-tree-node-set-right br (avl-tree-node-left p1)) - (avl-tree-node-set-left p1 br) + (setf (avl-tree--node-right br) (avl-tree--node-left p1)) + (setf (avl-tree--node-left p1) br) (if (= 0 b1) (progn - (avl-tree-node-set-balance br +1) - (avl-tree-node-set-balance p1 -1) + (setf (avl-tree--node-balance br) +1) + (setf (avl-tree--node-balance p1) -1) (setq result nil)) - (avl-tree-node-set-balance br 0) - (avl-tree-node-set-balance p1 0) + (setf (avl-tree--node-balance br) 0) + (setf (avl-tree--node-balance p1) 0) (setq result t)) - (avl-tree-node-set-branch node branch p1) + (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)) - (avl-tree-node-set-left p1 (avl-tree-node-right p2)) - (avl-tree-node-set-right p2 p1) - (avl-tree-node-set-right br (avl-tree-node-left p2)) - (avl-tree-node-set-left p2 br) - (if (> b2 0) - (avl-tree-node-set-balance br -1) - (avl-tree-node-set-balance br 0)) - (if (< b2 0) - (avl-tree-node-set-balance p1 +1) - (avl-tree-node-set-balance p1 0)) - (avl-tree-node-set-branch node branch p2) - (avl-tree-node-set-balance p2 0) + (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))))) -(defun avl-tree-del-balance2 (node branch) - (let ((br (avl-tree-node-branch node branch)) +(defun avl-tree--del-balance2 (node branch) + (let ((br (avl-tree--node-branch node branch)) p1 b1 p2 b2 result) (cond - ((> (avl-tree-node-balance br) 0) - (avl-tree-node-set-balance br 0) + ((> (avl-tree--node-balance br) 0) + (setf (avl-tree--node-balance br) 0) t) - ((= (avl-tree-node-balance br) 0) - (avl-tree-node-set-balance br -1) + ((= (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)) + (setq p1 (avl-tree--node-left br) + b1 (avl-tree--node-balance p1)) (if (<= b1 0) ;; Single LL rotation. (progn - (avl-tree-node-set-left br (avl-tree-node-right p1)) - (avl-tree-node-set-right p1 br) + (setf (avl-tree--node-left br) (avl-tree--node-right p1)) + (setf (avl-tree--node-right p1) br) (if (= 0 b1) (progn - (avl-tree-node-set-balance br -1) - (avl-tree-node-set-balance p1 +1) + (setf (avl-tree--node-balance br) -1) + (setf (avl-tree--node-balance p1) +1) (setq result nil)) - (avl-tree-node-set-balance br 0) - (avl-tree-node-set-balance p1 0) + (setf (avl-tree--node-balance br) 0) + (setf (avl-tree--node-balance p1) 0) (setq result t)) - (avl-tree-node-set-branch node branch p1) + (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)) - (avl-tree-node-set-right p1 (avl-tree-node-left p2)) - (avl-tree-node-set-left p2 p1) - (avl-tree-node-set-left br (avl-tree-node-right p2)) - (avl-tree-node-set-right p2 br) - (if (< b2 0) - (avl-tree-node-set-balance br +1) - (avl-tree-node-set-balance br 0)) - (if (> b2 0) - (avl-tree-node-set-balance p1 -1) - (avl-tree-node-set-balance p1 0)) - (avl-tree-node-set-branch node branch p2) - (avl-tree-node-set-balance p2 0) + (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))))) -(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)) - (avl-tree-node-set-data q (avl-tree-node-data br)) - (avl-tree-node-set-branch node branch - (avl-tree-node-left br)) +(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)) t))) -(defun avl-tree-do-delete (cmpfun root branch data) +(defun avl-tree--do-delete (cmpfun root branch data) ;; Return t if the height of the tree has shrunk. - (let ((br (avl-tree-node-branch root branch))) + (let ((br (avl-tree--node-branch root branch))) (cond ((null br) nil) - ((funcall cmpfun data (avl-tree-node-data br)) - (if (avl-tree-do-delete cmpfun br 0 data) - (avl-tree-del-balance1 root branch))) + ((funcall cmpfun data (avl-tree--node-data br)) + (if (avl-tree--do-delete cmpfun br 0 data) + (avl-tree--del-balance1 root branch))) - ((funcall cmpfun (avl-tree-node-data br) data) - (if (avl-tree-do-delete cmpfun br 1 data) - (avl-tree-del-balance2 root branch))) + ((funcall cmpfun (avl-tree--node-data br) data) + (if (avl-tree--do-delete cmpfun br 1 data) + (avl-tree--del-balance2 root branch))) (t ;; Found it. Let's delete it. (cond - ((null (avl-tree-node-right br)) - (avl-tree-node-set-branch root branch (avl-tree-node-left br)) + ((null (avl-tree--node-right br)) + (setf (avl-tree--node-branch root branch) (avl-tree--node-left br)) t) - ((null (avl-tree-node-left br)) - (avl-tree-node-set-branch root branch (avl-tree-node-right br)) + ((null (avl-tree--node-left br)) + (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-balance1 root branch)))))))) ;; ---------------------------------------------------------------- ;; Entering data -(defun avl-tree-enter-balance1 (node branch) +(defun avl-tree--enter-balance1 (node branch) ;; Rebalance a tree and 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)) p1 p2 b2 result) (cond - ((< (avl-tree-node-balance br) 0) - (avl-tree-node-set-balance br 0) + ((< (avl-tree--node-balance br) 0) + (setf (avl-tree--node-balance br) 0) nil) - ((= (avl-tree-node-balance br) 0) - (avl-tree-node-set-balance br +1) + ((= (avl-tree--node-balance br) 0) + (setf (avl-tree--node-balance br) +1) t) (t ;; Tree has grown => Rebalance. - (setq p1 (avl-tree-node-right br)) - (if (> (avl-tree-node-balance p1) 0) + (setq p1 (avl-tree--node-right br)) + (if (> (avl-tree--node-balance p1) 0) ;; Single RR rotation. (progn - (avl-tree-node-set-right br (avl-tree-node-left p1)) - (avl-tree-node-set-left p1 br) - (avl-tree-node-set-balance br 0) - (avl-tree-node-set-branch node branch p1)) + (setf (avl-tree--node-right br) (avl-tree--node-left p1)) + (setf (avl-tree--node-left p1) 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)) - (avl-tree-node-set-left p1 (avl-tree-node-right p2)) - (avl-tree-node-set-right p2 p1) - (avl-tree-node-set-right br (avl-tree-node-left p2)) - (avl-tree-node-set-left p2 br) - (if (> b2 0) - (avl-tree-node-set-balance br -1) - (avl-tree-node-set-balance br 0)) - (if (< b2 0) - (avl-tree-node-set-balance p1 +1) - (avl-tree-node-set-balance p1 0)) - (avl-tree-node-set-branch node branch p2)) - (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0) + (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) +(defun avl-tree--enter-balance2 (node branch) ;; Return t if the tree has grown. - (let ((br (avl-tree-node-branch node branch)) + (let ((br (avl-tree--node-branch node branch)) p1 p2 b2) (cond - ((> (avl-tree-node-balance br) 0) - (avl-tree-node-set-balance br 0) + ((> (avl-tree--node-balance br) 0) + (setf (avl-tree--node-balance br) 0) nil) - ((= (avl-tree-node-balance br) 0) - (avl-tree-node-set-balance br -1) + ((= (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) + (setq p1 (avl-tree--node-left br)) + (if (< (avl-tree--node-balance p1) 0) ;; Single LL rotation. (progn - (avl-tree-node-set-left br (avl-tree-node-right p1)) - (avl-tree-node-set-right p1 br) - (avl-tree-node-set-balance br 0) - (avl-tree-node-set-branch node branch p1)) + (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)) - (avl-tree-node-set-right p1 (avl-tree-node-left p2)) - (avl-tree-node-set-left p2 p1) - (avl-tree-node-set-left br (avl-tree-node-right p2)) - (avl-tree-node-set-right p2 br) - (if (< b2 0) - (avl-tree-node-set-balance br +1) - (avl-tree-node-set-balance br 0)) - (if (> b2 0) - (avl-tree-node-set-balance p1 -1) - (avl-tree-node-set-balance p1 0)) - (avl-tree-node-set-branch node branch p2)) - (avl-tree-node-set-balance (avl-tree-node-branch node branch) 0) + (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)))) -(defun avl-tree-do-enter (cmpfun root branch data) +(defun avl-tree--do-enter (cmpfun root branch data) ;; Return t if height of tree ROOT has grown. INTERNAL USE ONLY. - (let ((br (avl-tree-node-branch root branch))) + (let ((br (avl-tree--node-branch root branch))) (cond ((null br) ;; Data not in tree, insert it. - (avl-tree-node-set-branch - root branch (avl-tree-node-create nil nil data 0)) + (setf (avl-tree--node-branch root branch) + (avl-tree--node-create nil nil data 0)) t) - ((funcall cmpfun data (avl-tree-node-data br)) - (and (avl-tree-do-enter cmpfun br 0 data) - (avl-tree-enter-balance2 root branch))) + ((funcall cmpfun data (avl-tree--node-data br)) + (and (avl-tree--do-enter cmpfun br 0 data) + (avl-tree--enter-balance2 root branch))) - ((funcall cmpfun (avl-tree-node-data br) data) - (and (avl-tree-do-enter cmpfun br 1 data) - (avl-tree-enter-balance1 root branch))) + ((funcall cmpfun (avl-tree--node-data br) data) + (and (avl-tree--do-enter cmpfun br 1 data) + (avl-tree--enter-balance1 root branch))) (t - (avl-tree-node-set-data br data) + (setf (avl-tree--node-data br) data) nil)))) ;; ---------------------------------------------------------------- -(defun avl-tree-mapc (map-function root) +(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. ;; @@ -378,72 +339,59 @@ (push nil stack) (while node (if (and go-left - (avl-tree-node-left node)) + (avl-tree--node-left node)) ;; Do the left subtree first. (progn (push node stack) - (setq node (avl-tree-node-left node))) + (setq node (avl-tree--node-left node))) ;; Apply the function... (funcall map-function node) ;; and do the right subtree. - (if (avl-tree-node-right node) - (setq node (avl-tree-node-right node) - go-left t) - (setq node (pop stack) - go-left nil)))))) + (setq node (if (setq go-left (avl-tree--node-right node)) + (avl-tree--node-right node) + (pop stack))))))) -(defun avl-tree-do-copy (root) +(defun avl-tree--do-copy (root) ;; Copy the avl tree with ROOT as root. ;; Highly recursive. INTERNAL USE ONLY. (if (null root) nil - (avl-tree-node-create - (avl-tree-do-copy (avl-tree-node-left root)) - (avl-tree-do-copy (avl-tree-node-right root)) - (avl-tree-node-data root) - (avl-tree-node-balance root)))) + (avl-tree--node-create + (avl-tree--do-copy (avl-tree--node-left root)) + (avl-tree--do-copy (avl-tree--node-right root)) + (avl-tree--node-data root) + (avl-tree--node-balance root)))) -;;; ================================================================ -;;; The public functions which operate on AVL trees. +;; ================================================================ +;;; The public functions which operate on AVL trees. -(defun avl-tree-create (compare-function) - "Create a new empty avl tree and return it. -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." - (cons 'AVL-TREE - (cons (avl-tree-node-create nil nil nil 0) - compare-function))) +(defalias 'avl-tree-compare-function 'avl-tree--cmpfun + "Return the comparison function for the avl tree TREE. -(defun avl-tree-p (obj) - "Return t if OBJ is an avl tree, nil otherwise." - (eq (car-safe obj) 'AVL-TREE)) - -(defun avl-tree-compare-function (tree) - "Return the comparison function for the avl tree TREE." - (avl-tree-cmpfun tree)) +\(fn TREE)") (defun avl-tree-empty (tree) "Return t if avl tree TREE is emtpy, otherwise return nil." - (null (avl-tree-root tree))) + (null (avl-tree--root tree))) (defun avl-tree-enter (tree data) "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--do-enter (avl-tree--cmpfun tree) + (avl-tree--dummyroot tree) + 0 + data) data) (defun avl-tree-delete (tree data) "From the avl tree TREE, delete DATA. Return the element in TREE which matched DATA, nil if no element matched." - (avl-tree-do-delete (avl-tree-cmpfun tree) - (avl-tree-dummyroot tree) - 0 - data)) + (avl-tree--do-delete (avl-tree--cmpfun tree) + (avl-tree--dummyroot tree) + 0 + data)) (defun avl-tree-member (tree data) "Return the element in the avl tree TREE which matches DATA. @@ -451,82 +399,72 @@ `avl-tree-create' when TREE was created. 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)) + (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))) + ((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) + (avl-tree--node-data node) nil))) (defun avl-tree-map (__map-function__ tree) "Apply __MAP-FUNCTION__ to all elements in the avl tree TREE." - (avl-tree-mapc - (function (lambda (node) - (avl-tree-node-set-data - node (funcall __map-function__ - (avl-tree-node-data node))))) - (avl-tree-root tree))) + (avl-tree--mapc + (lambda (node) + (setf (avl-tree--node-data node) + (funcall __map-function__ (avl-tree--node-data node)))) + (avl-tree--root tree))) (defun avl-tree-first (tree) "Return the first element in TREE, or nil if TREE is empty." - (let ((node (avl-tree-root tree))) - (if node - (progn - (while (avl-tree-node-left node) - (setq node (avl-tree-node-left node))) - (avl-tree-node-data node)) - nil))) + (let ((node (avl-tree--root tree))) + (when node + (while (avl-tree--node-left node) + (setq node (avl-tree--node-left node))) + (avl-tree--node-data node)))) (defun avl-tree-last (tree) "Return the last element in TREE, or nil if TREE is empty." - (let ((node (avl-tree-root tree))) - (if node - (progn - (while (avl-tree-node-right node) - (setq node (avl-tree-node-right node))) - (avl-tree-node-data node)) - nil))) + (let ((node (avl-tree--root tree))) + (when node + (while (avl-tree--node-right node) + (setq node (avl-tree--node-right node))) + (avl-tree--node-data node)))) (defun avl-tree-copy (tree) "Return a copy of the avl tree TREE." - (let ((new-tree (avl-tree-create (avl-tree-cmpfun tree)))) - (avl-tree-node-set-left (avl-tree-dummyroot new-tree) - (avl-tree-do-copy (avl-tree-root tree))) + (let ((new-tree (avl-tree-create (avl-tree--cmpfun tree)))) + (setf (avl-tree--root new-tree) (avl-tree--do-copy (avl-tree--root tree))) new-tree)) (defun avl-tree-flatten (tree) "Return a sorted list containing all elements of TREE." (nreverse (let ((treelist nil)) - (avl-tree-mapc - (function (lambda (node) - (setq treelist (cons (avl-tree-node-data node) - treelist)))) - (avl-tree-root tree)) + (avl-tree--mapc + (lambda (node) (push (avl-tree--node-data node) treelist)) + (avl-tree--root tree)) treelist))) (defun avl-tree-size (tree) "Return the number of elements in TREE." (let ((treesize 0)) - (avl-tree-mapc - (function (lambda (data) - (setq treesize (1+ treesize)) - data)) - (avl-tree-root tree)) + (avl-tree--mapc + (lambda (data) (setq treesize (1+ treesize))) + (avl-tree--root tree)) treesize)) (defun avl-tree-clear (tree) "Clear the avl tree TREE." - (avl-tree-node-set-left (avl-tree-dummyroot tree) nil)) + (setf (avl-tree--root tree) nil)) (provide 'avl-tree)