master 19777b7c864: Allow default values in 'map-let' and the pcase 'map' form

[Basil L. Contovounesios]

branch: master
commit 19777b7c864f17248f279210545579001a2c99fd
Author: Earl Hyatt <okamsn@protonmail.com>
Commit: Basil L. Contovounesios <contovob@tcd.ie>

    Allow default values in 'map-let' and the pcase 'map' form
    
    * lisp/emacs-lisp/map.el (map-let, map)
    (map--make-pcase-bindings): Add a third argument for specifying a
    default value, like in 'map-elt'. (Bug#49407)
    
    * lisp/emacs-lisp/map.el (map--make-pcase-bindings): Clarify that keys
    that aren't found aren't ignored, they actually get the value
    nil (unless the new default value is given).  The overall pattern can
    still fail to match if the sub-pattern for the unfound key doesn't
    match nil.
    
    * test/lisp/emacs-lisp/map-tests.el (test-map-let-default)
    (test-map-plist-pcase-default, test-map-pcase-matches): Add tests,
    including for the above item.
---
 lisp/emacs-lisp/map.el            | 33 +++++++++++++++-------
 test/lisp/emacs-lisp/map-tests.el | 59 +++++++++++++++++++++++++++++++++++++++
 2 files changed, 82 insertions(+), 10 deletions(-)

diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 7a48ba47434..b55eb431668 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -50,18 +50,20 @@
 
 ARGS is a list of elements to be matched in the map.
 
-Each element of ARGS can be of the form (KEY PAT), in which case KEY is
-evaluated and searched for in the map.  The match fails if for any KEY
-found in the map, the corresponding PAT doesn't match the value
-associated with the KEY.
+Each element of ARGS can be of the form (KEY PAT [DEFAULT]),
+which looks up KEY in the map and matches the associated value
+against `pcase' pattern PAT.  DEFAULT specifies the fallback
+value to use when KEY is not present in the map.  If omitted, it
+defaults to nil.  Both KEY and DEFAULT are evaluated.
 
 Each element can also be a SYMBOL, which is an abbreviation of
 a (KEY PAT) tuple of the form (\\='SYMBOL SYMBOL).  When SYMBOL
 is a keyword, it is an abbreviation of the form (:SYMBOL SYMBOL),
 useful for binding plist values.
 
-Keys in ARGS not found in the map are ignored, and the match doesn't
-fail."
+An element of ARGS fails to match if PAT does not match the
+associated value or the default value.  The overall pattern fails
+to match if any element of ARGS fails to match."
   `(and (pred mapp)
         ,@(map--make-pcase-bindings args)))
 
@@ -71,12 +73,13 @@ fail."
 KEYS can be a list of symbols, in which case each element will be
 bound to the looked up value in MAP.
 
-KEYS can also be a list of (KEY VARNAME) pairs, in which case
-KEY is an unquoted form.
+KEYS can also be a list of (KEY VARNAME [DEFAULT]) sublists, in
+which case KEY and DEFAULT are unquoted forms.
 
 MAP can be an alist, plist, hash-table, or array."
   (declare (indent 2)
-           (debug ((&rest &or symbolp ([form symbolp])) form body)))
+           (debug ((&rest &or symbolp ([form symbolp &optional form]))
+                   form body)))
   `(pcase-let ((,(map--make-pcase-patterns keys) ,map))
      ,@body))
 
@@ -595,11 +598,21 @@ Example:
     (map-into \\='((1 . 3)) \\='(hash-table :test eql))"
   (map--into-hash map (cdr type)))
 
+(defmacro map--pcase-map-elt (key default map)
+  "A macro to make MAP the last argument to `map-elt'.
+
+This allows using default values for `map-elt', which can't be
+done using `pcase--flip'.
+
+KEY is the key sought in the map.  DEFAULT is the default value."
+  `(map-elt ,map ,key ,default))
+
 (defun map--make-pcase-bindings (args)
   "Return a list of pcase bindings from ARGS to the elements of a map."
   (mapcar (lambda (elt)
             (cond ((consp elt)
-                   `(app (pcase--flip map-elt ,(car elt)) ,(cadr elt)))
+                   `(app (map--pcase-map-elt ,(car elt) ,(caddr elt))
+                         ,(cadr elt)))
                   ((keywordp elt)
                    (let ((var (intern (substring (symbol-name elt) 1))))
                      `(app (pcase--flip map-elt ,elt) ,var)))
diff --git a/test/lisp/emacs-lisp/map-tests.el 
b/test/lisp/emacs-lisp/map-tests.el
index 86c0e9e0503..2204743f794 100644
--- a/test/lisp/emacs-lisp/map-tests.el
+++ b/test/lisp/emacs-lisp/map-tests.el
@@ -577,6 +577,13 @@ See bug#58531#25 and bug#58563."
     (should (= b 2))
     (should-not c)))
 
+(ert-deftest test-map-let-default ()
+  (map-let (('foo a 3)
+            ('baz b 4))
+      '((foo . 1))
+    (should (equal a 1))
+    (should (equal b 4))))
+
 (ert-deftest test-map-merge ()
   "Test `map-merge'."
   (should (equal (sort (map-merge 'list '(a 1) '((b . 2) (c . 3))
@@ -617,6 +624,58 @@ See bug#58531#25 and bug#58563."
                      (list one two))
                    '(1 2)))))
 
+(ert-deftest test-map-plist-pcase-default ()
+  (let ((plist '(:two 2)))
+    (should (equal (pcase-let (((map (:two two 33)
+                                     (:three three 44))
+                                plist))
+                     (list two three))
+                   '(2 44)))))
+
+(ert-deftest test-map-pcase-matches ()
+  (let ((plist '(:two 2)))
+    (should (equal (pcase plist
+                     ((map (:two two 33)
+                           (:three three))
+                      (list two three))
+                     (_ 'fail))
+                   '(2 nil)))
+
+    (should (equal (pcase plist
+                     ((map (:two two 33)
+                           (:three three 44))
+                      (list two three))
+                     (_ 'fail))
+                   '(2 44)))
+
+    (should (equal (pcase plist
+                     ((map (:two two 33)
+                           (:three `(,a . ,b) '(11 . 22)))
+                      (list two a b))
+                     (_ 'fail))
+                   '(2 11 22)))
+
+    (should (equal 'fail
+                   (pcase plist
+                     ((map (:two two 33)
+                           (:three `(,a . ,b) 44))
+                      (list two a b))
+                     (_ 'fail))))
+
+    (should (equal 'fail
+                   (pcase plist
+                     ((map (:two two 33)
+                           (:three `(,a . ,b) nil))
+                      (list two a b))
+                     (_ 'fail))))
+
+    (should (equal 'fail
+                   (pcase plist
+                     ((map (:two two 33)
+                           (:three `(,a . ,b)))
+                      (list two a b))
+                     (_ 'fail))))))
+
 (ert-deftest test-map-setf-alist-insert-key ()
   (let ((alist))
     (should (equal (setf (map-elt alist 'key) 'value)