diff options
| author | Stefan Monnier | 2014-12-08 14:49:17 -0500 |
|---|---|---|
| committer | Stefan Monnier | 2014-12-08 14:49:17 -0500 |
| commit | 28057ef3b598529cb15afcee57ef16ef6aa3bf2f (patch) | |
| tree | b90485ddc1cf76e8594a5d5ae90163e4a11b9664 | |
| parent | b7768d785f1fb8a93619b926ddb56d59ef8b81a0 (diff) | |
| download | emacs-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/ChangeLog | 11 | ||||
| -rw-r--r-- | lisp/emacs-lisp/avl-tree.el | 58 |
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 @@ | |||
| 1 | 2014-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 | |||
| 1 | 2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org> | 6 | 2014-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 | ||
| 16 | 2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org> | 21 | 2014-12-08 Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 17 | 22 | ||
| @@ -38,7 +43,7 @@ | |||
| 38 | 43 | ||
| 39 | 2014-12-07 Ivan Shmakov <ivan@siamics.net> | 44 | 2014-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. |
| 425 | COMPARE-FUNCTION is a function which takes two arguments, A and B, | 421 | COMPARE-FUNCTION is a function which takes two arguments, A and B, |
| 426 | and returns non-nil if A is less than B, and nil otherwise.") | 422 | and 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 | ||
| 511 | Each element is replaced by the return value of FUNCTION applied | 507 | Each 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, |
| 526 | for side-effect only. | 522 | for side-effect only. |
| 527 | 523 | ||
| @@ -529,13 +525,13 @@ FUNCTION is applied to the elements in ascending order, or | |||
| 529 | descending order if REVERSE is non-nil." | 525 | descending 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, |
| 540 | and combine the results using COMBINATOR. | 536 | and 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, |
| 559 | and make a list of the results. | 555 | and 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 | ||
| 570 | is more efficient." | 566 | is 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 | ||