From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.org!.POSTED!not-for-mail From: Tino Calancha Newsgroups: gmane.emacs.bugs Subject: bug#27584: 26.0.50; alist-get: Add optional arg TESTFN Date: Tue, 11 Jul 2017 18:19:56 +0900 Message-ID: <871spnwcsj.fsf@calancha-pc> References: <87tw2rva7v.fsf@calancha-pc> <87mv8j6y1z.fsf@petton.fr> <87y3s2m76v.fsf@calancha-pc> <8760f562bo.fsf@petton.fr> <877ezk3g4p.fsf@calancha-pc> <874luovf7a.fsf@petton.fr> <87shi8tzkr.fsf@petton.fr> <8737a858so.fsf@petton.fr> <83wp7jl9uf.fsf@gnu.org> <83lgnzl7rl.fsf@gnu.org> <87inj3411g.fsf@petton.fr> <83a84fkv7i.fsf@gnu.org> <8737a3qttj.fsf@strawberry> NNTP-Posting-Host: blaine.gmane.org Mime-Version: 1.0 Content-Type: text/plain X-Trace: blaine.gmane.org 1499764886 21543 195.159.176.226 (11 Jul 2017 09:21:26 GMT) X-Complaints-To: usenet@blaine.gmane.org NNTP-Posting-Date: Tue, 11 Jul 2017 09:21:26 +0000 (UTC) User-Agent: Gnus/5.13 (Gnus v5.13) Emacs/26.0.50 (gnu/linux) Cc: 27584@debbugs.gnu.org, monnier@iro.umontreal.ca To: Nicolas Petton Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane.org@gnu.org Tue Jul 11 11:21:19 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 1dUrLx-0004kq-Vs for geb-bug-gnu-emacs@m.gmane.org; Tue, 11 Jul 2017 11:21:10 +0200 Original-Received: from localhost ([::1]:45091 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dUrM3-000098-3y for geb-bug-gnu-emacs@m.gmane.org; Tue, 11 Jul 2017 05:21:15 -0400 Original-Received: from eggs.gnu.org ([2001:4830:134:3::10]:42136) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1dUrLv-00008v-VM for bug-gnu-emacs@gnu.org; Tue, 11 Jul 2017 05:21:09 -0400 Original-Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1dUrLq-0003Iv-Tx for bug-gnu-emacs@gnu.org; Tue, 11 Jul 2017 05:21:07 -0400 Original-Received: from debbugs.gnu.org ([208.118.235.43]:58925) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1dUrLq-0003Ig-Q0 for bug-gnu-emacs@gnu.org; Tue, 11 Jul 2017 05:21:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1dUrLq-0001qA-Do for bug-gnu-emacs@gnu.org; Tue, 11 Jul 2017 05:21:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Tino Calancha Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Tue, 11 Jul 2017 09:21:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 27584 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: Original-Received: via spool by 27584-submit@debbugs.gnu.org id=B27584.14997648106996 (code B ref 27584); Tue, 11 Jul 2017 09:21:02 +0000 Original-Received: (at 27584) by debbugs.gnu.org; 11 Jul 2017 09:20:10 +0000 Original-Received: from localhost ([127.0.0.1]:33369 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dUrL0-0001om-10 for submit@debbugs.gnu.org; Tue, 11 Jul 2017 05:20:10 -0400 Original-Received: from mail-pg0-f52.google.com ([74.125.83.52]:36602) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1dUrKy-0001oZ-Lt for 27584@debbugs.gnu.org; Tue, 11 Jul 2017 05:20:09 -0400 Original-Received: by mail-pg0-f52.google.com with SMTP id u62so63606705pgb.3 for <27584@debbugs.gnu.org>; Tue, 11 Jul 2017 02:20:08 -0700 (PDT) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gmail.com; s=20161025; h=from:to:cc:subject:references:date:in-reply-to:message-id :user-agent:mime-version; bh=DL5WzO76JDOQEH0RMHjj8gPlQWXOTsDSsy+pRZnqEHg=; b=Ei1sRmo11eBEREhyFYqxBShAe0FpCt95q3d4MHwEYjUjsnxgPfGnCGxsTiMnpiXsCN 7YZJpcVZIrj/KkooeI4t9KuAHxqtmK/f4zLS9isauVdH2i5tYsXyHZvWq6wj4tWLB7CG QXtBZ6NbHVJ9fJOWhb0cDA9Fu58eMUnutP3XLXScJL7vUPwuur/Wo5cTPn8CL3fsWAv3 QcEychsipo9YvbV5YjRScOolPl6Pkm0Ob48NGpj3IEj27l/k873qPoVY63Gak96i/PMH GE7ym+qFByItSvtKBrzxGFl4NXh8qnsfGxuqRs31IMrxlLPeMkOmS80tiknGdg8gA0w/ Hnng== X-Google-DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=1e100.net; s=20161025; h=x-gm-message-state:from:to:cc:subject:references:date:in-reply-to :message-id:user-agent:mime-version; bh=DL5WzO76JDOQEH0RMHjj8gPlQWXOTsDSsy+pRZnqEHg=; b=XG66tcocz2gkcr2SsmSCRvb6i2sUicFSc3toZRbhBkGDfmbuLEHnaM10memS+0O0sb zqg4eacyYHEHVSY+E1FaCnZRKgn489Ne7jql8Up9LwfVdpM36vNgYnw04SgzopZpIo5U gLz5d3vbxzZpO2QW/RYvBDShkkIw4up9KgKuY8U2mENBfeSE8gzB8JLTwc6aF7DSdL6W plWfHUvdGdp/q6ZcSdXnwMsL6uky6/GL2XPjwsOqUqQw35hP7qhRURtNXm4CkG054Yb/ O5h7W03j6DmbGVSsmgwEHVob+S0Y0lS+4mZsFCsy9UhLwUzQtsah919XGGoAVNsrHp0z LBTQ== X-Gm-Message-State: AIVw111Chrx51l/wRla0WC99klzfoxNb/YPJWkUS6Vb4L4Av1oeF7t86 BBdKjPwpzLEQ6g== X-Received: by 10.99.163.26 with SMTP id s26mr19319026pge.232.1499764802645; Tue, 11 Jul 2017 02:20:02 -0700 (PDT) Original-Received: from calancha-pc (170.224.128.101.dy.bbexcite.jp. [101.128.224.170]) by smtp.gmail.com with ESMTPSA id w66sm29859111pfi.63.2017.07.11.02.20.00 (version=TLS1_2 cipher=ECDHE-RSA-CHACHA20-POLY1305 bits=256/256); Tue, 11 Jul 2017 02:20:02 -0700 (PDT) In-Reply-To: <8737a3qttj.fsf@strawberry> (Nicolas Petton's message of "Tue, 11 Jul 2017 10:08:40 +0200") 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:134428 Archived-At: Nicolas Petton writes: > Tino, would you like to adapt your patch to use the new assoc? Here we are: --8<-----------------------------cut here---------------start------------->8--- commit 2a9fb44ddae0acbd09c3123f06981d291163e765 Author: Tino Calancha Date: Tue Jul 11 18:17:00 2017 +0900 alist-get: Add optional arg TESTFN If TESTFN is non-nil, then it is the predicate to lookup the alist. Otherwise, use 'eq' (Bug#27584). * lisp/subr.el (alist-get): Add optional arg FULL. * lisp/emacs-lisp/map.el (map-elt, map-put): Add optional arg TESTFN. * lisp/emacs-lisp/gv.el (alist-get): Update expander. * doc/lispref/lists.texi (Association Lists): Update manual. * etc/NEWS: Announce the changes. * test/lisp/emacs-lisp/map-tests.el (test-map-put-testfn-alist) (test-map-elt-testfn): New tests. diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi index 966d8f18b1..39353b6de6 100644 --- a/doc/lispref/lists.texi +++ b/doc/lispref/lists.texi @@ -1589,16 +1589,20 @@ Association Lists @end smallexample @end defun -@defun alist-get key alist &optional default remove -This function is like @code{assq}, but instead of returning the entire -association for @var{key} in @var{alist}, -@w{@code{(@var{key} . @var{value})}}, it returns just the @var{value}. -If @var{key} is not found in @var{alist}, it returns @var{default}. - -This is a generalized variable (@pxref{Generalized Variables}) that -can be used to change a value with @code{setf}. When using it to set -a value, optional argument @var{remove} non-@code{nil} means to remove -@var{key} from @var{alist} if the new value is @code{eql} to @var{default}. +@defun alist-get key alist &optional default remove testfn +This function is similar to @code{assq}. It finds the first +association @w{@code{(@var{key} . @var{value})}} by comparing +@var{key} with @var{alist} elements, and, if found, returns the +@var{value} of that association. If no association is found, the +function returns @var{default}. Comparison of @var{key} against +@var{alist} elements uses the function specified by @var{testfn}, +defaulting to @code{eq}. + +The return value is a generalized variable (@pxref{Generalized +Variables}) that can be used to change a value with @code{setf}. When +using it to set a value, optional argument @var{remove} non-@code{nil} +means to remove @var{key}'s association from @var{alist} if the new +value is @code{eql} to @var{default}. @end defun @defun rassq value alist diff --git a/etc/NEWS b/etc/NEWS index 68ebdb3c15..eb61e7d182 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1105,6 +1105,9 @@ break. * Lisp Changes in Emacs 26.1 ++++ +** New optional argument TESTFN in 'alist-get', 'map-elt' and 'map-put'. + ** New function 'seq-set-equal-p' to check if SEQUENCE1 and SEQUENCE2 contain the same elements, regardless of the order. diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el index c5c12a6414..27376fc7f9 100644 --- a/lisp/emacs-lisp/gv.el +++ b/lisp/emacs-lisp/gv.el @@ -377,10 +377,12 @@ setf `(with-current-buffer ,buf (set (make-local-variable ,var) ,v)))) (gv-define-expander alist-get - (lambda (do key alist &optional default remove) + (lambda (do key alist &optional default remove testfn) (macroexp-let2 macroexp-copyable-p k key (gv-letplace (getter setter) alist - (macroexp-let2 nil p `(assq ,k ,getter) + (macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq))) + (assoc ,k ,getter ,testfn) + (assq ,k ,getter)) (funcall do (if (null default) `(cdr ,p) `(if ,p (cdr ,p) ,default)) (lambda (v) diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el index a89457e877..31ba075c40 100644 --- a/lisp/emacs-lisp/map.el +++ b/lisp/emacs-lisp/map.el @@ -4,7 +4,7 @@ ;; Author: Nicolas Petton ;; Keywords: convenience, map, hash-table, alist, array -;; Version: 1.1 +;; Version: 1.2 ;; Package: map ;; Maintainer: emacs-devel@gnu.org @@ -93,11 +93,13 @@ map-let ((arrayp ,map-var) ,(plist-get args :array)) (t (error "Unsupported map: %s" ,map-var))))) -(defun map-elt (map key &optional default) +(defun map-elt (map key &optional default testfn) "Lookup KEY in MAP and return its associated value. If KEY is not found, return DEFAULT which defaults to nil. -If MAP is a list, `eql' is used to lookup KEY. +If MAP is a list, `eql' is used to lookup KEY. Optional argument +TESTFN, if non-nil, means use its function definition instead of +`eql'. MAP can be a list, hash-table or array." (declare @@ -106,30 +108,33 @@ map-elt (gv-letplace (mgetter msetter) `(gv-delay-error ,map) (macroexp-let2* nil ;; Eval them once and for all in the right order. - ((key key) (default default)) + ((key key) (default default) (testfn testfn)) `(if (listp ,mgetter) ;; Special case the alist case, since it can't be handled by the ;; map--put function. ,(gv-get `(alist-get ,key (gv-synthetic-place ,mgetter ,msetter) - ,default) + ,default nil ,testfn) do) ,(funcall do `(map-elt ,mgetter ,key ,default) (lambda (v) `(map--put ,mgetter ,key ,v))))))))) (map--dispatch map - :list (alist-get key map default) + :list (alist-get key map default nil testfn) :hash-table (gethash key map default) :array (if (and (>= key 0) (< key (seq-length map))) (seq-elt map key) default))) -(defmacro map-put (map key value) +(defmacro map-put (map key value &optional testfn) "Associate KEY with VALUE in MAP and return VALUE. If KEY is already present in MAP, replace the associated value with VALUE. +When MAP is a list, test equality with TESTFN if non-nil, otherwise use `eql'. +TESTFN, if non-nil, means use its function definition instead of +`eql'. MAP can be a list, hash-table or array." - `(setf (map-elt ,map ,key) ,value)) + `(setf (map-elt ,map ,key nil ,testfn) ,value)) (defun map-delete (map key) "Delete KEY from MAP and return MAP. diff --git a/lisp/subr.el b/lisp/subr.el index a9edff6166..d9d918ed12 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -725,15 +725,18 @@ rassq-delete-all (setq tail tail-cdr)))) alist) -(defun alist-get (key alist &optional default remove) - "Return the value associated with KEY in ALIST, using `assq'. +(defun alist-get (key alist &optional default remove testfn) + "Return the value associated with KEY in ALIST. If KEY is not found in ALIST, return DEFAULT. +Use TESTFN to lookup in the alist if non-nil. Otherwise, use `assq'. This is a generalized variable suitable for use with `setf'. When using it to set a value, optional argument REMOVE non-nil means to remove KEY from ALIST if the new value is `eql' to DEFAULT." (ignore remove) ;;Silence byte-compiler. - (let ((x (assq key alist))) + (let ((x (if (not testfn) + (assq key alist) + (assoc key alist testfn)))) (if x (cdr x) default))) (defun remove (elt seq) diff --git a/test/lisp/emacs-lisp/map-tests.el b/test/lisp/emacs-lisp/map-tests.el index 07e85cc539..15b0655040 100644 --- a/test/lisp/emacs-lisp/map-tests.el +++ b/test/lisp/emacs-lisp/map-tests.el @@ -63,6 +63,11 @@ with-maps-do (with-maps-do map (should (= 5 (map-elt map 7 5))))) +(ert-deftest test-map-elt-testfn () + (let ((map (list (cons "a" 1) (cons "b" 2)))) + (should-not (map-elt map "a")) + (should (map-elt map "a" nil 'equal)))) + (ert-deftest test-map-elt-with-nil-value () (should (null (map-elt '((a . 1) (b)) @@ -94,6 +99,13 @@ with-maps-do (should (eq (map-elt alist 2) 'b)))) +(ert-deftest test-map-put-testfn-alist () + (let ((alist (list (cons "a" 1) (cons "b" 2)))) + (map-put alist "a" 3 'equal) + (should-not (cddr alist)) + (map-put alist "a" 9) + (should (cddr alist)))) + (ert-deftest test-map-put-return-value () (let ((ht (make-hash-table))) (should (eq (map-put ht 'a 'hello) 'hello)))) --8<-----------------------------cut here---------------end--------------->8--- In GNU Emacs 26.0.50 (build 1, x86_64-pc-linux-gnu, GTK+ Version 3.22.11) of 2017-07-11 Repository revision: 0bece6c6815cc59e181817a2765a4ea752f34f56