From 391bdb4efc25b1c3c521b27d6203a5de173a2d14 Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sun, 1 Aug 2021 12:33:14 -0400
Subject: [PATCH v2] Add macro 'pcase-setq'

* lisp/emacs-lisp/pcase.el (pcase-setq): New macro.

This macro is the 'setq' equivalent of 'pcase-let'.

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

* test/lisp/emacs-lisp/pcase-tests.el (pcase-setq): Test this new macro.
---
 doc/lispref/control.texi            |  5 ++++
 etc/NEWS                            |  4 ++++
 lisp/emacs-lisp/pcase.el            | 31 +++++++++++++++++++++++++
 test/lisp/emacs-lisp/pcase-tests.el | 36 +++++++++++++++++++++++++++++
 4 files changed, 76 insertions(+)

diff --git a/doc/lispref/control.texi b/doc/lispref/control.texi
index 5026d0a4d7..6e4a5234e2 100644
--- a/doc/lispref/control.texi
+++ b/doc/lispref/control.texi
@@ -1312,6 +1312,11 @@ Destructuring with pcase Patterns
 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 95a2c87d05..0f11caf512 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -553,6 +553,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 006517db75..14af70a65b 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -317,6 +317,37 @@ pcase-dolist
          (pcase-let* ((,(car spec) ,tmpvar))
            ,@body)))))
 
+;;;###autoload
+(defmacro pcase-setq (pat val &rest args)
+  "Assign values to variables by destructuring with `pcase'.
+
+\(fn PATTERN VALUE PATTERN VALUE ...)"
+  (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 02d3878ad0..c53648383a 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -110,4 +110,40 @@ pcase-tests-cl-type
   (should-error (pcase 1
                   ((cl-type notatype) 'integer))))
 
+(ert-deftest pcase-setq ()
+  (should (equal (list nil nil)
+                 (let (a b)
+                   (pcase-setq `(,a ,b) nil)
+                   (list a b))))
+
+  (should (equal '(1 2)
+                 (let (a b)
+                   (pcase-setq `[,a ,b] [1 2])
+                   (list a b))))
+
+  (should (equal '(1 2)
+                 (let (a b)
+                   (pcase-setq a 1 b 2)
+                   (list a b))))
+
+  (should (= 2 (let (a)
+                 (pcase-setq a 1 `(,a) '(2))
+                 a)))
+
+  (should (equal '(nil [1 2 3] 4)
+                 (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))))
+
+  (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.25.1