[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] master 2f53c0c: Simplify cl-get using `plist-member'
From: |
Noam Postavsky |
Subject: |
[Emacs-diffs] master 2f53c0c: Simplify cl-get using `plist-member' |
Date: |
Mon, 20 Feb 2017 16:52:26 -0500 (EST) |
branch: master
commit 2f53c0c468561313dd9840e28371436c669153c2
Author: Noam Postavsky <address@hidden>
Commit: Noam Postavsky <address@hidden>
Simplify cl-get using `plist-member'
* lisp/emacs-lisp/cl-extra.el (cl-get, cl-getf, cl--set-getf): Use
`plist-member' instead of explicit loop.
* test/lisp/emacs-lisp/cl-extra-tests.el: New tests.
---
lisp/emacs-lisp/cl-extra.el | 28 +++++++------------------
test/lisp/emacs-lisp/cl-extra-tests.el | 38 ++++++++++++++++++++++++++++++++++
2 files changed, 46 insertions(+), 20 deletions(-)
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 644c35d..edd14b8 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -593,13 +593,7 @@ too large if positive or too small if negative)."
\n(fn SYMBOL PROPNAME &optional DEFAULT)"
(declare (compiler-macro cl--compiler-macro-get)
(gv-setter (lambda (store) (ignore def) `(put ,sym ,tag ,store))))
- (or (get sym tag)
- (and def
- ;; Make sure `def' is really absent as opposed to set to nil.
- (let ((plist (symbol-plist sym)))
- (while (and plist (not (eq (car plist) tag)))
- (setq plist (cdr (cdr plist))))
- (if plist (car (cdr plist)) def)))))
+ (cl-getf (symbol-plist sym) tag def))
(autoload 'cl--compiler-macro-get "cl-macs")
;;;###autoload
@@ -618,26 +612,20 @@ PROPLIST is a list of the sort returned by `symbol-plist'.
,(funcall setter
`(cl--set-getf ,getter ,k ,val))
,val)))))))))
- (setplist '--cl-getf-symbol-- plist)
- (or (get '--cl-getf-symbol-- tag)
- ;; Originally we called cl-get here,
- ;; but that fails, because cl-get has a compiler macro
- ;; definition that uses getf!
- (when def
- ;; Make sure `def' is really absent as opposed to set to nil.
- (while (and plist (not (eq (car plist) tag)))
- (setq plist (cdr (cdr plist))))
- (if plist (car (cdr plist)) def))))
+ (let ((val-tail (cdr-safe (plist-member plist tag))))
+ (if val-tail (car val-tail) def)))
;;;###autoload
(defun cl--set-getf (plist tag val)
- (let ((p plist))
- (while (and p (not (eq (car p) tag))) (setq p (cdr (cdr p))))
- (if p (progn (setcar (cdr p) val) plist) (cl-list* tag val plist))))
+ (let ((val-tail (cdr-safe (plist-member plist tag))))
+ (if val-tail (progn (setcar val-tail val) plist)
+ (cl-list* tag val plist))))
;;;###autoload
(defun cl--do-remf (plist tag)
(let ((p (cdr plist)))
+ ;; Can't use `plist-member' here because it goes to the cons-cell
+ ;; of TAG and we need the one before.
(while (and (cdr p) (not (eq (car (cdr p)) tag))) (setq p (cdr (cdr p))))
(and (cdr p) (progn (setcdr p (cdr (cdr (cdr p)))) t))))
diff --git a/test/lisp/emacs-lisp/cl-extra-tests.el
b/test/lisp/emacs-lisp/cl-extra-tests.el
new file mode 100644
index 0000000..3e2388a
--- /dev/null
+++ b/test/lisp/emacs-lisp/cl-extra-tests.el
@@ -0,0 +1,38 @@
+;;; cl-extra-tests.el --- tests for emacs-lisp/cl-extra.el -*-
lexical-binding:t -*-
+
+;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software: you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation, either version 3 of the
+;; License, or (at your option) any later version.
+;;
+;; This program is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+;; General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with this program. If not, see `http://www.gnu.org/licenses/'.
+
+;;; Code:
+
+(require 'cl-lib)
+(require 'ert)
+
+(ert-deftest cl-get ()
+ (put 'cl-get-test 'x 1)
+ (put 'cl-get-test 'y nil)
+ (should (eq (cl-get 'cl-get-test 'x) 1))
+ (should (eq (cl-get 'cl-get-test 'y :none) nil))
+ (should (eq (cl-get 'cl-get-test 'z :none) :none)))
+
+(ert-deftest cl-getf ()
+ (let ((plist '(x 1 y nil)))
+ (should (eq (cl-getf plist 'x) 1))
+ (should (eq (cl-getf plist 'y :none) nil))
+ (should (eq (cl-getf plist 'z :none) :none))))
+
+;;; cl-extra-tests.el ends here
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] master 2f53c0c: Simplify cl-get using `plist-member',
Noam Postavsky <=