emacs-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Emacs-diffs] Changes to emacs/lisp/emacs-lisp/avl-tree.el,v


From: Stefan Monnier
Subject: [Emacs-diffs] Changes to emacs/lisp/emacs-lisp/avl-tree.el,v
Date: Fri, 31 Aug 2007 20:15:38 +0000

CVSROOT:        /sources/emacs
Module name:    emacs
Changes by:     Stefan Monnier <monnier>        07/08/31 20:15:37

Index: emacs-lisp/avl-tree.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/emacs-lisp/avl-tree.el,v
retrieving revision 1.14
retrieving revision 1.15
diff -u -b -r1.14 -r1.15
--- emacs-lisp/avl-tree.el      27 Aug 2007 03:09:15 -0000      1.14
+++ emacs-lisp/avl-tree.el      31 Aug 2007 20:15:34 -0000      1.15
@@ -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.
+(eval-when-compile (require 'cl))
 
-(defmacro avl-tree-node-create (left right data balance)
-  ;; Create and return an avl-tree node.
-  `(vector ,left ,right ,data ,balance))
-
-(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))
-
-(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))
-
-(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))
+;; ================================================================
+;;; Functions and macros handling an AVL tree node.
 
-(defmacro avl-tree-node-branch (node branch)
+(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.\""
-  `(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))
+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)
 
-(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))
-
-
-;;; ================================================================
+;; ================================================================
 ;;;       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))))
+(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-dummyroot (tree)
-  ;; Return the dummy node of an avl-tree.  INTERNAL USE ONLY.
-  `(car (cdr ,tree)))
-
-(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 (avl-tree-node-data br) data)
-      (if (avl-tree-do-delete cmpfun br 1 data)
-          (avl-tree-del-balance2 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)))
 
      (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 (avl-tree-node-data br) data)
-      (and (avl-tree-do-enter cmpfun br 1 data)
-           (avl-tree-enter-balance1 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)))
 
      (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,60 +339,47 @@
     (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.
 
-(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)))
-
-(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))
+(defalias 'avl-tree-compare-function 'avl-tree--cmpfun
+  "Return the comparison function for the avl tree 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)
+  (avl-tree--do-enter (avl-tree--cmpfun tree)
+                      (avl-tree--dummyroot tree)
                      0
                      data)
   data)
@@ -440,8 +388,8 @@
   "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)
+  (avl-tree--do-delete (avl-tree--cmpfun tree)
+                       (avl-tree--dummyroot tree)
                       0
                       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)
 




reply via email to

[Prev in Thread] Current Thread [Next in Thread]