From 2f90fa19b8fdc70303232d389553afa524c72509 Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Wed, 11 Aug 2021 23:54:31 +0200
Subject: [PATCH] Add a `pcase-setq' macro

* doc/lispref/control.texi (Destructuring with pcase Patterns):
Document this macro.

* lisp/emacs-lisp/pcase.el (pcase-setq): New macro.  This macro is
the 'setq' equivalent of 'pcase-let'.

* test/lisp/emacs-lisp/pcase-tests.el (pcase-setq): Test this new
macro. (bug#49809).
---
 doc/lispref/control.texi            |  4 +++
 etc/NEWS                            |  4 +++
 lisp/emacs-lisp/pcase.el            | 38 +++++++++++++++++++++++
 test/lisp/emacs-lisp/pcase-tests.el | 48 +++++++++++++++++++++++++++++
 4 files changed, 94 insertions(+)

diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 5026d0a4d70..aacf66c5cf8 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1312,6 +1312,10 @@ element of @var{list}.  The bindings are performed as if by
 up being equivalent to @code{dolist} (@pxref{Iteration}).
 @end defmac
 
+@defmac pcase-setq pattern value@dots{}
+Assign values to variables in a @code{setq} form, destructuring each
+@var{value} according to its respective @var{pattern}.
+@end defmac
 
 @node Iteration
 @section Iteration
diff --git a/etc/NEWS b/etc/NEWS
index 18fa54b97e6..ffe8f5b32cb 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -559,6 +559,10 @@ The new 'cl-type' pattern compares types using 'cl-typep', which allows
 comparing simple types like '(cl-type integer)', as well as forms like
 '(cl-type (integer 0 10))'.
 
+*** New macro 'pcase-setq'
+This macro is the 'setq' equivalent of 'pcase-let', which allows for
+destructuring patterns in a 'setq' form.
+
 +++
 ** profiler.el
 The results displayed by 'profiler-report' now have the usage figures
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 006517db759..d111d9e41f8 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -317,6 +317,44 @@ of the elements of LIST is performed as if by `pcase-let'.
          (pcase-let* ((,(car spec) ,tmpvar))
            ,@body)))))
 
+;;;###autoload
+(defmacro pcase-setq (pat val &rest args)
+  "Assign values to variables by destructuring with `pcase'.
+PATTERNS are normal `pcase' patterns, and VALUES are expression.
+
+Evaluation happens sequentially as in `setq' (not in parallel).
+
+An example: (pcase-setq `((,a) [(,b)]) '((1) [(2)]))
+
+When a PATTERN doesn't match it's VALUE, the pair is silently skipped.
+
+\(fn PATTERNS VALUE PATTERN VALUES ...)"
+  (declare (debug (&rest [pcase-PAT form])))
+  (cond
+   (args
+    (let ((arg-length (length args)))
+      (unless (= 0 (mod arg-length 2))
+        (signal 'wrong-number-of-arguments
+                (list 'pcase-setq (+ 2 arg-length)))))
+    (let ((result))
+      (while args
+        (push `(pcase-setq ,(pop args) ,(pop args))
+              result))
+      `(progn
+         (pcase-setq ,pat ,val)
+         ,@(nreverse result))))
+   ((pcase--trivial-upat-p pat)
+    `(setq ,pat ,val))
+   (t
+    (pcase-compile-patterns
+     val
+     (list (cons pat
+                 (lambda (varvals &rest _)
+                   `(setq ,@(mapcan (lambda (varval)
+                                      (let ((var (car varval))
+                                            (val (cadr varval)))
+                                        (list var val)))
+                                    varvals)))))))))
 
 (defun pcase--trivial-upat-p (upat)
   (and (symbolp upat) (not (memq upat pcase--dontcare-upats))))
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index 02d3878ad08..67882d00d86 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -110,4 +110,52 @@
   (should-error (pcase 1
                   ((cl-type notatype) 'integer))))
 
+(ert-deftest pcase-setq ()
+  (should (equal (let (a b)
+                   (pcase-setq `(,a ,b) nil)
+                   (list a b))
+                 (list nil nil)))
+
+  (should (equal (let (a b)
+                   (pcase-setq `((,a) (,b)) '((1) (2)))
+                   (list a b))
+                 (list 1 2)))
+
+  (should (equal (list 'unset 'unset)
+                 (let ((a 'unset)
+                       (b 'unset))
+                   (pcase-setq `(,a ,b) nil)
+                   (list a b))))
+
+  (should (equal (let (a b)
+                   (pcase-setq `[,a ,b] [1 2])
+                   (list a b))
+                 '(1 2)))
+
+  (should (equal (let (a b)
+                   (pcase-setq a 1 b 2)
+                   (list a b))
+                 '(1 2)))
+
+  (should (= (let (a)
+               (pcase-setq a 1 `(,a) '(2))
+               a)
+             2))
+
+  (should (equal (let (array list-item array-copy)
+                   (pcase-setq (or `(,list-item) array) [1 2 3]
+                               array-copy array
+                               ;; This re-sets `array' to nil.
+                               (or `(,list-item) array) '(4))
+                   (list array array-copy list-item))
+                 '(nil [1 2 3] 4)))
+
+  (let ((a nil))
+    (should-error (pcase-setq a 1 b)
+                  :type '(wrong-number-of-arguments))
+    (should (eq a nil)))
+
+  (should-error (pcase-setq a)
+                :type '(wrong-number-of-arguments)))
+
 ;;; pcase-tests.el ends here.
-- 
2.39.5