From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: npostavs@users.sourceforge.net Newsgroups: gmane.emacs.bugs Subject: bug#25681: [PATCH] Simplify cl-get using `plist-member' Date: Fri, 10 Feb 2017 15:56:46 -0500 Message-ID: <877f4xn4s1.fsf@users.sourceforge.net> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" X-Trace: blaine.gmane.org 1486760175 21778 195.159.176.226 (10 Feb 2017 20:56:15 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Fri, 10 Feb 2017 20:56:15 +0000 (UTC) To: 25681@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Fri Feb 10 21:56:09 2017 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane.org Original-Received: from lists.gnu.org ([208.118.235.17]) by blaine.gmane.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ccIEj-0005Du-84 for geb-bug-gnu-emacs@m.gmane.org; Fri, 10 Feb 2017 21:56:09 +0100 Original-Received: from localhost ([::1]:45907 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ccIEo-0008Kj-SW for geb-bug-gnu-emacs@m.gmane.org; Fri, 10 Feb 2017 15:56:14 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:33622) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ccIEf-0008KT-JG for bug-gnu-emacs@gnu.org; Fri, 10 Feb 2017 15:56:07 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ccIEc-0006Uj-H6 for bug-gnu-emacs@gnu.org; Fri, 10 Feb 2017 15:56:05 -0500 Original-Received: from debbugs.gnu.org ([208.118.235.43]:36857) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ccIEc-0006Uf-DK for bug-gnu-emacs@gnu.org; Fri, 10 Feb 2017 15:56:02 -0500 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1ccIEc-0005Wc-6c for bug-gnu-emacs@gnu.org; Fri, 10 Feb 2017 15:56:02 -0500 X-Loop: help-debbugs@gnu.org Resent-From: npostavs@users.sourceforge.net Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Fri, 10 Feb 2017 20:56:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 25681 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.148676014921217 (code B ref -1); Fri, 10 Feb 2017 20:56:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 10 Feb 2017 20:55:49 +0000 Original-Received: from localhost ([127.0.0.1]:35056 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ccIEO-0005W9-TV for submit@debbugs.gnu.org; Fri, 10 Feb 2017 15:55:49 -0500 Original-Received: from eggs.gnu.org ([208.118.235.92]:42529) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1ccIEN-0005Vx-GC for submit@debbugs.gnu.org; Fri, 10 Feb 2017 15:55:47 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ccIEH-0006QI-6E for submit@debbugs.gnu.org; Fri, 10 Feb 2017 15:55:42 -0500 Original-Received: from lists.gnu.org ([2001:4830:134:3::11]:48232) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_256_CBC_SHA1:32) (Exim 4.71) (envelope-from ) id 1ccIEH-0006QE-2M for submit@debbugs.gnu.org; Fri, 10 Feb 2017 15:55:41 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:33494) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1ccIEF-0008KD-6w for bug-gnu-emacs@gnu.org; Fri, 10 Feb 2017 15:55:40 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1ccIEC-0006Q0-5a for bug-gnu-emacs@gnu.org; Fri, 10 Feb 2017 15:55:39 -0500 Original-Received: from mail-io0-x230.google.com ([2607:f8b0:4001:c06::230]:33416) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1ccIEB-0006Pw-Vl for bug-gnu-emacs@gnu.org; Fri, 10 Feb 2017 15:55:36 -0500 Original-Received: by mail-io0-x230.google.com with SMTP id v96so60177309ioi.0 for ; Fri, 10 Feb 2017 12:55:35 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=sender:from:to:subject:date:message-id:mime-version; bh=QFfTy4/Gg7lebWDzOdKBM8z80ZpuqZi1fjDixkow0ts=; b=cfNj1jQP+MRUTQAhkUcedp9M5efqwFMR9Mda6DtRxR/gezrJv7YKseOsiI4Kb7ehoN 4/D6qi2xjImSRi25dv51rJ62Pvm22q2KEbBMCFft9tF4XOCjoc+huiAVwJq9vJWFa8+9 prAHXjXA5JnsOCzoz+hWSw4aIj6wXR/XBppB5h01YH7KAmZWVLvem+3c4+sFXaiP8Mxm dXlKXMMUlVO8hxLJG2sQB/XwX9vvngZBfE+Eb353gtL90C//LxmakEj9uSyoMt7/QlXZ JIYiETz8fuFPClN/QcxYCx64TN3waDz63OPb2IIvQ38boSENF7Z2nkOM1V+EbJnZwE/X 3wuw== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:sender:from:to:subject:date:message-id :mime-version; bh=QFfTy4/Gg7lebWDzOdKBM8z80ZpuqZi1fjDixkow0ts=; b=khXpccCl1HPNnWooDm20xWDuKa/szAlIIFV1zIRUb4iK+frkwOpCaoAG0pN8TLv21o TIf3KWfYYSPdVE2SJcEZskMvSNdIbzjjVpyaAxJAPh0eS1dTRRvKwNWHvxYOiCf043pt xKH1QHZ1miSh0txDA6YvPSemwYtUqSlDCm/wb7PRMZkXRym52JAjo30MU3OX1HDGG/FK dS8V3UGaUSTzkHoKTV9yTUScbuD1i5Z06vtKsTYUuw+I56CePrFus4ZN5M4yilC5Qh2L AbHHCUE7Efd1pn5+XFWLfCJmoP+Dyt2chGL5A7BvmRSE2Vsn+CUdRjTN7vdL5HCbPNqQ ZQ9g== X-Gm-Message-State: AMke39mxB21z3VaqFWBBO7d8z9Kh76XYZoZCrBYjEoXq1XmYj7m9cYmB6EspTIAT/9eJgw== X-Received: by 10.107.58.68 with SMTP id h65mr10737910ioa.179.1486760135158; Fri, 10 Feb 2017 12:55:35 -0800 (PST) Original-Received: from zony ([45.2.7.65]) by smtp.googlemail.com with ESMTPSA id c21sm1469130iod.38.2017.02.10.12.55.34 for (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Fri, 10 Feb 2017 12:55:34 -0800 (PST) X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.6.x X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 208.118.235.43 X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.org gmane.emacs.bugs:129220 Archived-At: --=-=-= Content-Type: text/plain Severity: wishlist Tags: patch I noticed cl-get and friends had on overly complicated implemententation. --=-=-= Content-Type: text/x-diff Content-Disposition: inline; filename=0001-Simplify-cl-get-using-plist-member.patch Content-Description: patch >From 760926c3b3bc36a8ac6854402e33d768c9e33fb1 Mon Sep 17 00:00:00 2001 From: Noam Postavsky 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 --=-=-=--