From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.devel Subject: Re: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of code Date: Tue, 29 Nov 2016 17:28:57 +0900 Message-ID: <87oa0ysn92.fsf@gmail.com> References: <87zikk9biz.fsf@gmail.com> <83eg1vzfdv.fsf@gnu.org> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain; charset=utf-8 Content-Transfer-Encoding: quoted-printable X-Trace: blaine.gmane.org 1480408159 1463 195.159.176.226 (29 Nov 2016 08:29:19 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 29 Nov 2016 08:29:19 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) Cc: tino.calancha@gmail.com, emacs-devel@gnu.org To: Eli Zaretskii , =?utf-8?Q?Cl=C3=A9ment?= Pit--Claudel Original-X-From: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Tue Nov 29 09:29:11 2016 Return-path: Envelope-to: ged-emacs-devel@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 1cBdmo-0007aW-Hf for ged-emacs-devel@m.gmane.org; Tue, 29 Nov 2016 09:29:10 +0100 Original-Received: from localhost ([::1]:35311 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cBdms-0006Xq-7y for ged-emacs-devel@m.gmane.org; Tue, 29 Nov 2016 03:29:14 -0500 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:57954) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1cBdml-0006Xh-Mx for emacs-devel@gnu.org; Tue, 29 Nov 2016 03:29:08 -0500 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1cBdmi-0000ms-BE for emacs-devel@gnu.org; Tue, 29 Nov 2016 03:29:07 -0500 Original-Received: from mail-pg0-x243.google.com ([2607:f8b0:400e:c05::243]:34068) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1cBdmh-0000mc-S0; Tue, 29 Nov 2016 03:29:04 -0500 Original-Received: by mail-pg0-x243.google.com with SMTP id e9so15669904pgc.1; Tue, 29 Nov 2016 00:29:03 -0800 (PST) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20120113; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version:content-transfer-encoding; bh=vY253rb0RDJC8BI0Bj4ZW1p9/E8265h30P/dAg22qKU=; b=dh9v6gVOWGvL3T8oTB7QnI63V4V2fOJXJj5jGiG4ipaFq5/qI9foeQb6qxlol+KwkN jGBfkGj8GQVp1T/7w0a3xS6/9Xmb2+7s7Y5uMDzimHqlSLoOj32PEC6O8cAOA+HteIXV YMbXnxJRjNPbTNlIHhWyUZNPENXfA1eTaWZuceJZM9GjXAk8Wy3AoVJo3kSWltQSQO9J aPMvycXsnq4hvS7euKgczYbDZSZ+XlRxn+VZWDjPR93hvwmhl5vZss6KYNP3/WbmK1VY 60ZLAK40eBuhmPrAutTT0A3rt+K79T2v/PPTuSOp0ibtWXhYTC+IimGOHzbtZCzrOV29 7NJQ== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20130820; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version:content-transfer-encoding; bh=vY253rb0RDJC8BI0Bj4ZW1p9/E8265h30P/dAg22qKU=; b=dSn2GQ0o90DUkbZA50oI1M9fRujf+LDtcwyIFSylKrXTpvfzWyK4Ejmi8HGHaeZj8X JtNd2mNOisipVrMLOoggIAr6Ytd237WYrFczPRMNmGyc45J606Ys96wZzxnuRUIfN1Wi 62TskzNBYSVboO9um2+4hqCMFshdAThB0Z3ubiX783uKoEZxQzoR+8rXGJnlnJXl/08B QVgGOxLd13KWTKQYS7LuMDtlUmvquIGREyNTqP6gWbwBb+DTKPRr52ymt7m4mkWUZ03L lmoCqgLvDv0dqYKztdPgrBhUPRINFDrLaJMrg1JFbr57Wh2Xzt2iDvjQCIPBBaXynDLm h9Dw== X-Gm-Message-State: AKaTC001asNO/H1lj0S8dMyESoG3F4eCW35dMxLuWS7XGhIk7fiseDJSfFWJfgTRDeFGSg== X-Received: by 10.98.163.71 with SMTP id s68mr26188108pfe.60.1480408142148; Tue, 29 Nov 2016 00:29:02 -0800 (PST) Original-Received: from calancha-pc (177.192.218.133.dy.bbexcite.jp. [133.218.192.177]) by smtp.gmail.com with ESMTPSA id s8sm92818578pfj.45.2016.11.29.00.29.00 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 29 Nov 2016 00:29:01 -0800 (PST) In-Reply-To: (=?utf-8?Q?=22Cl=C3=A9ment?= Pit--Claudel"'s message of "Mon, 28 Nov 2016 13:17:08 -0500") X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 2607:f8b0:400e:c05::243 X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.21 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+ged-emacs-devel=m.gmane.org@gnu.org Original-Sender: "Emacs-devel" Xref: news.gmane.org gmane.emacs.devel:209708 Archived-At: Cl=C3=A9ment Pit--Claudel writes: > On 2016-11-28 12:24, Eli Zaretskii wrote: >>> From: Tino Calancha >>> Date: Mon, 28 Nov 2016 18:52:36 +0900 >>> Cc: tino.calancha@gmail.com >>> >>> how about following patch? >>> It prevent some duplication of code in subr.el, and it adds >>> a new test. >>=20 >> What about the overhead of a function call? These functions are >> likely to be invoked in loops. >>=20 >> Should we make the common part a defsubst? > > Would defsubst be enough? I think you'd want a defmacro. Otherwise, > you'll still pay for all the funcalls to #'car and #'cdr, won't you? Following patch makes `assq-delete-all-1' a macro: ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;;;; >From 310fc091f1adbf7781e7069b313c03bb31e735a8 Mon Sep 17 00:00:00 2001 From: Tino Calancha Date: Tue, 29 Nov 2016 17:15:30 +0900 Subject: [PATCH] assq-delete-all, rassq-delete-all: Avoid duplication of co= de See discussion in: https://lists.gnu.org/archive/html/emacs-devel/2016-11/msg00592.html * lisp/subr.el (assq-delete-all-1): New macro. (assq-delete-all, rassq-delete-all): Use it. * test/lisp/subr-tests.el (subr-test-assq-delete-all): New test. --- lisp/subr.el | 39 +++++++++++++++++++-------------------- test/lisp/subr-tests.el | 12 ++++++++++++ 2 files changed, 31 insertions(+), 20 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 5da5bf8..69827be 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -570,35 +570,34 @@ member-ignore-case (setq list (cdr list))) list) =20 +(defmacro assq-delete-all-1 (elt alist rassq) + (let ((lst (make-symbol "alist")) + (tail (make-symbol "tail")) + (entry (make-symbol "entry"))) + `(let ((,lst ,alist) + (,tail ,alist)) + (while (and (consp (car ,lst)) + (eq ,(if rassq `(cdar ,lst) `(caar ,lst)) ,elt)) + (setq ,lst (cdr ,lst))) + (while (cdr ,tail) + (let ((,entry (cdr ,tail))) + (if (and (consp (car ,entry)) + (eq ,(if rassq `(cdar ,entry) `(caar ,entry)) ,elt)) + (setcdr ,tail (cdr ,entry)) + (setq ,tail ,entry)))) + ,lst))) + (defun assq-delete-all (key alist) "Delete from ALIST all elements whose car is `eq' to KEY. Return the modified alist. Elements of ALIST that are not conses are ignored." - (while (and (consp (car alist)) - (eq (car (car alist)) key)) - (setq alist (cdr alist))) - (let ((tail alist) tail-cdr) - (while (setq tail-cdr (cdr tail)) - (if (and (consp (car tail-cdr)) - (eq (car (car tail-cdr)) key)) - (setcdr tail (cdr tail-cdr)) - (setq tail tail-cdr)))) - alist) + (assq-delete-all-1 key alist nil)) =20 (defun rassq-delete-all (value alist) "Delete from ALIST all elements whose cdr is `eq' to VALUE. Return the modified alist. Elements of ALIST that are not conses are ignored." - (while (and (consp (car alist)) - (eq (cdr (car alist)) value)) - (setq alist (cdr alist))) - (let ((tail alist) tail-cdr) - (while (setq tail-cdr (cdr tail)) - (if (and (consp (car tail-cdr)) - (eq (cdr (car tail-cdr)) value)) - (setcdr tail (cdr tail-cdr)) - (setq tail tail-cdr)))) - alist) + (assq-delete-all-1 value alist 'rassq)) =20 (defun alist-get (key alist &optional default remove) "Return the value associated with KEY in ALIST, using `assq'. diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el index ce21290..018c13b 100644 --- a/test/lisp/subr-tests.el +++ b/test/lisp/subr-tests.el @@ -224,5 +224,17 @@ (error-message-string (should-error (version-to-list "beta22= _8alpha3"))) "Invalid version syntax: `beta22_8alpha3' (must start with a= number)")))) =20 +(ert-deftest subr-test-assq-delete-all () + "Tests for `assq-delete-all' and `rassq-delete-all'." + (let ((alist '((foo . 1) (bar . 1) (baz . 1) (foo . 2)))) + (should (equal '((bar . 1) (baz . 1)) + (assq-delete-all 'foo (copy-tree alist)))) + (should (equal '((foo . 2)) (rassq-delete-all 1 (copy-tree alist)))) + (should (equal alist (assq-delete-all 'qux (copy-tree alist)))) + (should (equal alist (rassq-delete-all 9 (copy-tree alist)))) + (should (equal alist + (assq-delete-all (make-symbol "foo") (copy-tree alist))= )) + (should (equal alist (rassq-delete-all 1.0 (copy-tree alist)))))) + (provide 'subr-tests) ;;; subr-tests.el ends here --=20 2.10.2 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;= ;;;; In GNU Emacs 26.0.50.1 (x86_64-pc-linux-gnu, GTK+ Version 3.22.4) of 2016-11-28 Repository revision: 2c8a7e50d24daf19ea7d86f1cfeaa98a41c56085