GNU bug report logs - #25681
[PATCH] Simplify cl-get using `plist-member'

Previous Next

To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 25681 in the body.
You can then email your comments to 25681 AT debbugs.gnu.org in the normal way.

Toggle the display of automated, internal messages from the tracker.

Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):

From: npostavs <at> users.sourceforge.net
To: bug-gnu-emacs <at> gnu.org
Subject: [PATCH] Simplify cl-get using `plist-member'
Date: Fri, 10 Feb 2017 15:56:46 -0500

[Message part 1 (text/plain, inline)]

Severity: wishlist
Tags: patch

I noticed cl-get and friends had on overly complicated
implemententation.

[0001-Simplify-cl-get-using-plist-member.patch (text/x-diff, inline)]

From 760926c3b3bc36a8ac6854402e33d768c9e33fb1 Mon Sep 17 00:00:00 2001
From: Noam Postavsky <npostavs <at> gmail.com>
Date: Fri, 5 Aug 2016 19:59:52 -0400
Subject: [PATCH] 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(-)
 create mode 100644 test/lisp/emacs-lisp/cl-extra-tests.el

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 644c35d7b3..edd14b816f 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -593,13 +593,7 @@ cl-get
 \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 @@ cl-getf
 				  ,(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 0000000000..3e2388acc6
--- /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
-- 
2.11.1

Message #8 received at 25681 <at> debbugs.gnu.org (full text, mbox):

From: npostavs <at> users.sourceforge.net
To: 25681 <at> debbugs.gnu.org
Subject: Re: bug#25681: [PATCH] Simplify cl-get using `plist-member'
Date: Mon, 20 Feb 2017 16:54:20 -0500

tags 25681 fixed
close 25681 26.1
quit

Pushed to master [1: 2f53c0c468].

1: 2017-02-20 16:53:14 -0500 2f53c0c468561313dd9840e28371436c669153c2
  Simplify cl-get using `plist-member'

Previous Next

GNU bug tracking system
Copyright (C) 1999 Darren O. Benham, 1997,2003 nCipher Corporation Ltd, 1994-97 Ian Jackson.