aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorStefan Monnier2014-12-08 14:49:17 -0500
committerStefan Monnier2014-12-08 14:49:17 -0500
commit28057ef3b598529cb15afcee57ef16ef6aa3bf2f (patch)
treeb90485ddc1cf76e8594a5d5ae90163e4a11b9664
parentb7768d785f1fb8a93619b926ddb56d59ef8b81a0 (diff)
downloademacs-28057ef3b598529cb15afcee57ef16ef6aa3bf2f.tar.gz
emacs-28057ef3b598529cb15afcee57ef16ef6aa3bf2f.zip
* lisp/emacs-lisp/avl-tree.el: Use lexical-binding and cl-lib.
(avl-tree--root): Remove redundant defsetf.
-rw-r--r--lisp/ChangeLog11
-rw-r--r--lisp/emacs-lisp/avl-tree.el58
2 files changed, 35 insertions, 34 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index b9903ac2fd4..ec0a8c4a31f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
12014-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
2
3 * emacs-lisp/avl-tree.el: Use lexical-binding and cl-lib.
4 (avl-tree--root): Remove redundant defsetf.
5
12014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org> 62014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
2 7
3 * net/nsm.el (network-security-level): Remove the detailed 8 * net/nsm.el (network-security-level): Remove the detailed
@@ -10,8 +15,8 @@
10 15
11 * net/eww.el (eww-buffers-mode): New major mode. 16 * net/eww.el (eww-buffers-mode): New major mode.
12 (eww-list-buffers, eww-buffer-select, eww-buffer-show-next) 17 (eww-list-buffers, eww-buffer-select, eww-buffer-show-next)
13 (eww-buffer-show-previous, eww-buffer-kill, eww-buffer-show): New 18 (eww-buffer-show-previous, eww-buffer-kill, eww-buffer-show):
14 commands/functions (bug#19131). 19 New commands/functions (bug#19131).
15 20
162014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org> 212014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
17 22
@@ -38,7 +43,7 @@
38 43
392014-12-07 Ivan Shmakov <ivan@siamics.net> 442014-12-07 Ivan Shmakov <ivan@siamics.net>
40 45
41 * net/eww.el (eww): Moved history recording here... 46 * net/eww.el (eww): Move history recording here...
42 (eww-browse-url): ... from here (bug#19253). 47 (eww-browse-url): ... from here (bug#19253).
43 48
44 * net/eww.el (eww-browse-url): Use generate-new-buffer (was: 49 * net/eww.el (eww-browse-url): Use generate-new-buffer (was:
diff --git a/lisp/emacs-lisp/avl-tree.el b/lisp/emacs-lisp/avl-tree.el
index 813576efb46..43484801b5a 100644
--- a/lisp/emacs-lisp/avl-tree.el
+++ b/lisp/emacs-lisp/avl-tree.el
@@ -1,4 +1,4 @@
1;;; avl-tree.el --- balanced binary trees, AVL-trees 1;;; avl-tree.el --- balanced binary trees, AVL-trees -*- lexical-binding:t -*-
2 2
3;; Copyright (C) 1995, 2007-2014 Free Software Foundation, Inc. 3;; Copyright (C) 1995, 2007-2014 Free Software Foundation, Inc.
4 4
@@ -27,23 +27,23 @@
27 27
28;;; Commentary: 28;;; Commentary:
29 29
30;; An AVL tree is a self-balancing binary tree. As such, inserting, 30;; An AVL tree is a self-balancing binary tree. As such, inserting,
31;; deleting, and retrieving data from an AVL tree containing n elements 31;; deleting, and retrieving data from an AVL tree containing n elements
32;; is O(log n). It is somewhat more rigidly balanced than other 32;; is O(log n). It is somewhat more rigidly balanced than other
33;; self-balancing binary trees (such as red-black trees and AA trees), 33;; self-balancing binary trees (such as red-black trees and AA trees),
34;; making insertion slightly slower, deletion somewhat slower, and 34;; making insertion slightly slower, deletion somewhat slower, and
35;; retrieval somewhat faster (the asymptotic scaling is of course the 35;; retrieval somewhat faster (the asymptotic scaling is of course the
36;; same for all types). Thus it may be a good choice when the tree will 36;; same for all types). Thus it may be a good choice when the tree will
37;; be relatively static, i.e. data will be retrieved more often than 37;; be relatively static, i.e. data will be retrieved more often than
38;; they are modified. 38;; they are modified.
39;; 39;;
40;; Internally, a tree consists of two elements, the root node and the 40;; Internally, a tree consists of two elements, the root node and the
41;; comparison function. The actual tree has a dummy node as its root 41;; comparison function. The actual tree has a dummy node as its root
42;; with the real root in the left pointer, which allows the root node to 42;; with the real root in the left pointer, which allows the root node to
43;; be treated on a par with all other nodes. 43;; be treated on a par with all other nodes.
44;; 44;;
45;; Each node of the tree consists of one data element, one left 45;; Each node of the tree consists of one data element, one left
46;; sub-tree, one right sub-tree, and a balance count. The latter is the 46;; sub-tree, one right sub-tree, and a balance count. The latter is the
47;; difference in depth of the left and right sub-trees. 47;; difference in depth of the left and right sub-trees.
48;; 48;;
49;; The functions with names of the form "avl-tree--" are intended for 49;; The functions with names of the form "avl-tree--" are intended for
@@ -51,7 +51,7 @@
51 51
52;;; Code: 52;;; Code:
53 53
54(eval-when-compile (require 'cl)) 54(eval-when-compile (require 'cl-lib))
55 55
56 56
57 57
@@ -62,7 +62,7 @@
62;; ---------------------------------------------------------------- 62;; ----------------------------------------------------------------
63;; Functions and macros handling an AVL tree. 63;; Functions and macros handling an AVL tree.
64 64
65(defstruct (avl-tree- 65(cl-defstruct (avl-tree-
66 ;; A tagged list is the pre-defstruct representation. 66 ;; A tagged list is the pre-defstruct representation.
67 ;; (:type list) 67 ;; (:type list)
68 :named 68 :named
@@ -77,15 +77,10 @@
77 ;; Return the root node for an AVL tree. INTERNAL USE ONLY. 77 ;; Return the root node for an AVL tree. INTERNAL USE ONLY.
78 `(avl-tree--node-left (avl-tree--dummyroot ,tree))) 78 `(avl-tree--node-left (avl-tree--dummyroot ,tree)))
79 79
80(defsetf avl-tree--root (tree) (node)
81 `(setf (avl-tree--node-left (avl-tree--dummyroot ,tree)) ,node))
82
83
84
85;; ---------------------------------------------------------------- 80;; ----------------------------------------------------------------
86;; Functions and macros handling an AVL tree node. 81;; Functions and macros handling an AVL tree node.
87 82
88(defstruct (avl-tree--node 83(cl-defstruct (avl-tree--node
89 ;; We force a representation without tag so it matches the 84 ;; We force a representation without tag so it matches the
90 ;; pre-defstruct representation. Also we use the underlying 85 ;; pre-defstruct representation. Also we use the underlying
91 ;; representation in the implementation of 86 ;; representation in the implementation of
@@ -97,7 +92,7 @@
97 left right data balance) 92 left right data balance)
98 93
99 94
100(defalias 'avl-tree--node-branch 'aref 95(defalias 'avl-tree--node-branch #'aref
101 ;; This implementation is efficient but breaks the defstruct 96 ;; This implementation is efficient but breaks the defstruct
102 ;; abstraction. An alternative could be (funcall (aref [avl-tree-left 97 ;; abstraction. An alternative could be (funcall (aref [avl-tree-left
103 ;; avl-tree-right avl-tree-data] branch) node) 98 ;; avl-tree-right avl-tree-data] branch) node)
@@ -109,7 +104,7 @@ NODE is the node, and BRANCH is the branch.
109;; The funcall/aref trick wouldn't work for the setf method, unless we 104;; The funcall/aref trick wouldn't work for the setf method, unless we
110;; tried to access the underlying setter function, but this wouldn't be 105;; tried to access the underlying setter function, but this wouldn't be
111;; portable either. 106;; portable either.
112(defsetf avl-tree--node-branch aset) 107(gv-define-simple-setter avl-tree--node-branch aset)
113 108
114 109
115 110
@@ -297,7 +292,8 @@ Return t if the height of the tree has grown."
297 (if (< (* sgn b2) 0) sgn 0) 292 (if (< (* sgn b2) 0) sgn 0)
298 (avl-tree--node-branch node branch) p2)) 293 (avl-tree--node-branch node branch) p2))
299 (setf (avl-tree--node-balance 294 (setf (avl-tree--node-balance
300 (avl-tree--node-branch node branch)) 0) 295 (avl-tree--node-branch node branch))
296 0)
301 nil)))) 297 nil))))
302 298
303(defun avl-tree--do-enter (cmpfun root branch data &optional updatefun) 299(defun avl-tree--do-enter (cmpfun root branch data &optional updatefun)
@@ -346,7 +342,7 @@ inserted data."
346 (if (null node) 0 342 (if (null node) 0
347 (let ((dl (avl-tree--check-node (avl-tree--node-left node))) 343 (let ((dl (avl-tree--check-node (avl-tree--node-left node)))
348 (dr (avl-tree--check-node (avl-tree--node-right node)))) 344 (dr (avl-tree--check-node (avl-tree--node-right node))))
349 (assert (= (- dr dl) (avl-tree--node-balance node))) 345 (cl-assert (= (- dr dl) (avl-tree--node-balance node)))
350 (1+ (max dl dr))))) 346 (1+ (max dl dr)))))
351 347
352;; ---------------------------------------------------------------- 348;; ----------------------------------------------------------------
@@ -391,7 +387,7 @@ itself."
391 (avl-tree--node-data root) 387 (avl-tree--node-data root)
392 (avl-tree--node-balance root)))) 388 (avl-tree--node-balance root))))
393 389
394(defstruct (avl-tree--stack 390(cl-defstruct (avl-tree--stack
395 (:constructor nil) 391 (:constructor nil)
396 (:constructor avl-tree--stack-create 392 (:constructor avl-tree--stack-create
397 (tree &optional reverse 393 (tree &optional reverse
@@ -403,7 +399,7 @@ itself."
403 (:copier nil)) 399 (:copier nil))
404 reverse store) 400 reverse store)
405 401
406(defalias 'avl-tree-stack-p 'avl-tree--stack-p 402(defalias 'avl-tree-stack-p #'avl-tree--stack-p
407 "Return t if argument is an avl-tree-stack, nil otherwise.") 403 "Return t if argument is an avl-tree-stack, nil otherwise.")
408 404
409(defun avl-tree--stack-repopulate (stack) 405(defun avl-tree--stack-repopulate (stack)
@@ -420,12 +416,12 @@ itself."
420;;; The public functions which operate on AVL trees. 416;;; The public functions which operate on AVL trees.
421 417
422;; define public alias for constructors so that we can set docstring 418;; define public alias for constructors so that we can set docstring
423(defalias 'avl-tree-create 'avl-tree--create 419(defalias 'avl-tree-create #'avl-tree--create
424 "Create an empty AVL tree. 420 "Create an empty AVL tree.
425COMPARE-FUNCTION is a function which takes two arguments, A and B, 421COMPARE-FUNCTION is a function which takes two arguments, A and B,
426and returns non-nil if A is less than B, and nil otherwise.") 422and returns non-nil if A is less than B, and nil otherwise.")
427 423
428(defalias 'avl-tree-compare-function 'avl-tree--cmpfun 424(defalias 'avl-tree-compare-function #'avl-tree--cmpfun
429 "Return the comparison function for the AVL tree TREE. 425 "Return the comparison function for the AVL tree TREE.
430 426
431\(fn TREE)") 427\(fn TREE)")
@@ -505,7 +501,7 @@ previously specified in `avl-tree-create' when TREE was created."
505 (not (eq (avl-tree-member tree data flag) flag)))) 501 (not (eq (avl-tree-member tree data flag) flag))))
506 502
507 503
508(defun avl-tree-map (__map-function__ tree &optional reverse) 504(defun avl-tree-map (fun tree &optional reverse)
509 "Modify all elements in the AVL tree TREE by applying FUNCTION. 505 "Modify all elements in the AVL tree TREE by applying FUNCTION.
510 506
511Each element is replaced by the return value of FUNCTION applied 507Each element is replaced by the return value of FUNCTION applied
@@ -516,12 +512,12 @@ descending order if REVERSE is non-nil."
516 (avl-tree--mapc 512 (avl-tree--mapc
517 (lambda (node) 513 (lambda (node)
518 (setf (avl-tree--node-data node) 514 (setf (avl-tree--node-data node)
519 (funcall __map-function__ (avl-tree--node-data node)))) 515 (funcall fun (avl-tree--node-data node))))
520 (avl-tree--root tree) 516 (avl-tree--root tree)
521 (if reverse 1 0))) 517 (if reverse 1 0)))
522 518
523 519
524(defun avl-tree-mapc (__map-function__ tree &optional reverse) 520(defun avl-tree-mapc (fun tree &optional reverse)
525 "Apply FUNCTION to all elements in AVL tree TREE, 521 "Apply FUNCTION to all elements in AVL tree TREE,
526for side-effect only. 522for side-effect only.
527 523
@@ -529,13 +525,13 @@ FUNCTION is applied to the elements in ascending order, or
529descending order if REVERSE is non-nil." 525descending order if REVERSE is non-nil."
530 (avl-tree--mapc 526 (avl-tree--mapc
531 (lambda (node) 527 (lambda (node)
532 (funcall __map-function__ (avl-tree--node-data node))) 528 (funcall fun (avl-tree--node-data node)))
533 (avl-tree--root tree) 529 (avl-tree--root tree)
534 (if reverse 1 0))) 530 (if reverse 1 0)))
535 531
536 532
537(defun avl-tree-mapf 533(defun avl-tree-mapf
538 (__map-function__ combinator tree &optional reverse) 534 (fun combinator tree &optional reverse)
539 "Apply FUNCTION to all elements in AVL tree TREE, 535 "Apply FUNCTION to all elements in AVL tree TREE,
540and combine the results using COMBINATOR. 536and combine the results using COMBINATOR.
541 537
@@ -546,7 +542,7 @@ order, or descending order if REVERSE is non-nil."
546 (lambda (node) 542 (lambda (node)
547 (setq avl-tree-mapf--accumulate 543 (setq avl-tree-mapf--accumulate
548 (funcall combinator 544 (funcall combinator
549 (funcall __map-function__ 545 (funcall fun
550 (avl-tree--node-data node)) 546 (avl-tree--node-data node))
551 avl-tree-mapf--accumulate))) 547 avl-tree-mapf--accumulate)))
552 (avl-tree--root tree) 548 (avl-tree--root tree)
@@ -554,7 +550,7 @@ order, or descending order if REVERSE is non-nil."
554 (nreverse avl-tree-mapf--accumulate))) 550 (nreverse avl-tree-mapf--accumulate)))
555 551
556 552
557(defun avl-tree-mapcar (__map-function__ tree &optional reverse) 553(defun avl-tree-mapcar (fun tree &optional reverse)
558 "Apply FUNCTION to all elements in AVL tree TREE, 554 "Apply FUNCTION to all elements in AVL tree TREE,
559and make a list of the results. 555and make a list of the results.
560 556
@@ -568,7 +564,7 @@ then
568 (avl-tree-mapf function 'cons tree (not reverse)) 564 (avl-tree-mapf function 'cons tree (not reverse))
569 565
570is more efficient." 566is more efficient."
571 (nreverse (avl-tree-mapf __map-function__ 'cons tree reverse))) 567 (nreverse (avl-tree-mapf fun 'cons tree reverse)))
572 568
573 569
574(defun avl-tree-first (tree) 570(defun avl-tree-first (tree)
@@ -605,7 +601,7 @@ is more efficient."
605 "Return the number of elements in TREE." 601 "Return the number of elements in TREE."
606 (let ((treesize 0)) 602 (let ((treesize 0))
607 (avl-tree--mapc 603 (avl-tree--mapc
608 (lambda (data) (setq treesize (1+ treesize))) 604 (lambda (_) (setq treesize (1+ treesize)))
609 (avl-tree--root tree) 0) 605 (avl-tree--root tree) 0)
610 treesize)) 606 treesize))
611 607