From 988d72118687758af6c2b7c56c80056630d428ca Mon Sep 17 00:00:00 2001
From: Nicolas Petton <nicolas@petton.fr>
Date: Tue, 2 Jun 2015 22:13:38 +0200
Subject: [PATCH] Add a pcase pattern for maps and `map-let' based on it

* lisp/emacs-lisp/map.el (map-let): New macro.
(map--make-pcase-bindings, map--make-pcase-patterns): New functions.
* test/automated/map-tests.el: New test for `map-let'.
---
 lisp/emacs-lisp/map.el      | 35 +++++++++++++++++++++++++++++++++++
 test/automated/map-tests.el | 12 ++++++++++++
 2 files changed, 47 insertions(+)

diff --git a/lisp/emacs-lisp/map.el b/lisp/emacs-lisp/map.el
index 8801b2aba7a..dea2abcb0e8 100644
--- a/lisp/emacs-lisp/map.el
+++ b/lisp/emacs-lisp/map.el
@@ -44,6 +44,24 @@
 
 (require 'seq)
 
+(pcase-defmacro map (&rest args)
+  "pcase pattern matching map elements.
+Matches if the object is a map (list, hash-table or array), and
+binds values from ARGS to the corresponding element of the map.
+
+ARGS can be an alist of key/binding pairs of a list of keys."
+  `(and (pred map-p)
+        ,@(map--make-pcase-bindings args)))
+
+(defmacro map-let (args map &rest body)
+  "Bind the variables in ARGS to the elements of MAP then evaluate BODY.
+
+ARGS can be an alist of key/binding pairs or a list of keys.  MAP
+can be a list, hash-table or array."
+  (declare (indent 2) (debug t))
+  `(pcase-let ((,(map--make-pcase-patterns args) ,map))
+     ,@body))
+
 (defun map-elt (map key &optional default)
   "Perform a lookup in MAP of KEY and return its associated value.
 If KEY is not found, return DEFAULT which defaults to nil.
@@ -331,5 +349,22 @@ If KEY is not found, return DEFAULT which defaults to nil."
                map)
     ht))
 
+(defun map--make-pcase-bindings (args)
+  "Return a list of pcase bindings from ARGS to the elements of a map."
+  (seq-map (lambda (elt)
+             (if (consp elt)
+                 `(app (pcase--flip map-elt ',(car elt)) ,(cdr elt))
+               `(app (pcase--flip map-elt ',elt) ,elt)))
+           args))
+
+(defun map--make-pcase-patterns (args)
+  "Return a list of `(map ...)' pcase patterns built from ARGS."
+  (cons 'map
+        (seq-map (lambda (elt)
+                   (if (and (consp elt) (eq 'map (car elt)))
+                       (map--make-pcase-patterns elt)
+                     elt))
+                 args)))
+
 (provide 'map)
 ;;; map.el ends here
diff --git a/test/automated/map-tests.el b/test/automated/map-tests.el
index e65af894275..2f7d4eb0572 100644
--- a/test/automated/map-tests.el
+++ b/test/automated/map-tests.el
@@ -317,5 +317,17 @@ Evaluate BODY for each created map.
     (assert (map-empty-p (map-into nil 'hash-table)))
     (should-error (map-into [1 2 3] 'string))))
 
+(ert-deftest test-map-let ()
+  (map-let (foo bar baz) '((foo . 1) (bar . 2))
+    (assert (= foo 1))
+    (assert (= bar 2))
+    (assert (null baz)))
+  (map-let ((foo . a)
+            (bar . b)
+            (baz . c)) '((foo . 1) (bar . 2))
+    (assert (= a 1))
+    (assert (= b 2))
+    (assert (null c))))
+
 (provide 'map-tests)
 ;;; map-tests.el ends here
-- 
2.11.4.GIT