Package: emacs;
Reported by: Tino Calancha <tino.calancha <at> gmail.com>
Date: Wed, 5 Jul 2017 03:24:02 UTC
Severity: wishlist
Found in version 26.0.50
Done: Tino Calancha <tino.calancha <at> gmail.com>
Bug is archived. No further changes may be made.
View this message in rfc822 format
From: Tino Calancha <tino.calancha <at> gmail.com> To: 27584 <at> debbugs.gnu.org Cc: Nicolas Petton <nicolas <at> petton.fr>, stefan monnier <monnier <at> iro.umontreal.ca> Subject: bug#27584: 26.0.50; alist-get: Add optional arg TESTFN Date: Thu, 06 Jul 2017 15:05:12 +0900
Tino Calancha <tino.calancha <at> gmail.com> writes:
> On Wed, 5 Jul 2017, Nicolas Petton wrote:
>
>> Thanks, I like your changes. If this is going to be installed, could
>> you add tests to map-tests.el as well?
OK, done!
(See patch below)
I have a few questions:
1. In my patch `assoc-predicate' is a defsubst.
Should does exit at all?
If yes:
*) should be a defun instead?
**) should be named `assoc-predicate' or differently?
2. Should i collapse those 3 new 'etc/NEWS' entries in just 1 or 2?
--8<-----------------------------cut here---------------start------------->8---
commit a7f6ac2a09de893a42b086ec2dabbeeac7ba4cb4
Author: Tino Calancha <tino.calancha <at> gmail.com>
Date: Thu Jul 6 14:47:43 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.
* 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 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 13805ce0da..a395ac7aec 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1050,6 +1050,13 @@ break.
* 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
;;;; 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)
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))))
commit 4bb22ad2203ac54e5f873fcf624e26642e1557c1
Author: Tino Calancha <tino.calancha <at> gmail.com>
Date: Thu Jul 6 14:48:44 2017 +0900
assoc-predicate: New defsubst
* lisp/subr.el (assoc-predicate): New defsubst.
(alist-get):
* lisp/emacs-lisp/gv.el (alist-get): Use it.
* doc/lispref/lists.texi (Association Lists): Update manual.
* etc/NEWS: Announce the feature.
diff --git a/doc/lispref/lists.texi b/doc/lispref/lists.texi
index d2ae3028d8..98a79990a4 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1589,6 +1589,24 @@ Association Lists
@end smallexample
@end defun
+@defun assoc-predicate key alist test
+This function is like @code{assoc} in that it returns the first
+association for @var{key} in @var{alist}, but it makes the comparison
+using @code{test} instead of @code{equal}. @code{assoc-predicate}
+returns @code{nil} if no association in @var{alist} has a @sc{car},
+@var{x}, satisfying @code{(funcall test x key)}.
+
+@smallexample
+(setq leaves
+ '(("simple leaves" . oak)
+ ("compound leaves" . horsechestnut)))
+
+(assoc-predicate "simple leaves" leaves 'string=)
+ @result{} ("simple leaves" . oak)
+@end smallexample
+
+@end defun
+
@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
diff --git a/etc/NEWS b/etc/NEWS
index a395ac7aec..4d23563215 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1051,6 +1051,9 @@ break.
* Lisp Changes in Emacs 26.1
+++
+** New defsubst 'assoc-predicate'.
+
++++
** New optional argument FULL in 'assoc-default', to return the full
matching element.
diff --git a/lisp/emacs-lisp/gv.el b/lisp/emacs-lisp/gv.el
index 166881a458..29b85e280e 100644
--- a/lisp/emacs-lisp/gv.el
+++ b/lisp/emacs-lisp/gv.el
@@ -381,7 +381,7 @@ setf
(macroexp-let2 macroexp-copyable-p k key
(gv-letplace (getter setter) alist
(macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq)))
- (assoc-default ,k ,getter ,testfn nil 'full)
+ (assoc-predicate ,k ,getter ,testfn)
(assq ,k ,getter))
(funcall do (if (null default) `(cdr ,p)
`(if ,p (cdr ,p) ,default))
diff --git a/lisp/subr.el b/lisp/subr.el
index 01c6c1628f..1d1f39731f 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -674,6 +674,10 @@ assoc-default
(setq tail (cdr tail)))
value))
+(defsubst assoc-predicate (key alist test)
+ "Like `assoc' but compare keys with TEST."
+ (assoc-default key alist test nil 'full))
+
(defun assoc-ignore-case (key alist)
"Like `assoc', but ignores differences in case and text representation.
KEY must be a string. Upper-case and lower-case letters are treated as equal.
@@ -739,7 +743,7 @@ alist-get
means to remove KEY from ALIST if the new value is `eql' to DEFAULT."
(ignore remove) ;;Silence byte-compiler.
(let ((x (if (and testfn (not (eq testfn 'eq)))
- (assoc-default key alist testfn nil 'full)
+ (assoc-predicate key alist testfn)
(assq key alist))))
(if x (cdr x) default)))
--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-06
Repository revision: 7a0170de20fe1225d3eeac099d1e61a0c0410bf3
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.