Commit 2f53c0c4 authored by Noam Postavsky's avatar Noam Postavsky
Browse files

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.
parent 57a8346e
......@@ -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))))
......
;;; 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
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment