* lisp/emacs-lisp/avl-tree.el: Use lexical-binding and cl-lib.

(avl-tree--root): Remove redundant defsetf.
This commit is contained in:
Stefan Monnier 2014-12-08 14:49:17 -05:00
parent b7768d785f
commit 28057ef3b5
2 changed files with 35 additions and 34 deletions

View file

@ -1,3 +1,8 @@
2014-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
* emacs-lisp/avl-tree.el: Use lexical-binding and cl-lib.
(avl-tree--root): Remove redundant defsetf.
2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org> 2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
* net/nsm.el (network-security-level): Remove the detailed * net/nsm.el (network-security-level): Remove the detailed
@ -10,8 +15,8 @@
* net/eww.el (eww-buffers-mode): New major mode. * net/eww.el (eww-buffers-mode): New major mode.
(eww-list-buffers, eww-buffer-select, eww-buffer-show-next) (eww-list-buffers, eww-buffer-select, eww-buffer-show-next)
(eww-buffer-show-previous, eww-buffer-kill, eww-buffer-show): New (eww-buffer-show-previous, eww-buffer-kill, eww-buffer-show):
commands/functions (bug#19131). New commands/functions (bug#19131).
2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org> 2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
@ -38,7 +43,7 @@
2014-12-07 Ivan Shmakov <ivan@siamics.net> 2014-12-07 Ivan Shmakov <ivan@siamics.net>
* net/eww.el (eww): Moved history recording here... * net/eww.el (eww): Move history recording here...
(eww-browse-url): ... from here (bug#19253). (eww-browse-url): ... from here (bug#19253).
* net/eww.el (eww-browse-url): Use generate-new-buffer (was: * net/eww.el (eww-browse-url): Use generate-new-buffer (was:

View file

@ -1,4 +1,4 @@
;;; avl-tree.el --- balanced binary trees, AVL-trees ;;; avl-tree.el --- balanced binary trees, AVL-trees -*- lexical-binding:t -*-
;; Copyright (C) 1995, 2007-2014 Free Software Foundation, Inc. ;; Copyright (C) 1995, 2007-2014 Free Software Foundation, Inc.
@ -27,23 +27,23 @@
;;; Commentary: ;;; Commentary:
;; An AVL tree is a self-balancing binary tree. As such, inserting, ;; An AVL tree is a self-balancing binary tree. As such, inserting,
;; deleting, and retrieving data from an AVL tree containing n elements ;; deleting, and retrieving data from an AVL tree containing n elements
;; is O(log n). It is somewhat more rigidly balanced than other ;; is O(log n). It is somewhat more rigidly balanced than other
;; self-balancing binary trees (such as red-black trees and AA trees), ;; self-balancing binary trees (such as red-black trees and AA trees),
;; making insertion slightly slower, deletion somewhat slower, and ;; making insertion slightly slower, deletion somewhat slower, and
;; retrieval somewhat faster (the asymptotic scaling is of course the ;; 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 ;; 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 ;; be relatively static, i.e. data will be retrieved more often than
;; they are modified. ;; they are modified.
;; ;;
;; Internally, a tree consists of two elements, the root node and the ;; Internally, a tree consists of two elements, the root node and the
;; comparison function. The actual tree has a dummy node as its root ;; 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 ;; with the real root in the left pointer, which allows the root node to
;; be treated on a par with all other nodes. ;; 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, one right sub-tree, and a balance count. The latter is the ;; sub-tree, one right sub-tree, and a balance count. The latter is the
;; difference in depth of the left and right sub-trees. ;; difference in depth of the left and right 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
@ -51,7 +51,7 @@
;;; Code: ;;; Code:
(eval-when-compile (require 'cl)) (eval-when-compile (require 'cl-lib))
@ -62,7 +62,7 @@
;; ---------------------------------------------------------------- ;; ----------------------------------------------------------------
;; Functions and macros handling an AVL tree. ;; Functions and macros handling an AVL tree.
(defstruct (avl-tree- (cl-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
@ -77,15 +77,10 @@
;; 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)
`(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node))
;; ---------------------------------------------------------------- ;; ----------------------------------------------------------------
;; Functions and macros handling an AVL tree node. ;; Functions and macros handling an AVL tree node.
(defstruct (avl-tree--node (cl-defstruct (avl-tree--node
;; We force a representation without tag so it matches the ;; We force a representation without tag so it matches the
;; pre-defstruct representation. Also we use the underlying ;; pre-defstruct representation. Also we use the underlying
;; representation in the implementation of ;; representation in the implementation of
@ -97,7 +92,7 @@
left right data balance) left right data balance)
(defalias 'avl-tree--node-branch 'aref (defalias 'avl-tree--node-branch #'aref
;; This implementation is efficient but breaks the defstruct ;; This implementation is efficient but breaks the defstruct
;; abstraction. An alternative could be (funcall (aref [avl-tree-left ;; abstraction. An alternative could be (funcall (aref [avl-tree-left
;; avl-tree-right avl-tree-data] branch) node) ;; avl-tree-right avl-tree-data] branch) node)
@ -109,7 +104,7 @@ NODE is the node, and BRANCH is the branch.
;; The funcall/aref trick wouldn't work for the setf method, unless we ;; 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 ;; tried to access the underlying setter function, but this wouldn't be
;; portable either. ;; portable either.
(defsetf avl-tree--node-branch aset) (gv-define-simple-setter avl-tree--node-branch aset)
@ -297,7 +292,8 @@ Return t if the height of the tree has grown."
(if (< (* sgn b2) 0) sgn 0) (if (< (* sgn b2) 0) sgn 0)
(avl-tree--node-branch node branch) p2)) (avl-tree--node-branch node branch) p2))
(setf (avl-tree--node-balance (setf (avl-tree--node-balance
(avl-tree--node-branch node branch)) 0) (avl-tree--node-branch node branch))
0)
nil)))) nil))))
(defun avl-tree--do-enter (cmpfun root branch data &optional updatefun) (defun avl-tree--do-enter (cmpfun root branch data &optional updatefun)
@ -346,7 +342,7 @@ inserted data."
(if (null node) 0 (if (null node) 0
(let ((dl (avl-tree--check-node (avl-tree--node-left node))) (let ((dl (avl-tree--check-node (avl-tree--node-left node)))
(dr (avl-tree--check-node (avl-tree--node-right node)))) (dr (avl-tree--check-node (avl-tree--node-right node))))
(assert (= (- dr dl) (avl-tree--node-balance node))) (cl-assert (= (- dr dl) (avl-tree--node-balance node)))
(1+ (max dl dr))))) (1+ (max dl dr)))))
;; ---------------------------------------------------------------- ;; ----------------------------------------------------------------
@ -391,7 +387,7 @@ itself."
(avl-tree--node-data root) (avl-tree--node-data root)
(avl-tree--node-balance root)))) (avl-tree--node-balance root))))
(defstruct (avl-tree--stack (cl-defstruct (avl-tree--stack
(:constructor nil) (:constructor nil)
(:constructor avl-tree--stack-create (:constructor avl-tree--stack-create
(tree &optional reverse (tree &optional reverse
@ -403,7 +399,7 @@ itself."
(:copier nil)) (:copier nil))
reverse store) reverse store)
(defalias 'avl-tree-stack-p 'avl-tree--stack-p (defalias 'avl-tree-stack-p #'avl-tree--stack-p
"Return t if argument is an avl-tree-stack, nil otherwise.") "Return t if argument is an avl-tree-stack, nil otherwise.")
(defun avl-tree--stack-repopulate (stack) (defun avl-tree--stack-repopulate (stack)
@ -420,12 +416,12 @@ itself."
;;; 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 ;; define public alias for constructors so that we can set docstring
(defalias 'avl-tree-create 'avl-tree--create (defalias 'avl-tree-create #'avl-tree--create
"Create an empty AVL tree. "Create an empty AVL tree.
COMPARE-FUNCTION is a function which takes two arguments, A and B, 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.") 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.
\(fn TREE)") \(fn TREE)")
@ -505,7 +501,7 @@ previously specified in `avl-tree-create' when TREE was created."
(not (eq (avl-tree-member tree data flag) flag)))) (not (eq (avl-tree-member tree data flag) flag))))
(defun avl-tree-map (__map-function__ tree &optional reverse) (defun avl-tree-map (fun tree &optional reverse)
"Modify all elements in the AVL tree TREE by applying FUNCTION. "Modify all elements in the AVL tree TREE by applying FUNCTION.
Each element is replaced by the return value of FUNCTION applied Each element is replaced by the return value of FUNCTION applied
@ -516,12 +512,12 @@ 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 fun (avl-tree--node-data node))))
(avl-tree--root tree) (avl-tree--root tree)
(if reverse 1 0))) (if reverse 1 0)))
(defun avl-tree-mapc (__map-function__ tree &optional reverse) (defun avl-tree-mapc (fun tree &optional reverse)
"Apply FUNCTION to all elements in AVL tree TREE, "Apply FUNCTION to all elements in AVL tree TREE,
for side-effect only. for side-effect only.
@ -529,13 +525,13 @@ FUNCTION is applied to the elements in ascending order, or
descending order if REVERSE is non-nil." descending order if REVERSE is non-nil."
(avl-tree--mapc (avl-tree--mapc
(lambda (node) (lambda (node)
(funcall __map-function__ (avl-tree--node-data node))) (funcall fun (avl-tree--node-data node)))
(avl-tree--root tree) (avl-tree--root tree)
(if reverse 1 0))) (if reverse 1 0)))
(defun avl-tree-mapf (defun avl-tree-mapf
(__map-function__ combinator tree &optional reverse) (fun combinator tree &optional reverse)
"Apply FUNCTION to all elements in AVL tree TREE, "Apply FUNCTION to all elements in AVL tree TREE,
and combine the results using COMBINATOR. and combine the results using COMBINATOR.
@ -546,7 +542,7 @@ order, or descending order if REVERSE is non-nil."
(lambda (node) (lambda (node)
(setq avl-tree-mapf--accumulate (setq avl-tree-mapf--accumulate
(funcall combinator (funcall combinator
(funcall __map-function__ (funcall fun
(avl-tree--node-data node)) (avl-tree--node-data node))
avl-tree-mapf--accumulate))) avl-tree-mapf--accumulate)))
(avl-tree--root tree) (avl-tree--root tree)
@ -554,7 +550,7 @@ order, or descending order if REVERSE is non-nil."
(nreverse avl-tree-mapf--accumulate))) (nreverse avl-tree-mapf--accumulate)))
(defun avl-tree-mapcar (__map-function__ tree &optional reverse) (defun avl-tree-mapcar (fun tree &optional reverse)
"Apply FUNCTION to all elements in AVL tree TREE, "Apply FUNCTION to all elements in AVL tree TREE,
and make a list of the results. and make a list of the results.
@ -568,7 +564,7 @@ then
(avl-tree-mapf function 'cons tree (not reverse)) (avl-tree-mapf function 'cons tree (not reverse))
is more efficient." is more efficient."
(nreverse (avl-tree-mapf __map-function__ 'cons tree reverse))) (nreverse (avl-tree-mapf fun 'cons tree reverse)))
(defun avl-tree-first (tree) (defun avl-tree-first (tree)
@ -605,7 +601,7 @@ is more efficient."
"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 (_) (setq treesize (1+ treesize)))
(avl-tree--root tree) 0) (avl-tree--root tree) 0)
treesize)) treesize))