From: Tino Calancha <tino.calancha@gmail.com>
To: 27584@debbugs.gnu.org
Cc: nicolas petton <nicolas@petton.fr>,
stefan monnier <monnier@iro.umontreal.ca>
Subject: bug#27584: 26.0.50; alist-get: Add optional arg TESTFN
Date: Wed, 05 Jul 2017 12:22:44 +0900 [thread overview]
Message-ID: <87tw2rva7v.fsf@calancha-pc> (raw)
Severity: wishlist
X-Debbugs-CC: Nicolas Petton <nicolas@petton.fr>, Stefan Monnier <monnier@iro.umontreal.ca>
Consider the following question:
https://emacs.stackexchange.com/questions/33892/replace-element-of-alist-using-equal-even-if-key-does-not-exist/33893#33893
1. The OP wants to update an alist without adding duplicates,
2. but he doesn't want to restrict the lookup in the alist to 'eq'.
The OP realized that
(setf (alist-get key alist) val)
is not an option because, `alist-get' assumes 'eq' in the lookup.
Then he writes his own function:
;; docstrig omitted:
(defun alist-set (key val alist &optional symbol)
(if-let ((pair (if symbol (assq key alist) (assoc key alist))))
(setcdr pair val)
(push (cons key val) alist))
alist)
* In the same thread, Drew suggests to add an optional arg TESTFN in `alist-get'.
* We might also tweak `map.el' so that the following code works:
(progn
(setq map (list (cons "a" 1) (cons "b" 2)))
(require 'map)
(map-put map "a" 'foo 'equal)
map)
=> (("a" . foo) ("b" . 2))
;; Without 'equal in `map-put' that would yield:
;; (("a" . foo) ("a" . 1) ("b" . 2))
--8<-----------------------------cut here---------------start------------->8---
commit 2c020d77c7e74b8ca415cb6370aac5bac86df452
Author: Tino Calancha <tino.calancha@gmail.com>
Date: Wed Jul 5 12:18:53 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 (assoc-default): Add optional arg FULL.
(alist-get)
* 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.
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index 8eab2818f9..d2ae3028d8 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1589,10 +1589,14 @@ 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
+@defun alist-get key alist &optional default remove testfn
+This function is like @code{assq} when @var{testfn} is @code{nil},
+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}.
+When @var{testfn} is non-@code{nil}, it returns @var{value} if @var{key}
+is equal to the car of an element of @var{alist}. The equality is
+tested with @var{testfn}.
If @var{key} is not found in @var{alist}, it returns @var{default}.
This is a generalized variable (@pxref{Generalized Variables}) that
@@ -1640,7 +1644,7 @@ Association Lists
@end smallexample
@end defun
-@defun assoc-default key alist &optional test default
+@defun assoc-default key alist &optional test default full
This function searches @var{alist} for a match for @var{key}. For each
element of @var{alist}, it compares the element (if it is an atom) or
the element's @sc{car} (if it is a cons) against @var{key}, by calling
@@ -1652,7 +1656,8 @@ Association Lists
If an alist element matches @var{key} by this criterion,
then @code{assoc-default} returns a value based on this element.
-If the element is a cons, then the value is the element's @sc{cdr}.
+If the element is a cons, then the value is the element if @var{full}
+is non-@code{nil}, or the element's @sc{cdr} if @var{full} is @code{nil}.
Otherwise, the return value is @var{default}.
If no alist element matches @var{key}, @code{assoc-default} returns
diff --git a/etc/NEWS b/etc/NEWS
index 83cb73f4a9..dca9809795 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1046,6 +1046,11 @@ break.
\f
* Lisp Changes in Emacs 26.1
+** New optional argument FULL in 'assoc-default', to return the full
+matching element.
+
+** 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..166881a458 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-default ,k ,getter ,testfn nil 'full)
+ (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..f3850f5844 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -93,11 +93,11 @@ 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, TESTFN is used to lookup KEY if non-nil or `eql' if nil.
MAP can be a list, hash-table or array."
(declare
@@ -106,30 +106,31 @@ 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'.
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..01c6c1628f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -650,23 +650,27 @@ copy-tree
\f
;;;; Various list-search functions.
-(defun assoc-default (key alist &optional test default)
+(defun assoc-default (key alist &optional test default full)
"Find object KEY in a pseudo-alist ALIST.
ALIST is a list of conses or objects. Each element
(or the element's car, if it is a cons) is compared with KEY by
calling TEST, with two arguments: (i) the element or its car,
and (ii) KEY.
If that is non-nil, the element matches; then `assoc-default'
- returns the element's cdr, if it is a cons, or DEFAULT if the
- element is not a cons.
+ returns the element, if it is a cons and FULL is non-nil,
+ or the element's cdr, if it is a cons and FULL is nil,
+ or DEFAULT if the element is not a cons.
If no element matches, the value is nil.
If TEST is omitted or nil, `equal' is used."
(let (found (tail alist) value)
(while (and tail (not found))
(let ((elt (car tail)))
- (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
- (setq found t value (if (consp elt) (cdr elt) default))))
+ (when (funcall (or test 'equal) (if (consp elt) (car elt) elt) key)
+ (setq found t
+ value (cond ((consp elt)
+ (if full elt (cdr elt)))
+ (t default)))))
(setq tail (cdr tail)))
value))
@@ -725,15 +729,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 (and testfn (not (eq testfn 'eq)))
+ (assoc-default key alist testfn nil 'full)
+ (assq key alist))))
(if x (cdr x) default)))
(defun remove (elt seq)
--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-05
Repository revision: 5d62247323f53f3ae9c7d9f51e951635887b2fb6
next reply other threads:[~2017-07-05 3:22 UTC|newest]
Thread overview: 48+ messages / expand[flat|nested] mbox.gz Atom feed top
2017-07-05 3:22 Tino Calancha [this message]
2017-07-05 8:53 ` bug#27584: 26.0.50; alist-get: Add optional arg TESTFN Tino Calancha
2017-07-05 9:19 ` Nicolas Petton
2017-07-05 13:18 ` Tino Calancha
2017-07-06 6:05 ` Tino Calancha
2017-07-06 6:13 ` Stefan Monnier
2017-07-06 6:20 ` Tino Calancha
2017-07-06 9:36 ` Nicolas Petton
2017-07-06 10:55 ` Tino Calancha
2017-07-06 11:06 ` Nicolas Petton
2017-07-06 15:07 ` Stefan Monnier
2017-07-07 6:48 ` Tino Calancha
2017-07-07 7:46 ` Eli Zaretskii
2017-07-07 8:09 ` Nicolas Petton
2017-07-07 15:53 ` Stefan Monnier
2017-07-09 14:45 ` Tino Calancha
2017-07-10 12:04 ` Michael Heerdegen
2017-07-10 12:28 ` Tino Calancha
2017-07-10 12:38 ` Michael Heerdegen
2017-07-10 12:47 ` Michael Heerdegen
2017-07-10 13:02 ` Tino Calancha
2017-07-10 13:18 ` Michael Heerdegen
2017-07-10 12:50 ` Michael Heerdegen
2017-07-06 14:56 ` Nicolas Petton
2017-07-07 6:39 ` Tino Calancha
2017-07-07 8:11 ` Nicolas Petton
2017-07-07 8:22 ` Tino Calancha
2017-07-07 8:34 ` Nicolas Petton
2017-07-07 15:49 ` Stefan Monnier
2017-07-07 15:54 ` Nicolas Petton
2017-07-07 19:47 ` Nicolas Petton
2017-07-08 6:30 ` Eli Zaretskii
2017-07-08 7:02 ` Tino Calancha
2017-07-08 7:14 ` Eli Zaretskii
2017-07-08 11:32 ` Nicolas Petton
2017-07-08 11:46 ` Eli Zaretskii
2017-07-09 14:48 ` Tino Calancha
2017-07-09 19:18 ` Nicolas Petton
2017-07-11 8:08 ` Nicolas Petton
2017-07-11 9:19 ` Tino Calancha
2017-07-12 17:36 ` Michael Heerdegen
2017-07-14 5:19 ` Tino Calancha
2017-07-14 11:16 ` Nicolas Petton
2017-07-17 13:38 ` Tino Calancha
2017-08-01 16:37 ` Nicolas Petton
2017-08-01 16:49 ` Nicolas Petton
2017-08-01 18:53 ` Eli Zaretskii
2017-07-08 11:29 ` Nicolas Petton
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87tw2rva7v.fsf@calancha-pc \
--to=tino.calancha@gmail.com \
--cc=27584@debbugs.gnu.org \
--cc=monnier@iro.umontreal.ca \
--cc=nicolas@petton.fr \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).