bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

classic Classic list List threaded Threaded
45 messages Options
123
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Tino Calancha-2
Severity: wishlist
X-Debbugs-CC: Nicolas Petton <[hidden email]>, Stefan Monnier <[hidden email]>

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 <[hidden email]>
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.
 
 * 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)
--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



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Tino Calancha-2
>  
> -(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))

If we go in this direction, then i think it has sense to add
something with less parameters, like this:

(defsubst assoc-predicate (key alist test)
  "Like `assoc' but compare keys with TEST."
  (assoc-default key alist test nil 'full))



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Nicolas Petton-2
In reply to this post by Tino Calancha-2
Tino Calancha <[hidden email]> writes:

> 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:
Thanks, I like your changes.  If this is going to be installed, could
you add tests to map-tests.el as well?

Cheers,
Nico

signature.asc (482 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Tino Calancha-2


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?
Sure, i have that in mind.  I will prepare them by tomorrow while
Stefan take a look on it.

Cheers,
Tino



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Tino Calancha-2
Tino Calancha <[hidden email]> 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 <[hidden email]>
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 <[hidden email]>
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



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Stefan Monnier
> 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?
   
It's been called cl-assoc so far ;-)


        Stefan



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Tino Calancha-2


On Thu, 6 Jul 2017, Stefan Monnier wrote:

>> 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?
>
> It's been called cl-assoc so far ;-)
Some day your dream will be fulfilled, and `cl-lib' will be preloaded at
startup.  Then, we will not need things like `assoc-predicate'.



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Nicolas Petton-2
Tino Calancha <[hidden email]> writes:

>> It's been called cl-assoc so far ;-)

> Some day your dream will be fulfilled, and `cl-lib' will be preloaded at
> startup.  Then, we will not need things like `assoc-predicate'.

map.el could require cl-lib and use cl-assoc?

signature.asc (482 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Tino Calancha-2


On Thu, 6 Jul 2017, Nicolas Petton wrote:

> Tino Calancha <[hidden email]> writes:
>
>>> It's been called cl-assoc so far ;-)
>
>> Some day your dream will be fulfilled, and `cl-lib' will be preloaded at
>> startup.  Then, we will not need things like `assoc-predicate'.
>
> map.el could require cl-lib and use cl-assoc?
Actually, it already does require cl-lib, because the following chain:
* map.el requires `seq'
* seq.el requires `cl-lib'

Indeed, in my patch `assoc-predicate' doesn't appear in map.el,
so it's not just a matter of replace:
assoc-predicate ---> cl-assoc

`assoc-predicate' appears in the implementation (subr.el)
and setter expansion (gv.el) of `alist-get'.

Neither subr.el nor gv.el are requiring `cl-lib'.



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Nicolas Petton-2
Tino Calancha <[hidden email]> writes:

> `assoc-predicate' appears in the implementation (subr.el)
> and setter expansion (gv.el) of `alist-get'.
>
> Neither subr.el nor gv.el are requiring `cl-lib'.

Oh, right, indeed.

signature.asc (482 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Nicolas Petton-2
In reply to this post by Tino Calancha-2
Tino Calancha <[hidden email]> writes:


> 1. In my patch `assoc-predicate' is a defsubst.
>    Should does exit at all?

I would inline its call and use `assoc-default' directly, but I guess
it's a matter of taste.

But wouldn't it be better if `assoc' took an optional testfn?  I'm not
sure I like the `full' parameter in `assoc-default', and I think the
inconsistency of the return values between `assoc' and `assoc-default'
is already confusing.

Nico

signature.asc (482 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Stefan Monnier
In reply to this post by Tino Calancha-2
>>> 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?
>> It's been called cl-assoc so far ;-)
> Some day your dream will be fulfilled, and `cl-lib' will be preloaded at
> startup.

I'm not sure it's my dream, to tell you the truth: I like Scheme's
choice of not treating "keyword symbols" specially, so macros can use
them (because the keyword args aren't evaluated), but not functions.
This ensures that the cost of keyword-argument parsing is only paid
during macro expansion (where it's tolerable) but not at run-time
(where it's much too costly and hence absolutely requires
compiler-macro crutches).

> Then, we will not need things like `assoc-predicate'.

In reality, my intention, beside putting a smiley, was to point you to another
implementation which uses defun with a compiler-macro instead of
defsubst.  Actually your assoc-predicate might be a good candidate for
define-inline (which is in dire need of documentation.  I can't believe
its author still hasn't bothered to put even a docstring).

Something like

    (define-inline assoc-predicate (elem list &optional pred)
      (inline-letevals (elem list pred)
        (pcase (inline-const-val pred)
          ('eq (inline-quote (assq ,elem ,list)))
          ((or 'equal 'nil) (inline-quote (assoc ,elem ,list)))
          (_ (inline-quote (assoc-default ,elem ,list ,pred nil 'full))))))


-- Stefan



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Tino Calancha-2
In reply to this post by Nicolas Petton-2
Nicolas Petton <[hidden email]> writes:

> Tino Calancha <[hidden email]> writes:
>
>
>> 1. In my patch `assoc-predicate' is a defsubst.
>>    Should does exit at all?
>
> I would inline its call and use `assoc-default' directly, but I guess
> it's a matter of taste.
Following Stefan suggestion, we can optimize using a compiler macro.
Then, `assoc-default' is just the default case.
>
> But wouldn't it be better if `assoc' took an optional testfn?  I'm not
> sure I like the `full' parameter in `assoc-default', and I think the
> inconsistency of the return values between `assoc' and `assoc-default'
> is already confusing.
In fact, that would kill 2 birds in a shot.



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Tino Calancha-2
In reply to this post by Stefan Monnier
Stefan Monnier <[hidden email]> writes:


>>>> **) should be named `assoc-predicate' or differently?
>>> It's been called cl-assoc so far ;-)
>> Some day your dream will be fulfilled, and `cl-lib' will be preloaded at
>> startup.
>
> I'm not sure it's my dream, to tell you the truth: I like Scheme's
> choice of not treating "keyword symbols" specially, so macros can use
> them (because the keyword args aren't evaluated), but not functions.
> This ensures that the cost of keyword-argument parsing is only paid
> during macro expansion (where it's tolerable) but not at run-time
> (where it's much too costly and hence absolutely requires
> compiler-macro crutches).
thanks for th explanations.  I see your point now.

>> Then, we will not need things like `assoc-predicate'.
>
> In reality, my intention, beside putting a smiley, was to point you to another
> implementation which uses defun with a compiler-macro instead of
> defsubst.  Actually your assoc-predicate might be a good candidate for
> define-inline (which is in dire need of documentation.  I can't believe
> its author still hasn't bothered to put even a docstring).
>
> Something like
>
>     (define-inline assoc-predicate (elem list &optional pred)
>       (inline-letevals (elem list pred)
>         (pcase (inline-const-val pred)
>           ('eq (inline-quote (assq ,elem ,list)))
>           ((or 'equal 'nil) (inline-quote (assoc ,elem ,list)))
>           (_ (inline-quote (assoc-default ,elem ,list ,pred nil 'full))))))
Yes, that sounds much better!
I adapted your example into subr.el after stole from
`cl--compiler-macro-assoc' another optimization.
(See updated patch below)

Nico, one thing worries me is the following:
* After this patch, `map.el' v1.2 depends on Emacs version > 25:
* because it makes a call to `alist-get' with 5 parameters i.e., it
  uses TESTFN.
Is that a problem?

--8<-----------------------------cut here---------------start------------->8---
commit b4855d2d641b9fe4e6a49e898f797c40fe872281
Author: Tino Calancha <[hidden email]>
Date:   Fri Jul 7 15:29:15 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..e25502d76f 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -4,7 +4,7 @@
 
 ;; Author: Nicolas Petton <[hidden email]>
 ;; Keywords: convenience, map, hash-table, alist, array
-;; Version: 1.1
+;; Version: 1.2
 ;; Package: map
 
 ;; Maintainer: [hidden email]
@@ -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 536e4cf1dd8df61edb4bbc580ba1da787ba57f43
Author: Tino Calancha <[hidden email]>
Date:   Fri Jul 7 15:31:15 2017 +0900

    assoc-predicate: New defun
   
    Add new function like 'assoc' with an optional arg PRED,
    a predicate to compare the elements in the alist.
    * lisp/subr.el (assoc-predicate): New defun.
    (alist-get):
    * lisp/emacs-lisp/gv.el (alist-get): Use it.
    * test/lisp/subr-tests.el (subr-assoc-default, subr-assoc-predicate):
    New tests.
    * 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..b2a0b2df09 100644
--- a/doc/lispref/lists.texi
+++ b/doc/lispref/lists.texi
@@ -1589,6 +1589,25 @@ Association Lists
 @end smallexample
 @end defun
 
+@defun assoc-predicate key alist &optional pred
+This function is like @code{assoc} in that it returns the first
+association for @var{key} in @var{alist}, but if @code{pred} is
+non-@code{nil}, then it makes the comparison using @code{pred}
+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 pred 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..e988186b6c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -1050,6 +1050,11 @@ break.
 
 * Lisp Changes in Emacs 26.1
 
+
++++
+** New defun 'assoc-predicate', like 'assoc' with an optional argument
+PRED, a predicate to compare the elements in the alist.
+
 +++
 ** 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..80b10a62c0 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -674,6 +674,19 @@ assoc-default
       (setq tail (cdr tail)))
     value))
 
+(defun assoc-predicate (key alist &optional pred)
+  "Like `assoc' but compare keys with TEST."
+  (declare (compiler-macro
+            (lambda (_)
+              `(pcase ,pred
+                 ('eq (assq ,key ,alist))
+                 ((or 'equal 'nil) (assoc ,key ,alist))
+                 ((guard (and (macroexp-const-p ,key) (eq ,pred 'eql)))
+                  (if (floatp ,key)
+                      (assoc ,key ,alist) (assq ,key ,alist)))
+                 (_ (assoc-default ,key ,alist ,pred nil 'full))))))
+  (assoc-default key alist pred 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 +752,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)))
 
diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 54f4ab5d1b..ab806f74c3 100644
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -325,6 +325,23 @@ subr-tests--this-file
       (setq res (read-passwd "pass: " 'confirm (mapconcat #'string default "")))
       (should (string= default res)))))
 
+(ert-deftest subr-assoc-default ()
+  (let ((alist (list (cons "a" 1) (cons "b" 2) "c")))
+    (should (assoc-default "b" alist))
+    (should-not (assoc-default "b" alist 'eq))
+    (should-not (assoc-default "c" alist 'eq 'foo))
+    ;; Return 4th argument if the found element is an atom.
+    (should (equal 'foo (assoc-default "c" alist 'equal 'foo)))
+    (should (equal 2 (assoc-default "b" alist 'equal nil)))
+    (should (equal '("b" . 2) (assoc-default "b" alist 'equal nil 'full)))))
+
+(ert-deftest subr-assoc-predicate ()
+  (let ((alist (list (cons "a" 1) (cons "b" 2) "c")))
+    (should (assoc-predicate "b" alist))
+    (should-not (assoc-predicate "b" alist 'eq))
+    (should-not (assoc-predicate "c" alist 'eq))
+    (should-not (assoc-predicate "c" alist 'equal))
+    (should (equal '("b" . 2) (assoc-predicate "b" alist 'equal)))))
 
 (provide 'subr-tests)
 ;;; subr-tests.el ends here
--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-07
Repository revision: 51275358e91d654e0cb49b749bf83d2fa19476c7



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Eli Zaretskii
> From: Tino Calancha <[hidden email]>
> Date: Fri, 07 Jul 2017 15:48:01 +0900
> Cc: Nicolas Petton <[hidden email]>,
> Stefan Monnier <[hidden email]>

Thanks.  A few comments about the documentation parts:

> -@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}.

Sometimes, trying to make small changes to existing documentation
makes the documentation less readable and even confusing.  This is one
of those cases: where previously alist-get was only a minor deviation
from assq, and thus just mentioning those deviations would do, now the
deviations are much more significant, and the reference to assq gets
in the way instead of helping.  So I would rewrite the documentation
like this:

  @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 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}.

Suggest to simplify:

  If the element is a cons, then the value is the element's @sc{cdr}
  if @var{full} is @code{nil} or omitted, or the entire element
  otherwise.

> -(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.

Since the sentence references more than one argument, the "or `eql' if
nil" part is ambiguous.  Suggest to disambiguate:

  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'.

> -(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'.

Likewise here.

> -(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,
                             ^^
That "it" is ambiguous: does it refer to "element" or to "cdr"?

> -(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'.

Again, "if non-nil" is ambiguous: it could refer to TESTFN or to
alist.

> +@defun assoc-predicate key alist &optional pred
> +This function is like @code{assoc} in that it returns the first
> +association for @var{key} in @var{alist}, but if @code{pred} is
> +non-@code{nil}, then it makes the comparison using @code{pred}
> +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 pred x key)}.
          ^^^^^^^^^^^^^^^^^^
"pred", "x", and "key" should be in @var here.  I'd also include the
entire @code snippet in @w{..}, so that it won't be split between two
lines.

> ++++
> +** New defun 'assoc-predicate', like 'assoc' with an optional argument
> +PRED, a predicate to compare the elements in the alist.

Please use "function" in NEWS, not "defun".

> +(defun assoc-predicate (key alist &optional pred)
> +  "Like `assoc' but compare keys with TEST."
                                         ^^^^
PRED, not TEST.

Thanks.



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Nicolas Petton-2
In reply to this post by Tino Calancha-2
Tino Calancha <[hidden email]> writes:

> Nico, one thing worries me is the following:
> * After this patch, `map.el' v1.2 depends on Emacs version > 25:
> * because it makes a call to `alist-get' with 5 parameters i.e., it
>   uses TESTFN.
> Is that a problem?

map.el is not distributed outside of Emacs, so it shouldn't be a
problem.

I plan to do a more or less complete rewrite of map.el based on the same
design I used in the rewrite of seq.el (using methods for dispatching).
Maybe then I'll distribute it in GNU ELPA as well, but that's something
to worry about later, and we can always find solutions :)

Cheers,
Nico

signature.asc (482 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Nicolas Petton-2
In reply to this post by Tino Calancha-2
Tino Calancha <[hidden email]> writes:

>> But wouldn't it be better if `assoc' took an optional testfn?  I'm not
>> sure I like the `full' parameter in `assoc-default', and I think the
>> inconsistency of the return values between `assoc' and `assoc-default'
>> is already confusing.

> In fact, that would kill 2 birds in a shot.

I don't understand what you mean.  Would it be a good thing to
kill these 2 birds? :-D

Cheers,
Nico

signature.asc (482 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Tino Calancha-2


On Fri, 7 Jul 2017, Nicolas Petton wrote:

> Tino Calancha <[hidden email]> writes:
>
>>> But wouldn't it be better if `assoc' took an optional testfn?  I'm not
>>> sure I like the `full' parameter in `assoc-default', and I think the
>>> inconsistency of the return values between `assoc' and `assoc-default'
>>> is already confusing.
>
>> In fact, that would kill 2 birds in a shot.
>
> I don't understand what you mean.  Would it be a good thing to
> kill these 2 birds? :-D
It depends if you like to eat birds.  They are lighther than beef.



Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Nicolas Petton-2
Tino Calancha <[hidden email]> writes:

>> I don't understand what you mean.  Would it be a good thing to
>> kill these 2 birds? :-D

> It depends if you like to eat birds.  They are lighther than beef.

Now I'll have to explain to puzzled people sitting next to me why I was
laughing out loud while staring at my emails.

More seriously, could you explain what you meant?

Cheers,
Nico

signature.asc (482 bytes) Download Attachment
Reply | Threaded
Open this post in threaded view
|  
Report Content as Inappropriate

bug#27584: 26.0.50; alist-get: Add optional arg TESTFN

Stefan Monnier
> More seriously, could you explain what you meant?

It's like "faire d'une pierre deux coups", which you could also relate
to "buy one get one free".  So, yes, it's a good thing to kill two birds
in a shot.


        Stefan "damn birds!"



123
Loading...