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

[Tino Calancha <tino.calancha@gmail.com>]

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