bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Okamsn via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 1108 bytes --]

Hello,

The attached patch adds the pattern `cl-lambda` for Pcase, which works 
like `cl-destructuring-bind`. There are two differences with the lambda 
lists:

1. It does not support `&environment`
2. Without `&allow-other-keys` or `:allow-other-keys t`, the pattern 
will fail to match if their are unmatched keys in EXPVAL, but it does 
not throw an error.

The variable that would be bound in the lambda list can be Pcase 
patterns themselves, with two exceptions:

1. Using a sub-pattern as the cdr of a dotted list, like "(cl-lambda (a 
. `(,b . ,c))" doesn't work, since the pattern won't always look like a 
dotted list.
2. For constructs that use a sub-list to provide additional values, such 
as `&optional`, `&key`, and `&aux`, the sub-pattern only works inside 
the sub-list.  For example, one could do "(cl-lambda (&optional (`(,a 
,b))" but not "(cl-lambda (&optional `(,a ,b)))".

The pattern is useful when one wants to combine the features of `pcase` 
and `cl-destructuring-bind`, such combining the optional values with the 
`pred` or `guard` patterns.

Thank you.

[-- Attachment #2: 0001-Add-the-Pcase-pattern-cl-lambda-for-matching-lambda-.patch --]
[-- Type: text/x-patch, Size: 37534 bytes --]

From a16bf1ded587b7cc974dafa5f72427f3a1f6c5ff Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sat, 25 Nov 2023 13:00:03 -0500
Subject: [PATCH] Add the Pcase pattern `cl-lambda' for matching lambda list.

This pattern matches function argument lists as described in the Info
node `(cl)Argument Lists'.

* lisp/emacs-lisp/cl-macs.el (cl-lambda--pcase-macroexpander)
(cl-lambda, cl--pcase-lambda-list-get-var-groups)
(cl--pcase-cl-lambda-positional-pattern)
(cl--pcase-cl-lambda-plist-keys)
(cl--pcase-cl-lambda-&key-pattern)
(cl--pcase-cl-lambda-&aux-pattern):
Add pattern and supporting functions.

* test/lisp/emacs-lisp/pcase-tests.el:
(pcase-tests-cl-lambda-&whole-should-error)
(pcase-tests-cl-lambda-&whole)
(pcase-tests-cl-lambda-pos, pcase-tests-cl-lambda-pos-sub-patterns)
(pcase-tests-cl-lambda-&optional-should-error)
(pcase-tests-cl-lambda-&optional)
(pcase-tests-cl-lambda-&optional-sub-patterns)
(pcase-tests-cl-lambda-&rest-should-error)
(pcase-tests-cl-lambda-&rest-nonlist-cdr)
(pcase-tests-cl-lambda-&rest-with-&whole)
(pcase-tests-cl-lambda-&rest-only)
(pcase-tests-cl-lambda-&rest-after-&optional)
(pcase-tests-cl-lambda-&rest-sub-patterns)
(pcase-tests-cl-lambda-&key-should-error)
(pcase-tests-cl-lambda-&key-exact)
(pcase-tests-cl-lambda-&key-permissive)
(pcase-tests-cl-lambda-&key-not-first)
(pcase-tests-cl-lambda-&key-full-form)
(pcase-tests-cl-lambda-&key-sub-patterns)
(pcase-tests-cl-lambda-&aux-should-error)
(pcase-tests-cl-lambda-&aux)
(pcase-tests-cl-lambda-&aux-sub-patterns)
(pcase-tests-cl-lambda-all):
Add tests.
---
 lisp/emacs-lisp/cl-macs.el          | 325 ++++++++++++++++++
 test/lisp/emacs-lisp/pcase-tests.el | 515 ++++++++++++++++++++++++++++
 2 files changed, 840 insertions(+)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 7c207d372fc..00c10f6458f 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3825,6 +3825,331 @@ cl-type
 TYPE is a type descriptor as accepted by `cl-typep', which see."
   `(pred (pcase--flip cl-typep ',type)))
 
+;;; Pcase lambda-list pattern
+
+;; This pattern is like `cl-destructuring-bind', but with `pcase'.  We
+;; can't use `cl--do-arglist' for this, because `cl--do-arglist' uses
+;; `pop' to modify earlier variables while setting later ones, which
+;; doesn't seem to work with `pcase'.
+
+(defconst cl--pcase-lambda-list-constructs
+  '(&whole &optional &rest &key &allow-other-keys &aux)
+  "Symbols that change how the following elements are understood.")
+
+(define-error 'cl--pcase-lambda-list-bad-lambda-list
+              "Error in `cl-lambda' pattern.")
+
+(defun cl--pcase-cl-lambda-var-groups (lambda-list)
+  "Return the alist of variable groups in LAMBDA-LIST.
+
+Lists are of the form
+`([&whole WHOLE-VAR] [POS-VARS] [&optional OPT-VARS] [&rest REST-VAR]
+[&key KEY-VARS] [&aux AUX-VARS])'."
+  (let ((whole-var) (processing-whole)
+        (pos-var)
+        (opt-var) (processing-opts)
+        (rest-var) (processing-rest) (dotted-rest-var)
+        (key-var) (processing-keys) (allow-other-keys)
+        (aux-var) (processing-auxs)
+        (remaining-list (cl-copy-list lambda-list)))
+
+    (when (not (proper-list-p remaining-list))
+      (cl-shiftf dotted-rest-var
+                 (cdr (last remaining-list))
+                 nil))
+
+    (cl-flet ((missing-after (cdr) (or (null cdr)
+                                       (memq (car cdr) cl--pcase-lambda-list-constructs)))
+              (stop-processing () (setq processing-whole nil
+                                        processing-opts nil
+                                        processing-rest nil
+                                        processing-keys nil
+                                        processing-auxs nil)))
+      (cl-loop
+       for (first . rest) on lambda-list
+       do
+       (pcase first
+         ('&whole
+          (if (or (missing-after rest)
+                  whole-var pos-var opt-var
+                  rest-var key-var allow-other-keys aux-var)
+              (signal 'cl--pcase-lambda-list-bad-lambda-list (list lambda-list))
+            (stop-processing)
+            (setq processing-whole t)))
+
+         ('&optional
+          (if (or (missing-after rest)
+                  opt-var rest-var key-var allow-other-keys aux-var)
+              (signal 'cl--pcase-lambda-list-bad-lambda-list
+                      (list lambda-list))
+            (stop-processing)
+            (setq processing-opts t)))
+
+         ((or '&rest '&body)
+          (if (or (missing-after rest)
+                  rest-var key-var allow-other-keys aux-var
+                  dotted-rest-var)
+              (signal 'cl--pcase-lambda-list-bad-lambda-list
+                      (list lambda-list))
+            (stop-processing)
+            (setq processing-rest t)))
+
+         ('&key
+          (if (or (missing-after rest)
+                  key-var allow-other-keys aux-var
+                  dotted-rest-var)
+              (signal 'cl--pcase-lambda-list-bad-lambda-list
+                      (list lambda-list))
+            (stop-processing)
+            (setq processing-keys t)))
+
+         ('&allow-other-keys
+          (if (or (not processing-keys)
+                  allow-other-keys
+                  dotted-rest-var)
+              (signal 'cl--pcase-lambda-list-bad-lambda-list
+                      (list lambda-list))
+            (stop-processing)
+            (setq allow-other-keys t)))
+
+         ('&aux
+          (if (or (missing-after rest)
+                  aux-var
+                  dotted-rest-var)
+              (signal 'cl--pcase-lambda-list-bad-lambda-list
+                      (list lambda-list))
+            (stop-processing)
+            (setq processing-auxs t)))
+
+         ((guard processing-whole)
+          (setq whole-var first
+                processing-whole nil))
+
+         ((guard processing-rest)
+          (setq rest-var first
+                processing-rest nil))
+
+         ((guard processing-opts)
+          (push first opt-var))
+
+         ((guard processing-keys)
+          (push first key-var))
+
+         ((guard processing-auxs)
+          (push first aux-var))
+
+         ('&environment
+          (signal 'cl--pcase-lambda-list-bad-lambda-list
+                  (list lambda-list)))
+
+         (_
+          (if (or opt-var rest-var key-var aux-var
+                  allow-other-keys)
+              (signal 'cl--pcase-lambda-list-bad-lambda-list
+                      (list lambda-list))
+            (push first pos-var))))))
+
+    `((whole . ,whole-var)
+      (pos . ,(nreverse pos-var))
+      (opt . ,(nreverse opt-var))
+      (rest . ,(or dotted-rest-var rest-var))
+      (key . ,(nreverse key-var))
+      (allow-other-keys . ,allow-other-keys)
+      (aux . ,(nreverse aux-var)))))
+
+(defun cl--pcase-cl-lambda-positional-pattern (pos-vars opt-vars rest-var key-vars)
+  "Build a pattern for the positional, `&optional', and `&rest' variables.
+
+POS-VARS is the list of the positional variables.  OPT-VARS is the list of
+the optional variables.  REST-VAR is the `&rest' variable."
+  ;; A modified version of the back-quote pattern to better work with
+  ;; optional values.
+  (cond
+   (pos-vars `(and (pred consp)
+                   (app car-safe ,(car pos-vars))
+                   (app cdr-safe ,(cl--pcase-cl-lambda-positional-pattern
+                                   (cdr pos-vars) opt-vars
+                                   rest-var key-vars))))
+   (opt-vars (pcase-let (((or `(,var ,default ,supplied)
+                              `(,var ,default)
+                              `(,var)
+                              var)
+                          (car opt-vars)))
+               `(and (pred listp)
+                     (app car-safe (or (and (pred null)
+                                            ,@(when supplied `((let ,supplied nil)))
+                                            ,@(when default `((let ,var ,default))))
+                                       ,(if supplied
+                                            `(and (let ,supplied t)
+                                                  ,var)
+                                          var)))
+                     (app cdr-safe ,(cl--pcase-cl-lambda-positional-pattern
+                                     nil (cdr opt-vars)
+                                     rest-var key-vars)))))
+   (rest-var rest-var)
+   ;; `pcase' allows `(,a ,b) to match (1 2 3), so we need to make
+   ;; sure there aren't more values left.  However, if we are using
+   ;; `&key', then we allow more values.
+   (key-vars '_)
+   (t '(pred null))))
+
+;;;###autoload
+(defun cl--pcase-cl-lambda-plist-keys (list)
+  "Get every other element in LIST, to get the keys in a property list."
+  (cl-loop for key in list by #'cddr collect key))
+
+(defun cl--pcase-cl-lambda-&key-pattern (key-vars allow-other-keys plist-var)
+  "Build a `pcase' pattern for the `&key' variables.
+
+KEY-VARS are the forms of the key variables.  ALLOW-OTHER-KEYS is
+whether `&allow-other-keys' was used.  PLIST-VAR is the variable
+holding the property list."
+  (let* ((specified-keys nil)
+         (pat-list
+          (cl-loop
+           for bind in key-vars
+           append (pcase-let* (((or (or `((,key ,var) ,default ,supplied)
+                                        `((,key ,var) ,default)
+                                        `((,key ,var)))
+                                    (and (or `(,var ,default ,supplied)
+                                             `(,var ,default)
+                                             `(,var)
+                                             (and (pred symbolp)
+                                                  var))
+                                         ;; Strip a leading underscore, since it
+                                         ;; only means that this argument is
+                                         ;; unused, but shouldn't affect the
+                                         ;; key's name (bug#12367).
+                                         (let key (intern
+                                                   (format ":%s"
+                                                           (let ((name (symbol-name var)))
+                                                             (if (eq ?_ (aref name 0))
+                                                                 (substring name 1)
+                                                               name)))))))
+                                bind)
+                               (const-key (macroexp-const-p key))
+                               (used-key (if const-key
+                                             key
+                                           (gensym (format "plist-key-%s" var)))))
+                    (unless allow-other-keys
+                      (push key specified-keys))
+                    `(,@(unless (equal used-key key)
+                          `((let ,used-key ,key)))
+                      ,@(cond
+                         (supplied
+                          (let ((key-found (gensym "key-found")))
+                            `((let ,key-found (plist-member ,plist-var ,used-key
+                                                            #'equal))
+                              (or (and (guard ,key-found)
+                                       (let ,var (cadr ,key-found))
+                                       (let ,supplied t))
+                                  (and (let ,var ,default)
+                                       (let ,supplied nil))))))
+                         (default
+                          (let ((key-found (gensym "key-found")))
+                            `((let ,var
+                                (if-let ((,key-found (plist-member ,plist-var
+                                                                   ,used-key
+                                                                   #'equal)))
+                                    (cl-second ,key-found)
+                                  ,default)))))
+                         (t
+                          `((let ,var  (plist-get ,plist-var ,used-key #'equal))))))))))
+    `(and ,@(unless allow-other-keys
+              `((guard (or (null (cl-set-difference (cl--pcase-cl-lambda-plist-keys ,plist-var)
+                                                    (list ,@specified-keys)
+                                                    :test #'equal))
+                           (plist-get ,plist-var :allow-other-keys)))))
+          ,@pat-list)))
+
+(defun cl--pcase-cl-lambda-&aux-pattern (aux-vars)
+  "Build `pcase' pattern for `&aux' variables.
+
+AUX-VARS is the list of bindings."
+  `(and ,@(cl-loop for bind in aux-vars
+                   collect (pcase-let (((or `(,var ,val)
+                                            `(,var)
+                                            var)
+                                        bind))
+                             `(let ,var ,val)))))
+
+;;;###autoload
+(pcase-defmacro cl-lambda (lambda-list)
+  "Match a CL lambda list.  See the Info node `(cl)Argument Lists'.
+
+This pattern does not support `&environment'.
+
+`&key' will fail to match if there are more keys in the plist
+then specified, unless `&allow-other-keys' is given or unless the
+plist associates the key `:allow-other-keys' with a non-nil
+value.  Unlike `cl-destructuring-bind', this pattern does not
+signal an error if there are unmatched keys in the plist.
+
+Unlike the back-quote pattern, the pattern will fail to match if the
+non-optional part of LAMBDA-LIST is shorter than EXPVAL.
+
+For this `pcase' pattern, the variables in LAMBDA-LIST can
+themselves be `pcase' patterns, instead of just symbols as in a
+normal CL lambda list.  However, lambda-list constructs like
+`&optional', `&key', and `&aux' use sub-lists to specify default
+values and other features.  For example,
+
+    (cl-lambda (&optional (opt1 default1 opt1-supplied)))
+
+Therefore, to avoid ambiguity, the use of sub-patterns can only
+be done within the sub-list for those constructs.  For example,
+
+    (cl-lambda (&optional ((and opt1 (guard (listp opt1)))
+                           nil)))
+
+For similar reasons, the cdr of a dotted list (as opposed to the
+element following `&rest') for the remainder of a list cannot be
+a sub-pattern."
+  (let* ((groups (cl--pcase-cl-lambda-var-groups lambda-list))
+         (whole-var (alist-get 'whole groups))
+         (pos-vars (alist-get 'pos groups))
+         (opt-vars (alist-get 'opt groups))
+         (rest-var (alist-get 'rest groups))
+         (key-vars (alist-get 'key groups))
+         (allow-other-keys (alist-get 'allow-other-keys groups))
+         (aux-vars (alist-get 'aux groups)))
+    (remq nil
+          `(and (pred listp)
+                ,(when whole-var
+                   whole-var)
+                ,(when (or pos-vars opt-vars rest-var)
+                   (cl--pcase-cl-lambda-positional-pattern
+                    pos-vars opt-vars
+                    rest-var key-vars))
+                ,@(when key-vars
+                    (let ((plist-var (gensym "maybe-plist")))
+                      (cond
+                       (rest-var
+                        (list (cl--pcase-cl-lambda-&key-pattern
+                               key-vars allow-other-keys
+                               rest-var)))
+                       ((or pos-vars opt-vars)
+                        (if whole-var
+                            `((let ,plist-var (nthcdr ,(+ (length pos-vars)
+                                                          (length opt-vars))
+                                                      ,whole-var))
+                              ,(cl--pcase-cl-lambda-&key-pattern
+                                key-vars allow-other-keys
+                                plist-var))
+                          `((app (nthcdr ,(+ (length pos-vars)
+                                             (length opt-vars)))
+                                 ,plist-var)
+                            ,(cl--pcase-cl-lambda-&key-pattern
+                              key-vars allow-other-keys
+                              plist-var))))
+                       (t
+                        `((and ,plist-var
+                               ,(cl--pcase-cl-lambda-&key-pattern
+                                 key-vars allow-other-keys
+                                 plist-var)))))))
+                ,(when aux-vars
+                   (cl--pcase-cl-lambda-&aux-pattern aux-vars))))))
+
 ;; Local variables:
 ;; generated-autoload-file: "cl-loaddefs.el"
 ;; End:
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index 799e8d36647..9c32259e953 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -160,4 +160,519 @@ pcase-tests-setq
   (should-error (pcase-setq a)
                 :type '(wrong-number-of-arguments)))
 
+;;; Tests for the `cl-lambda' `pcase' pattern.
+
+(ert-deftest pcase-tests-cl-lambda-&whole-should-error ()
+  "`&whole' must come first if given, and must be followed by a patter."
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&whole))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (a b &whole c))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&rest a &whole c))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&key a &whole c))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&aux (a 1) &whole c))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&optional (a 1) &whole c))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&whole whole1 &whole whole2))
+                   (list whole1 whole2)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list))
+
+(ert-deftest pcase-tests-cl-lambda-&whole ()
+  "`&whole' can be a `pcase' pattern."
+  (should (equal (list (list 1 2 3) 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-lambda (&whole whole a b c))
+                    (list whole a b c)))))
+
+  (should (equal (list 1 2 3 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-lambda (&whole `(,a0 ,b0 ,c0) a b c))
+                    (list a0 b0 c0 a b c))))))
+
+(ert-deftest pcase-tests-cl-lambda-pos ()
+  "Positional variables must match the length of EXPVAL."
+  (should (equal (list 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-lambda (a b c))
+                    (list a b c)))))
+
+  (should (equal nil
+                 (pcase (list (list 1))
+                   ((cl-lambda (a b))
+                    (list a b)))))
+
+  (should (equal nil
+                 (pcase (list (list 1 2 3))
+                   ((cl-lambda (a b))
+                    (list a b))))))
+
+(ert-deftest pcase-tests-cl-lambda-pos-sub-patterns ()
+  (should (equal (list 1 2 3 4)
+                 (pcase (list 1 2 (list 3 4))
+                   ((cl-lambda (a b (cl-lambda (c d))))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2)
+                 (pcase (list (list 1 2))
+                   ((cl-lambda (`(,a ,b)))
+                    (list a b))))))
+
+(ert-deftest pcase-tests-cl-lambda-&optional-should-error ()
+  "`&optional' cannot be used after `&optional', `&rest', `&key', and `&aux'."
+  (should-error (equal (list 1 2 3)
+                       (pcase (list 1 2 3)
+                         ((cl-lambda (&rest a &optional b c))
+                          (list a b c))))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&body a &optional b c))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&key a &optional b c))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&allow-other-keys &optional b c))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&aux (a 1) &optional b c))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&optional a &optional b c))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list))
+
+(ert-deftest pcase-tests-cl-lambda-&optional ()
+  (should (equal (list 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-lambda (a b &optional c))
+                    (list a b c)))))
+
+  (should (equal (list 1 2 nil)
+                 (pcase (list 1 2)
+                   ((cl-lambda (a b &optional c))
+                    (list a b c)))))
+
+  (should (equal (list 1 2 13)
+                 (pcase (list 1 2)
+                   ((cl-lambda (a b &optional (c 13)))
+                    (list a b c)))))
+
+  (should (equal (list 1 2 13 nil)
+                 (pcase (list 1 2)
+                   ((cl-lambda (a b &optional (c 13 c-supplied)))
+                    (list a b c c-supplied)))))
+
+  (should (equal (list 1 2 3 t)
+                 (pcase (list 1 2 3)
+                   ((cl-lambda (a b &optional (c 13 c-supplied)))
+                    (list a b c c-supplied))))))
+
+(ert-deftest pcase-tests-cl-lambda-&optional-sub-patterns ()
+  "Test using sub-patterns in `cl-lambda' pattern.
+Sub-patterns must be contained within a sub-list, since a sub-list
+also provides a default value."
+  (should-error (pcase (list 1 2 (list 3 4))
+                  ((cl-lambda (a b &optional `(,c ,d)))
+                   (list a b c d))))
+
+  (should (equal (list 1 2 33)
+                 (pcase (list 1 2)
+                   ((cl-lambda (a b &optional ((and opt1
+                                                    (guard (numberp opt1)))
+                                               33)))
+                    (list a b opt1)))))
+
+  (should (equal nil
+                 (pcase (list 1 2 'not-num)
+                   ((cl-lambda (a b &optional ((and opt1
+                                                    (guard (numberp opt1)))
+                                               33)))
+                    (list a b opt1)))))
+
+  (should (equal nil
+                 (pcase (list 1 2 nil)
+                   ((cl-lambda (a b &optional ((and opt1
+                                                    (guard (numberp opt1)))
+                                               'not-num)))
+                    (list a b opt1)))))
+
+  (should (equal (list 1 2 3 4)
+                 (pcase (list 1 2 (list 3 4))
+                   ((cl-lambda (a b &optional (`(,c ,d))))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 nil nil)
+                 (pcase (list 1 2)
+                   ((cl-lambda (a b &optional (`(,c ,d))))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 13 14)
+                 (pcase (list 1 2)
+                   ((cl-lambda (a b &optional (`(,c ,d) (list 13 14))))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 13 14)
+                 (pcase (list 1 2)
+                   ((cl-lambda ( a b
+                                 &optional ((cl-lambda (c &optional (d 14)))
+                                            (list 13))))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 13 14 nil)
+                 (pcase (list 1 2)
+                   ((cl-lambda (a b &optional (`(,c ,d) (list 13 14) cd-supplied)))
+                    (list a b c d cd-supplied)))))
+
+  (should (equal (list 1 2 13 14 nil t nil)
+                 (pcase (list 1 2)
+                   ((cl-lambda ( a b
+                                 &optional
+                                 ((cl-lambda (&optional (c 27 c-sub-sup)
+                                                        (d 14 d-sub-sup)))
+                                  (list 13)
+                                  cd-supplied)))
+                    (list a b c d cd-supplied c-sub-sup d-sub-sup))))))
+
+(ert-deftest pcase-tests-cl-lambda-&rest-should-error ()
+  "`&rest' (`&body', `.') cannot be used after `&rest', `&body', `&key',and `&aux'."
+  (should-error (equal (list 1 2 3)
+                       (pcase (list 1 2 3)
+                         ((cl-lambda (&rest a &rest b))
+                          (list a b c))))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (equal (list 1 2 3)
+                       (pcase (list 1 2 3)
+                         ((cl-lambda (&body a &body b))
+                          (list a b c))))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (equal (list 1 2 3)
+                       (pcase (list 1 2 3)
+                         ((cl-lambda (&body a . b))
+                          (list a b c))))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&body a &rest b))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&rest a &body b))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&key a &rest b))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&key a &body b))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&key a . b))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&allow-other-keys &rest b))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&allow-other-keys &body b))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&allow-other-keys . b))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&aux (a 1) &rest b))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&aux (a 1) &body b))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-lambda (&aux (a 1) . b))
+                   (list a b c)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list))
+
+(ert-deftest pcase-tests-cl-lambda-&rest-nonlist-cdr ()
+  (should (equal (list 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-lambda (a &rest b))
+                    (list a b)))))
+
+  (should (equal (list 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-lambda (a &body b))
+                    (list a b)))))
+
+  (should (equal (list 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-lambda (a . b))
+                    (list a b))))))
+
+(ert-deftest pcase-tests-cl-lambda-&rest-with-&whole ()
+  (should (equal (list (cons 1 2) 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-lambda (&whole whole a &rest b))
+                    (list whole a b)))))
+
+  (should (equal (list (cons 1 2) 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-lambda (&whole whole a &body b))
+                    (list whole a b)))))
+
+  (should (equal (list (cons 1 2) 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-lambda (&whole whole a . b))
+                    (list whole a b))))))
+
+(ert-deftest pcase-tests-cl-lambda-&rest-only ()
+  "Using only `&rest' should work like `&whole'."
+  (should (equal (list (list 1 2))
+                 (pcase (list 1 2)
+                   ((cl-lambda (&rest a))
+                    (list a)))))
+
+  (should (equal (list (cons 1 2))
+                 (pcase (cons 1 2)
+                   ((cl-lambda (&body a))
+                    (list a))))))
+
+(ert-deftest pcase-tests-cl-lambda-&rest-after-&optional ()
+  (should (equal (list 1 2 3 (list 4 5))
+                 (pcase (list 1 2 3 4 5)
+                   ((cl-lambda (&optional a b c &rest d))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 3 (list 4 5))
+                 (pcase (list 1 2 3 4 5)
+                   ((cl-lambda (&optional a b c &body d))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 3 (list 4 5))
+                 (pcase (list 1 2 3 4 5)
+                   ((cl-lambda (&optional a b c . d))
+                    (list a b c d))))))
+
+(ert-deftest pcase-tests-cl-lambda-&rest-sub-patterns ()
+  ;; We can't do (a . `(,b . ,c)), so we don't test that.
+  (should (equal (list 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-lambda (a &rest (cl-lambda (b c))))
+                    (list a b c)))))
+
+  (should (equal (list 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-lambda (a &body `(,b ,c)))
+                    (list a b c))))))
+
+(ert-deftest pcase-tests-cl-lambda-&key-should-error ()
+  "`&key' cannot be used after `&key', `&allow-other-keys', and `&aux'."
+  (should-error (pcase (list :a 1 :b 2)
+                  ((cl-lambda (&key a &key b))
+                   (list a b)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list :a 1 :b 2)
+                  ((cl-lambda (&aux (a 1) &key b))
+                   (list a b)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list)
+
+  (should-error (pcase (list :a 1 :b 2)
+                  ((cl-lambda (&allow-other-keys &key b))
+                   (list a b)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list))
+
+(ert-deftest pcase-tests-cl-lambda-&key-exact ()
+  "`&key' doesn't match unspecified keys unless `&allow-other-keys' or `:allow-other-keys' is given."
+  (should (equal (list 1 2)
+                 (pcase (list :a 1 :b 2)
+                   ((cl-lambda (&key a b))
+                    (list a b)))))
+
+  (should (equal nil
+                 (pcase (list :a 1 :b 2 :c 3)
+                   ((cl-lambda (&key a b))
+                    (list a b)))))
+
+  (should (equal (list 1 2 nil)
+                 (pcase (list :a 1 :b 2)
+                   ((cl-lambda (&key a b c))
+                    (list a b c))))))
+
+(ert-deftest pcase-tests-cl-lambda-&key-permissive ()
+  "`&key' doesn't match unspecified keys unless `&allow-other-keys' or `:allow-other-keys' is given."
+  (should (equal (list 1 2)
+                 (pcase (list :a 1 :b 2 :c 3)
+                   ((cl-lambda (&key a b &allow-other-keys))
+                    (list a b)))))
+
+  (should (equal (list 1 2)
+                 (pcase (list :a 1 :b 2 :c 3 :allow-other-keys t)
+                   ((cl-lambda (&key a b))
+                    (list a b))))))
+
+(ert-deftest pcase-tests-cl-lambda-&key-not-first ()
+  "The plist should be after positional values and equal to `&rest'."
+  (should (equal (list 1 2 3 11 22)
+                 (pcase (list 1 2 3 :k1 11 :k2 22)
+                   ((cl-lambda (a b c &key k1 k2))
+                    (list a b c k1 k2)))))
+
+  (should (equal (list 1 2 3 (list :k1 11 :k2 22) 11 22)
+                 (pcase (list 1 2 3 :k1 11 :k2 22)
+                   ((cl-lambda (a b c &rest r1 &key k1 k2))
+                    (list a b c r1 k1 k2))))))
+
+(ert-deftest pcase-tests-cl-lambda-&key-full-form ()
+  (should (equal (list 1 2)
+                 (pcase (list :a 1 :b 2)
+                   ((cl-lambda (&key a (b 13)))
+                    (list a b)))))
+
+  (should (equal (list 1 13)
+                 (pcase (list :a 1)
+                   ((cl-lambda (&key a (b 13)))
+                    (list a b)))))
+
+  (should (equal (list 1 13 nil)
+                 (pcase (list :a 1)
+                   ((cl-lambda (&key a (b 13 b-supplied)))
+                    (list a b b-supplied)))))
+
+  (should (equal (list 1 2 t)
+                 (pcase (list :a 1 :b 2)
+                   ((cl-lambda (&key a (b 13 b-supplied)))
+                    (list a b b-supplied)))))
+
+  (should (equal (list 1 2 t)
+                 (pcase (list :a 1 :bat 2)
+                   ((cl-lambda (&key a ((:bat b) 13 b-supplied)))
+                    (list a b b-supplied)))))
+
+  (should (equal (list 1 2 t)
+                 (let ((key :bat))
+                   (pcase (list :a 1 :bat 2)
+                     ((cl-lambda (&key a ((key b) 13 b-supplied)))
+                      (list a b b-supplied)))))))
+
+(ert-deftest pcase-tests-cl-lambda-&key-sub-patterns ()
+  (should (equal '(1 2 (:c 77 :e should-ignore) nil 77 t 99 nil)
+                 (pcase '(:ab (1 2))
+                   ((cl-lambda (&key
+                                ((:ab `(,a ,b)))
+                                ((:cd (cl-lambda ( &whole cd
+                                                   &key
+                                                   (c 88 c-supp)
+                                                   ((:d d) 99 d-supp)
+                                                   &allow-other-keys)))
+                                 (list :c 77 :e 'should-ignore)
+                                 cd-supp)))
+                    (list a b cd cd-supp c c-supp d d-supp)))))
+
+  (should (equal '( 1 2 (:c 77 :e should-ignore :allow-other-keys t) nil
+                    77 t 99 nil)
+                 (pcase '(:ab (1 2))
+                   ((cl-lambda (&key
+                                ((:ab `(,a ,b)))
+                                ((:cd (cl-lambda ( &whole cd
+                                                   &key
+                                                   (c 88 c-supp)
+                                                   ((:d d) 99 d-supp))))
+                                 (list :c 77 :e 'should-ignore
+                                       :allow-other-keys t)
+                                 cd-supp)))
+                    (list a b cd cd-supp c c-supp d d-supp)))))
+
+  (should (equal nil
+                 (pcase '(:ab (1 2))
+                   ((cl-lambda (&key
+                                ((:ab `(,a ,b)))
+                                ((:cd (cl-lambda ( &whole cd
+                                                   &key
+                                                   (c 88 c-supp)
+                                                   ((:d d) 99 d-supp))))
+                                 (list :c 77 :e 'should-fail)
+                                 cd-supp)))
+                    (list a b cd cd-supp c c-supp d d-supp))))))
+
+(ert-deftest pcase-tests-cl-lambda-&aux-should-error ()
+  "`&aux' cannot be used after `&aux'."
+  (should-error (pcase nil
+                  ((cl-lambda (&aux a &aux b))
+                   (list a b)))
+                :type 'cl--pcase-lambda-list-bad-lambda-list))
+
+(ert-deftest pcase-tests-cl-lambda-&aux ()
+  (should (equal (list 1 2 nil nil)
+                 (pcase nil
+                   ((cl-lambda (&aux (a 1) (b 2) (c) d))
+                    (list a b c d)))))
+
+  (should (equal (list 0 1 2 nil nil)
+                 (pcase (list 0)
+                   ((cl-lambda (z0 &aux (a 1) (b 2) (c) d))
+                    (list z0 a b c d))))))
+
+(ert-deftest pcase-tests-cl-lambda-&aux-sub-patterns ()
+  (should (equal (list 1 2)
+                 (pcase nil
+                   ((cl-lambda (&aux (`(,a ,b) (list 1 2))))
+                    (list a b ))))))
+
+(ert-deftest pcase-tests-cl-lambda-all ()
+  (should (equal '(1 2 3 4 5 (:k1 111 :k2 222) 111 222 333 444)
+                 (pcase (list 1 2 3 4 5 :k1 111 :k2 222)
+                   ((cl-lambda ( a b c
+                                 &optional d e
+                                 &rest r
+                                 &key k1 k2
+                                 &aux (x1 333) (x2 444)))
+                    (list a b c d e r k1 k2 x1 x2))))))
+
 ;;; pcase-tests.el ends here.
-- 
2.34.1

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

> The attached patch adds the pattern `cl-lambda` for Pcase, which works
> like `cl-destructuring-bind`. There are two differences with the lambda
> lists:

Hmm... I'm not sure mixing the CL destructuring patterns with the Pcase
patterns (both of which are rather featureful and complex) will help
their popularity.

Beside that problem (which means I'm not very favorable to the
addition), the name should be changed because "lambda" is misleading.
It suggests this has to do with a function (I had to read the code to
understand what this is doing).

> The pattern is useful when one wants to combine the features of `pcase`
> and `cl-destructuring-bind`, such combining the optional values with the
> `pred` or `guard` patterns.

Do you have examples uses?

Maybe we could introduce a different Pcase pattern which covers those
needs but stays closer to the Pcase pattern syntax?


        Stefan

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Okamsn via Bug reports for GNU Emacs, the Swiss army knife of text editors]

Stefan Monnier wrote:
>> The attached patch adds the pattern `cl-lambda` for Pcase, which works
>> like `cl-destructuring-bind`. There are two differences with the lambda
>> lists:
> 
> Hmm... I'm not sure mixing the CL destructuring patterns with the Pcase
> patterns (both of which are rather featureful and complex) will help
> their popularity.
> 
> Beside that problem (which means I'm not very favorable to the
> addition), the name should be changed because "lambda" is misleading.
> It suggests this has to do with a function (I had to read the code to
> understand what this is doing).

I agree that the name is not ideal. When I searched for what the 
destructuring pattern was called, the website Common Lisp HyperSpec 
called it a "destructuring lambda list" 
(https://www.lispworks.com/documentation/HyperSpec/Body/03_de.htm). I 
would have suggested "cl", as it is the kind of destructuring used by 
the macros of cl-lib, but I thought that would not work well with the 
existence of the "cl-type" pattern. I also thought about something like 
"cl-arglist", if that is better.

>> The pattern is useful when one wants to combine the features of `pcase`
>> and `cl-destructuring-bind`, such combining the optional values with the
>> `pred` or `guard` patterns.
> 
> Do you have examples uses?

Not of that idea, no.  I maintain a library that implements a 
destructuring pattern like cl-lib 
(https://github.com/okamsn/loopy/blob/master/doc/loopy-doc.org#basic-destructuring) 
and I have been thinking about how I could use Pcase to simplify the 
implementation of the destructuring and to stop using a re-invented 
wheel. While doing that, it occurred to me that cl-lib itself might be a 
better place for such a Pcase pattern. To be clear, the patch only 
implements the cl-lib destructuring, not the other destructuring ideas 
from my library.

For me, I am interested in using such a destructuring pattern with 
`pcase-let` and `pcase-setq`, but not so much with `pcase` itself.

> Maybe we could introduce a different Pcase pattern which covers those
> needs but stays closer to the Pcase pattern syntax?

As far as I understand Pcase, one thing that I think cl-lib does better 
is specifying default values for multiple optional variables. For 
example, for `(a &optional (b 2) (c 3))` in Pcase, I would write

     (or `(,a ,b ,c)
         (and `(,a ,b)
              (let c 3))
         (and `(,a)
              (let c 3)
              (let b 2)))

or

     `(,a . ,(or `(,b . ,(or `(,c)
                             (let c 3)))
                 (and (let b 2)
                      (let c 3))))

in which there is repetition in the default values. Is there a better 
way to specify default values for optional elements?

Thank you.

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[João Távora]

On Tue, Dec 5, 2023 at 2:43 AM Okamsn via Bug reports for GNU Emacs,
the Swiss army knife of text editors <bug-gnu-emacs@gnu.org> wrote:

> For me, I am interested in using such a destructuring pattern with
> `pcase-let` and `pcase-setq`, but not so much with `pcase` itself.
>
> > Maybe we could introduce a different Pcase pattern which covers those
> > needs but stays closer to the Pcase pattern syntax?
>
> As far as I understand Pcase, one thing that I think cl-lib does better
> is specifying default values for multiple optional variables. For
> example, for `(a &optional (b 2) (c 3))` in Pcase, I would write

Yes.  cl-lib has a couple of neat tricks up its sleeve, still.

And what about keyword arguments in plists? Can pcase
destructure them?  If so, does it bind the "supplied-p" variable?
And can it rename the variable being destructured to something
else non-clashing?

All these things are useful in CL's destructuring-bind,
but it is missing other stuff like "casing" logic.  So
at least on a first glimpse, this reunion would be
welcome by me.

With the caveat that I haven't seen any examples or the
patch yet, and it matters.

João

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[João Távora]

On Mon, Dec 4, 2023 at 7:09 PM Stefan Monnier via Bug reports for GNU
Emacs, the Swiss army knife of text editors <bug-gnu-emacs@gnu.org>
wrote:
>
> > The attached patch adds the pattern `cl-lambda` for Pcase, which works
> > like `cl-destructuring-bind`. There are two differences with the lambda
> > lists:
>
> Hmm... I'm not sure mixing the CL destructuring patterns with the Pcase
> patterns (both of which are rather featureful and complex) will help
> their popularity.
>
> Beside that problem (which means I'm not very favorable to the
> addition), the name should be changed because "lambda" is misleading.
> It suggests this has to do with a function (I had to read the code to
> understand what this is doing).
>
> > The pattern is useful when one wants to combine the features of `pcase`
> > and `cl-destructuring-bind`, such combining the optional values with the
> > `pred` or `guard` patterns.
>
> Do you have examples uses?

I for one would like to see some examples too.  Okamsn's description
of this pcase extension sounds interesting.  In fact, it sounds very
much like the slime-dcase and sly-dcase macros in SLIME and SLY
respectively.

João

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Okamsn via Bug reports for GNU Emacs, the Swiss army knife of text editors]

[-- Attachment #1: Type: text/plain, Size: 1542 bytes --]

Stefan Monnier wrote:
>> The attached patch adds the pattern `cl-lambda` for Pcase, which works
>> like `cl-destructuring-bind`. There are two differences with the lambda
>> lists:
> 
> Hmm... I'm not sure mixing the CL destructuring patterns with the Pcase
> patterns (both of which are rather featureful and complex) will help
> their popularity.
> 
> Beside that problem (which means I'm not very favorable to the
> addition), the name should be changed because "lambda" is misleading.
> It suggests this has to do with a function (I had to read the code to
> understand what this is doing).
> 
>> The pattern is useful when one wants to combine the features of `pcase`
>> and `cl-destructuring-bind`, such combining the optional values with the
>> `pred` or `guard` patterns.
> 
> Do you have examples uses?
> 
> Maybe we could introduce a different Pcase pattern which covers those
> needs but stays closer to the Pcase pattern syntax?
> 
> 
>          Stefan
> 

Hello,

Because I wrote this patch with the thought that others might want it, I 
don't have any nontrivial examples to share right now. The best example 
I have for the use of the optional arguments is for the implementing of 
the optional arguments, which isn't very convincing.

I've updated the patch to rename the pattern to `cl-arglist` and to 
avoid creating intermediate variables using the `let` pattern, but I'm 
fine with resting the discussion here until a stronger argument can be 
made in favor of the patch.

Thank you.

[-- Attachment #2: v2-0001-Add-the-Pcase-pattern-cl-arglist-for-matching-a-C.patch --]
[-- Type: text/x-patch, Size: 38778 bytes --]

From e1752da863b44c93d139ca88bf8c7f6549229d18 Mon Sep 17 00:00:00 2001
From: Earl Hyatt <okamsn@protonmail.com>
Date: Sat, 25 Nov 2023 13:00:03 -0500
Subject: [PATCH v2] Add the Pcase pattern `cl-arglist' for matching a CL
 argument list.

This pattern matches function argument lists as described in the Info
node `(cl)Argument Lists'.

* lisp/emacs-lisp/cl-macs.el (cl-arglist--pcase-macroexpander)
(cl-arglist, cl--pcase-arglist-list-get-var-groups)
(cl--pcase-cl-arglist-positional-pattern)
(cl--pcase-cl-arglist-plist-keys)
(cl--pcase-cl-arglist-&key-pattern)
(cl--pcase-cl-arglist-&aux-pattern):
Add pattern and supporting functions.

* test/lisp/emacs-lisp/pcase-tests.el:
(pcase-tests-cl-arglist-&whole-should-error)
(pcase-tests-cl-arglist-&whole)
(pcase-tests-cl-arglist-pos, pcase-tests-cl-arglist-pos-sub-patterns)
(pcase-tests-cl-arglist-&optional-should-error)
(pcase-tests-cl-arglist-&optional)
(pcase-tests-cl-arglist-&optional-sub-patterns)
(pcase-tests-cl-arglist-&rest-should-error)
(pcase-tests-cl-arglist-&rest-nonlist-cdr)
(pcase-tests-cl-arglist-&rest-with-&whole)
(pcase-tests-cl-arglist-&rest-only)
(pcase-tests-cl-arglist-&rest-after-&optional)
(pcase-tests-cl-arglist-&rest-sub-patterns)
(pcase-tests-cl-arglist-&key-should-error)
(pcase-tests-cl-arglist-&key-exact)
(pcase-tests-cl-arglist-&key-permissive)
(pcase-tests-cl-arglist-&key-not-first)
(pcase-tests-cl-arglist-&key-full-form)
(pcase-tests-cl-arglist-&key-sub-patterns)
(pcase-tests-cl-arglist-&aux-should-error)
(pcase-tests-cl-arglist-&aux)
(pcase-tests-cl-arglist-&aux-sub-patterns)
(pcase-tests-cl-arglist-all):
Add tests.
---
 lisp/emacs-lisp/cl-macs.el          | 343 ++++++++++++++++++
 test/lisp/emacs-lisp/pcase-tests.el | 515 ++++++++++++++++++++++++++++
 2 files changed, 858 insertions(+)

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 7c207d372fc..0e10011a506 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -3825,6 +3825,349 @@ cl-type
 TYPE is a type descriptor as accepted by `cl-typep', which see."
   `(pred (pcase--flip cl-typep ',type)))
 
+;;; Pcase lambda-list pattern
+
+;; This pattern is like `cl-destructuring-bind', but with `pcase'.  We
+;; can't use `cl--do-arglist' for this, because `cl--do-arglist' uses
+;; `pop' to modify earlier variables while setting later ones, which
+;; doesn't seem to work with `pcase'.
+
+(define-error 'cl--pcase-cl-arglist-invalid-arg-list
+              "Invalid argument list used in `cl-arglist' pattern.")
+
+(defun cl--pcase-cl-arglist-var-groups (lambda-list)
+  "Return the alist of variable groups in LAMBDA-LIST.
+
+Lists are of the form
+`([&whole WHOLE-VAR] [POS-VARS] [&optional OPT-VARS] [&rest REST-VAR]
+[&key KEY-VARS] [&aux AUX-VARS])'."
+  (let ((whole-var) (processing-whole)
+        (pos-var)
+        (opt-var) (processing-opts)
+        (rest-var) (processing-rest) (dotted-rest-var)
+        (key-var) (processing-keys) (allow-other-keys)
+        (aux-var) (processing-auxs)
+        (remaining-list (cl-copy-list lambda-list)))
+
+    (when (not (proper-list-p remaining-list))
+      (cl-shiftf dotted-rest-var
+                 (cdr (last remaining-list))
+                 nil))
+
+    (cl-flet ((missing-after (cdr) (or (null cdr)
+                                       (memq (car cdr) cl--lambda-list-keywords)))
+              (stop-processing () (setq processing-whole nil
+                                        processing-opts nil
+                                        processing-rest nil
+                                        processing-keys nil
+                                        processing-auxs nil)))
+
+      (cl-loop
+       for (first . rest) on remaining-list
+       do
+       (pcase first
+         ('&whole
+          (if (or (missing-after rest)
+                  whole-var pos-var opt-var
+                  rest-var key-var allow-other-keys aux-var)
+              (signal 'cl--pcase-cl-arglist-invalid-arg-list (list lambda-list))
+            (stop-processing)
+            (setq processing-whole t)))
+
+         ('&optional
+          (if (or (missing-after rest)
+                  opt-var rest-var key-var allow-other-keys aux-var)
+              (signal 'cl--pcase-cl-arglist-invalid-arg-list
+                      (list lambda-list))
+            (stop-processing)
+            (setq processing-opts t)))
+
+         ((or '&rest '&body)
+          (if (or (missing-after rest)
+                  rest-var key-var allow-other-keys aux-var
+                  dotted-rest-var)
+              (signal 'cl--pcase-cl-arglist-invalid-arg-list
+                      (list lambda-list))
+            (stop-processing)
+            (setq processing-rest t)))
+
+         ('&key
+          (if (or (missing-after rest)
+                  key-var allow-other-keys aux-var
+                  dotted-rest-var)
+              (signal 'cl--pcase-cl-arglist-invalid-arg-list
+                      (list lambda-list))
+            (stop-processing)
+            (setq processing-keys t)))
+
+         ('&allow-other-keys
+          (if (or (not processing-keys)
+                  allow-other-keys
+                  dotted-rest-var)
+              (signal 'cl--pcase-cl-arglist-invalid-arg-list
+                      (list lambda-list))
+            (stop-processing)
+            (setq allow-other-keys t)))
+
+         ('&aux
+          (if (or (missing-after rest)
+                  aux-var
+                  dotted-rest-var)
+              (signal 'cl--pcase-cl-arglist-invalid-arg-list
+                      (list lambda-list))
+            (stop-processing)
+            (setq processing-auxs t)))
+
+         ((guard processing-whole)
+          (setq whole-var first
+                processing-whole nil))
+
+         ((guard processing-rest)
+          (setq rest-var first
+                processing-rest nil))
+
+         ((guard processing-opts)
+          (push first opt-var))
+
+         ((guard processing-keys)
+          (push first key-var))
+
+         ((guard processing-auxs)
+          (push first aux-var))
+
+         ('&environment
+          (signal 'cl--pcase-cl-arglist-invalid-arg-list
+                  (list lambda-list)))
+
+         (_
+          (if (or opt-var rest-var key-var aux-var
+                  allow-other-keys)
+              (signal 'cl--pcase-cl-arglist-invalid-arg-list
+                      (list lambda-list))
+            (push first pos-var))))))
+
+    `((whole . ,whole-var)
+      (pos . ,(nreverse pos-var))
+      (opt . ,(nreverse opt-var))
+      (rest . ,(or dotted-rest-var rest-var))
+      (key . ,(nreverse key-var))
+      (allow-other-keys . ,allow-other-keys)
+      (aux . ,(nreverse aux-var)))))
+
+(defun cl--pcase-cl-arglist-positional-pattern (pos-vars opt-vars rest-var key-vars)
+  "Build a pattern for the positional, `&optional', and `&rest' variables.
+
+POS-VARS is the list of the positional variables.  OPT-VARS is the list of
+the optional variables.  REST-VAR is the `&rest' variable."
+  ;; A modified version of the back-quote pattern to better work with
+  ;; optional values.
+  (cond
+   (pos-vars `(and (pred consp)
+                   (app car-safe ,(car pos-vars))
+                   (app cdr-safe ,(cl--pcase-cl-arglist-positional-pattern
+                                   (cdr pos-vars) opt-vars
+                                   rest-var key-vars))))
+   (opt-vars (pcase-let (((or `(,var ,default ,supplied)
+                              `(,var ,default)
+                              `(,var)
+                              var)
+                          (car opt-vars)))
+               `(and (pred listp)
+                     (app car-safe (or (and (pred null)
+                                            ,@(when supplied `((let ,supplied nil)))
+                                            ,@(when default `((let ,var ,default))))
+                                       ,(if supplied
+                                            `(and (let ,supplied t)
+                                                  ,var)
+                                          var)))
+                     (app cdr-safe ,(cl--pcase-cl-arglist-positional-pattern
+                                     nil (cdr opt-vars)
+                                     rest-var key-vars)))))
+   (rest-var rest-var)
+   ;; `pcase' allows `(,a ,b) to match (1 2 3), so we need to make
+   ;; sure there aren't more values left.  However, if we are using
+   ;; `&key', then we allow more values.
+   (key-vars '_)
+   (t '(pred null))))
+
+(defun cl--pcase-cl-arglist-&key-pattern (key-vars allow-other-keys)
+  "Build a `pcase' pattern for the `&key' variables.
+
+KEY-VARS are the forms of the key variables.  ALLOW-OTHER-KEYS is
+whether `&allow-other-keys' was used.  PLIST-VAR is the variable
+holding the property list."
+  ;; If we aren't checking whether all keys in EXPVAL were given,
+  ;; then we can use simpler patterns since we don't need to store the
+  ;; value of the key.
+  (cl-flet ((get-var-data (var-form)
+              (pcase-let (((or (or `((,key ,var) ,default ,supplied)
+                                   `((,key ,var) ,default)
+                                   `((,key ,var)))
+                               (and (or `(,var ,default ,supplied)
+                                        `(,var ,default)
+                                        `(,var)
+                                        (and (pred symbolp)
+                                             var))
+                                    ;; Strip a leading underscore, since it
+                                    ;; only means that this argument is
+                                    ;; unused, but shouldn't affect the
+                                    ;; key's name (bug#12367).
+                                    (let key (intern
+                                              (format ":%s"
+                                                      (let ((name (symbol-name var)))
+                                                        (if (eq ?_ (aref name 0))
+                                                            (substring name 1)
+                                                          name)))))))
+                           var-form))
+                (list key var default supplied))))
+    (if allow-other-keys
+        `(and ,@(mapcar (lambda (var-form)
+                          (pcase-let ((`(,key ,var ,default ,supplied) (get-var-data var-form))
+                                      (key-found (gensym "key-found"))
+                                      (plist (gensym "plist")))
+                            (cond (supplied
+                                   `(app (lambda (,plist)
+                                           (let ((,key-found (plist-member ,plist ,key)))
+                                             (if ,key-found
+                                                 (cons t (cadr ,plist))
+                                               (cons nil ,default))))
+                                         (,'\` ((,'\, ,supplied) . (,'\, ,var)))))
+                                  (default
+                                   `(app (lambda (,plist)
+                                           (let ((,key-found (plist-member ,plist ,key)))
+                                             (if ,key-found
+                                                 (cadr ,plist)
+                                               ,default)))
+                                         ,var))
+                                  (t
+                                   `(app (pcase--flip plist-get ,key)
+                                         ,var)))))
+                        key-vars))
+      ;; If we are checking whether there are no other keys in EXPVAL,
+      ;; then we use a single function for extracting the associated
+      ;; values and performing the check, whose output we match against
+      ;; a list of patterns.
+      (let ((res (gensym "res"))
+            (keys (gensym "keys"))
+            (plist (gensym "plist"))
+            (pats nil))
+        `(app (lambda (,plist)
+                (let ((,res nil)
+                      (,keys nil))
+                  ,@(cl-loop
+                     for (key var default supplied) in (mapcar #'get-var-data key-vars)
+                     collect (macroexp-let2* ((keyval key))
+                                 nil
+                               `(progn
+                                  (push ,keyval ,keys)
+                                  ,(cond
+                                    (supplied
+                                     (push supplied pats)
+                                     (push var pats)
+                                     (cl-once-only ((key-found `(plist-member ,plist ,keyval)))
+                                       `(if ,key-found
+                                            (progn
+                                              (push t ,res)
+                                              (push (cadr ,key-found) ,res))
+                                          (push nil ,res)
+                                          (push ,default ,res))))
+                                    (default
+                                     (push var pats)
+                                     (cl-once-only ((key-found `(plist-member ,plist ,keyval)))
+                                       `(if ,key-found
+                                            (push (cadr ,key-found) ,res)
+                                          (push ,default ,res))))
+                                    (t
+                                     (push var pats)
+                                     `(push (plist-get ,plist ,keyval)
+                                            ,res))))))
+                  (push (or (plist-get ,plist :allow-other-keys)
+                            (cl-loop for (key _val) on ,plist by #'cddr
+                                     always (memq key ,keys)))
+                        ,res)
+                  ;; Reverse in case a latter pattern use a variable
+                  ;; from an earlier pattern.
+                  (nreverse ,res)))
+              (,'\` ,(cl-loop for pat in (reverse (cons '(pred (not null))
+                                                        pats))
+                              collect `(,'\, ,pat))))))))
+
+(defun cl--pcase-cl-arglist-&aux-pattern (aux-vars)
+  "Build `pcase' pattern for `&aux' variables.
+
+AUX-VARS is the list of bindings."
+  `(and ,@(cl-loop for bind in aux-vars
+                   collect (pcase-let (((or `(,var ,val)
+                                            `(,var)
+                                            var)
+                                        bind))
+                             `(let ,var ,val)))))
+
+;;;###autoload
+(pcase-defmacro cl-arglist (arglist)
+  "Match a CL argument list, as in `cl-defun' and `cl-defmacro'.
+
+See the Info node `(cl)Argument Lists'.
+
+This pattern does not support `&environment'.
+
+`&key' will fail to match if there are more keys in the plist
+then specified, unless `&allow-other-keys' is given or unless the
+plist associates the key `:allow-other-keys' with a non-nil
+value.  Unlike `cl-destructuring-bind', this pattern does not
+signal an error if there are unmatched keys in the plist.
+
+Unlike the back-quote pattern, the pattern will fail to match if the
+non-optional part of ARGLIST is shorter than EXPVAL.
+
+For this `pcase' pattern, the variables in ARGLIST can
+themselves be `pcase' patterns, instead of just symbols as in a
+normal CL lambda list.  However, argument-list constructs like
+`&optional', `&key', and `&aux' use sub-lists to specify default
+values and other features.  For example,
+
+    (cl-arglist (&optional (opt1 default1 opt1-supplied)))
+
+Therefore, to avoid ambiguity, the use of sub-patterns can only
+be done within the sub-list for those constructs.  For example,
+
+    (cl-arglist (&optional ((and opt1 (guard (listp opt1)))
+                           nil)))
+
+For similar reasons, the cdr of a dotted list (as opposed to the
+element following `&rest') for the remainder of a list cannot be
+a sub-pattern."
+  (let* ((groups (cl--pcase-cl-arglist-var-groups arglist))
+         (whole-var (alist-get 'whole groups))
+         (pos-vars (alist-get 'pos groups))
+         (opt-vars (alist-get 'opt groups))
+         (rest-var (alist-get 'rest groups))
+         (key-vars (alist-get 'key groups))
+         (allow-other-keys (alist-get 'allow-other-keys groups))
+         (aux-vars (alist-get 'aux groups)))
+    (remq nil
+          `(and (pred listp)
+                ,(when whole-var
+                   whole-var)
+                ,(when (or pos-vars opt-vars rest-var)
+                   (cl--pcase-cl-arglist-positional-pattern
+                    pos-vars opt-vars
+                    rest-var key-vars))
+                ,(when key-vars
+                   (cond
+                    (rest-var `(app (lambda (_) ,rest-var)
+                                    ,(cl--pcase-cl-arglist-&key-pattern
+                                      key-vars allow-other-keys)))
+                    ((or pos-vars opt-vars)
+                     `(app (nthcdr ,(+ (length pos-vars)
+                                       (length opt-vars)))
+                           ,(cl--pcase-cl-arglist-&key-pattern
+                             key-vars allow-other-keys)))
+                    (t (cl--pcase-cl-arglist-&key-pattern
+                        key-vars allow-other-keys))))
+                ,(when aux-vars
+                   (cl--pcase-cl-arglist-&aux-pattern aux-vars))))))
+
 ;; Local variables:
 ;; generated-autoload-file: "cl-loaddefs.el"
 ;; End:
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index 799e8d36647..108e4b96d04 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -160,4 +160,519 @@ pcase-tests-setq
   (should-error (pcase-setq a)
                 :type '(wrong-number-of-arguments)))
 
+;;;; Tests for the `cl-arglist' `pcase' pattern.
+
+(ert-deftest pcase-tests-cl-arglist-&whole-should-error ()
+  "`&whole' must come first if given, and must be followed by a patter."
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&whole))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (a b &whole c))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&rest a &whole c))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&key a &whole c))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&aux (a 1) &whole c))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&optional (a 1) &whole c))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&whole whole1 &whole whole2))
+                   (list whole1 whole2)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list))
+
+(ert-deftest pcase-tests-cl-arglist-&whole ()
+  "`&whole' can be a `pcase' pattern."
+  (should (equal (list (list 1 2 3) 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-arglist (&whole whole a b c))
+                    (list whole a b c)))))
+
+  (should (equal (list 1 2 3 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-arglist (&whole `(,a0 ,b0 ,c0) a b c))
+                    (list a0 b0 c0 a b c))))))
+
+(ert-deftest pcase-tests-cl-arglist-pos ()
+  "Positional variables must match the length of EXPVAL."
+  (should (equal (list 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-arglist (a b c))
+                    (list a b c)))))
+
+  (should (equal nil
+                 (pcase (list (list 1))
+                   ((cl-arglist (a b))
+                    (list a b)))))
+
+  (should (equal nil
+                 (pcase (list (list 1 2 3))
+                   ((cl-arglist (a b))
+                    (list a b))))))
+
+(ert-deftest pcase-tests-cl-arglist-pos-sub-patterns ()
+  (should (equal (list 1 2 3 4)
+                 (pcase (list 1 2 (list 3 4))
+                   ((cl-arglist (a b (cl-arglist (c d))))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2)
+                 (pcase (list (list 1 2))
+                   ((cl-arglist (`(,a ,b)))
+                    (list a b))))))
+
+(ert-deftest pcase-tests-cl-arglist-&optional-should-error ()
+  "`&optional' cannot be used after `&optional', `&rest', `&key', and `&aux'."
+  (should-error (equal (list 1 2 3)
+                       (pcase (list 1 2 3)
+                         ((cl-arglist (&rest a &optional b c))
+                          (list a b c))))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&body a &optional b c))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&key a &optional b c))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&allow-other-keys &optional b c))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&aux (a 1) &optional b c))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&optional a &optional b c))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list))
+
+(ert-deftest pcase-tests-cl-arglist-&optional ()
+  (should (equal (list 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-arglist (a b &optional c))
+                    (list a b c)))))
+
+  (should (equal (list 1 2 nil)
+                 (pcase (list 1 2)
+                   ((cl-arglist (a b &optional c))
+                    (list a b c)))))
+
+  (should (equal (list 1 2 13)
+                 (pcase (list 1 2)
+                   ((cl-arglist (a b &optional (c 13)))
+                    (list a b c)))))
+
+  (should (equal (list 1 2 13 nil)
+                 (pcase (list 1 2)
+                   ((cl-arglist (a b &optional (c 13 c-supplied)))
+                    (list a b c c-supplied)))))
+
+  (should (equal (list 1 2 3 t)
+                 (pcase (list 1 2 3)
+                   ((cl-arglist (a b &optional (c 13 c-supplied)))
+                    (list a b c c-supplied))))))
+
+(ert-deftest pcase-tests-cl-arglist-&optional-sub-patterns ()
+  "Test using sub-patterns in `cl-arglist' pattern.
+Sub-patterns must be contained within a sub-list, since a sub-list
+also provides a default value."
+  (should-error (pcase (list 1 2 (list 3 4))
+                  ((cl-arglist (a b &optional `(,c ,d)))
+                   (list a b c d))))
+
+  (should (equal (list 1 2 33)
+                 (pcase (list 1 2)
+                   ((cl-arglist (a b &optional ((and opt1
+                                                    (guard (numberp opt1)))
+                                               33)))
+                    (list a b opt1)))))
+
+  (should (equal nil
+                 (pcase (list 1 2 'not-num)
+                   ((cl-arglist (a b &optional ((and opt1
+                                                    (guard (numberp opt1)))
+                                               33)))
+                    (list a b opt1)))))
+
+  (should (equal nil
+                 (pcase (list 1 2 nil)
+                   ((cl-arglist (a b &optional ((and opt1
+                                                    (guard (numberp opt1)))
+                                               'not-num)))
+                    (list a b opt1)))))
+
+  (should (equal (list 1 2 3 4)
+                 (pcase (list 1 2 (list 3 4))
+                   ((cl-arglist (a b &optional (`(,c ,d))))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 nil nil)
+                 (pcase (list 1 2)
+                   ((cl-arglist (a b &optional (`(,c ,d))))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 13 14)
+                 (pcase (list 1 2)
+                   ((cl-arglist (a b &optional (`(,c ,d) (list 13 14))))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 13 14)
+                 (pcase (list 1 2)
+                   ((cl-arglist ( a b
+                                 &optional ((cl-arglist (c &optional (d 14)))
+                                            (list 13))))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 13 14 nil)
+                 (pcase (list 1 2)
+                   ((cl-arglist (a b &optional (`(,c ,d) (list 13 14) cd-supplied)))
+                    (list a b c d cd-supplied)))))
+
+  (should (equal (list 1 2 13 14 nil t nil)
+                 (pcase (list 1 2)
+                   ((cl-arglist ( a b
+                                 &optional
+                                 ((cl-arglist (&optional (c 27 c-sub-sup)
+                                                        (d 14 d-sub-sup)))
+                                  (list 13)
+                                  cd-supplied)))
+                    (list a b c d cd-supplied c-sub-sup d-sub-sup))))))
+
+(ert-deftest pcase-tests-cl-arglist-&rest-should-error ()
+  "`&rest' (`&body', `.') cannot be used after `&rest', `&body', `&key',and `&aux'."
+  (should-error (equal (list 1 2 3)
+                       (pcase (list 1 2 3)
+                         ((cl-arglist (&rest a &rest b))
+                          (list a b c))))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (equal (list 1 2 3)
+                       (pcase (list 1 2 3)
+                         ((cl-arglist (&body a &body b))
+                          (list a b c))))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (equal (list 1 2 3)
+                       (pcase (list 1 2 3)
+                         ((cl-arglist (&body a . b))
+                          (list a b c))))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&body a &rest b))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&rest a &body b))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&key a &rest b))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&key a &body b))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&key a . b))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&allow-other-keys &rest b))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&allow-other-keys &body b))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&allow-other-keys . b))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&aux (a 1) &rest b))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&aux (a 1) &body b))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list 1 2 3)
+                  ((cl-arglist (&aux (a 1) . b))
+                   (list a b c)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list))
+
+(ert-deftest pcase-tests-cl-arglist-&rest-nonlist-cdr ()
+  (should (equal (list 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-arglist (a &rest b))
+                    (list a b)))))
+
+  (should (equal (list 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-arglist (a &body b))
+                    (list a b)))))
+
+  (should (equal (list 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-arglist (a . b))
+                    (list a b))))))
+
+(ert-deftest pcase-tests-cl-arglist-&rest-with-&whole ()
+  (should (equal (list (cons 1 2) 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-arglist (&whole whole a &rest b))
+                    (list whole a b)))))
+
+  (should (equal (list (cons 1 2) 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-arglist (&whole whole a &body b))
+                    (list whole a b)))))
+
+  (should (equal (list (cons 1 2) 1 2)
+                 (pcase (cons 1 2)
+                   ((cl-arglist (&whole whole a . b))
+                    (list whole a b))))))
+
+(ert-deftest pcase-tests-cl-arglist-&rest-only ()
+  "Using only `&rest' should work like `&whole'."
+  (should (equal (list (list 1 2))
+                 (pcase (list 1 2)
+                   ((cl-arglist (&rest a))
+                    (list a)))))
+
+  (should (equal (list (cons 1 2))
+                 (pcase (cons 1 2)
+                   ((cl-arglist (&body a))
+                    (list a))))))
+
+(ert-deftest pcase-tests-cl-arglist-&rest-after-&optional ()
+  (should (equal (list 1 2 3 (list 4 5))
+                 (pcase (list 1 2 3 4 5)
+                   ((cl-arglist (&optional a b c &rest d))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 3 (list 4 5))
+                 (pcase (list 1 2 3 4 5)
+                   ((cl-arglist (&optional a b c &body d))
+                    (list a b c d)))))
+
+  (should (equal (list 1 2 3 (list 4 5))
+                 (pcase (list 1 2 3 4 5)
+                   ((cl-arglist (&optional a b c . d))
+                    (list a b c d))))))
+
+(ert-deftest pcase-tests-cl-arglist-&rest-sub-patterns ()
+  ;; We can't do (a . `(,b . ,c)), so we don't test that.
+  (should (equal (list 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-arglist (a &rest (cl-arglist (b c))))
+                    (list a b c)))))
+
+  (should (equal (list 1 2 3)
+                 (pcase (list 1 2 3)
+                   ((cl-arglist (a &body `(,b ,c)))
+                    (list a b c))))))
+
+(ert-deftest pcase-tests-cl-arglist-&key-should-error ()
+  "`&key' cannot be used after `&key', `&allow-other-keys', and `&aux'."
+  (should-error (pcase (list :a 1 :b 2)
+                  ((cl-arglist (&key a &key b))
+                   (list a b)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list :a 1 :b 2)
+                  ((cl-arglist (&aux (a 1) &key b))
+                   (list a b)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list)
+
+  (should-error (pcase (list :a 1 :b 2)
+                  ((cl-arglist (&allow-other-keys &key b))
+                   (list a b)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list))
+
+(ert-deftest pcase-tests-cl-arglist-&key-exact ()
+  "`&key' doesn't match unspecified keys unless `&allow-other-keys' or `:allow-other-keys' is given."
+  (should (equal (list 1 2)
+                 (pcase (list :a 1 :b 2)
+                   ((cl-arglist (&key a b))
+                    (list a b)))))
+
+  (should (equal nil
+                 (pcase (list :a 1 :b 2 :c 3)
+                   ((cl-arglist (&key a b))
+                    (list a b)))))
+
+  (should (equal (list 1 2 nil)
+                 (pcase (list :a 1 :b 2)
+                   ((cl-arglist (&key a b c))
+                    (list a b c))))))
+
+(ert-deftest pcase-tests-cl-arglist-&key-permissive ()
+  "`&key' doesn't match unspecified keys unless `&allow-other-keys' or `:allow-other-keys' is given."
+  (should (equal (list 1 2)
+                 (pcase (list :a 1 :b 2 :c 3)
+                   ((cl-arglist (&key a b &allow-other-keys))
+                    (list a b)))))
+
+  (should (equal (list 1 2)
+                 (pcase (list :a 1 :b 2 :c 3 :allow-other-keys t)
+                   ((cl-arglist (&key a b))
+                    (list a b))))))
+
+(ert-deftest pcase-tests-cl-arglist-&key-not-first ()
+  "The plist should be after positional values and equal to `&rest'."
+  (should (equal (list 1 2 3 11 22)
+                 (pcase (list 1 2 3 :k1 11 :k2 22)
+                   ((cl-arglist (a b c &key k1 k2))
+                    (list a b c k1 k2)))))
+
+  (should (equal (list 1 2 3 (list :k1 11 :k2 22) 11 22)
+                 (pcase (list 1 2 3 :k1 11 :k2 22)
+                   ((cl-arglist (a b c &rest r1 &key k1 k2))
+                    (list a b c r1 k1 k2))))))
+
+(ert-deftest pcase-tests-cl-arglist-&key-full-form ()
+  (should (equal (list 1 2)
+                 (pcase (list :a 1 :b 2)
+                   ((cl-arglist (&key a (b 13)))
+                    (list a b)))))
+
+  (should (equal (list 1 13)
+                 (pcase (list :a 1)
+                   ((cl-arglist (&key a (b 13)))
+                    (list a b)))))
+
+  (should (equal (list 1 13 nil)
+                 (pcase (list :a 1)
+                   ((cl-arglist (&key a (b 13 b-supplied)))
+                    (list a b b-supplied)))))
+
+  (should (equal (list 1 2 t)
+                 (pcase (list :a 1 :b 2)
+                   ((cl-arglist (&key a (b 13 b-supplied)))
+                    (list a b b-supplied)))))
+
+  (should (equal (list 1 2 t)
+                 (pcase (list :a 1 :bat 2)
+                   ((cl-arglist (&key a ((:bat b) 13 b-supplied)))
+                    (list a b b-supplied)))))
+
+  (should (equal (list 1 2 t)
+                 (let ((key :bat))
+                   (pcase (list :a 1 :bat 2)
+                     ((cl-arglist (&key a ((key b) 13 b-supplied)))
+                      (list a b b-supplied)))))))
+
+(ert-deftest pcase-tests-cl-arglist-&key-sub-patterns ()
+  (should (equal '(1 2 (:c 77 :e should-ignore) nil 77 t 99 nil)
+                 (pcase '(:ab (1 2))
+                   ((cl-arglist (&key
+                                 ((:ab `(,a ,b)))
+                                 ((:cd (cl-arglist ( &whole cd
+                                                     &key
+                                                     (c 88 c-supp)
+                                                     ((:d d) 99 d-supp)
+                                                     &allow-other-keys)))
+                                  (list :c 77 :e 'should-ignore)
+                                  cd-supp)))
+                    (list a b cd cd-supp c c-supp d d-supp)))))
+
+  (should (equal '( 1 2 (:c 77 :e should-ignore :allow-other-keys t) nil
+                    77 t 99 nil)
+                 (pcase '(:ab (1 2))
+                   ((cl-arglist (&key
+                                 ((:ab `(,a ,b)))
+                                 ((:cd (cl-arglist ( &whole cd
+                                                     &key
+                                                     (c 88 c-supp)
+                                                     ((:d d) 99 d-supp))))
+                                  (list :c 77 :e 'should-ignore
+                                        :allow-other-keys t)
+                                  cd-supp)))
+                    (list a b cd cd-supp c c-supp d d-supp)))))
+
+  (should (equal nil
+                 (pcase '(:ab (1 2))
+                   ((cl-arglist (&key
+                                 ((:ab `(,a ,b)))
+                                 ((:cd (cl-arglist ( &whole cd
+                                                     &key
+                                                     (c 88 c-supp)
+                                                     ((:d d) 99 d-supp))))
+                                  (list :c 77 :e 'should-fail)
+                                  cd-supp)))
+                    (list a b cd cd-supp c c-supp d d-supp))))))
+
+(ert-deftest pcase-tests-cl-arglist-&aux-should-error ()
+  "`&aux' cannot be used after `&aux'."
+  (should-error (pcase nil
+                  ((cl-arglist (&aux a &aux b))
+                   (list a b)))
+                :type 'cl--pcase-cl-arglist-invalid-arg-list))
+
+(ert-deftest pcase-tests-cl-arglist-&aux ()
+  (should (equal (list 1 2 nil nil)
+                 (pcase nil
+                   ((cl-arglist (&aux (a 1) (b 2) (c) d))
+                    (list a b c d)))))
+
+  (should (equal (list 0 1 2 nil nil)
+                 (pcase (list 0)
+                   ((cl-arglist (z0 &aux (a 1) (b 2) (c) d))
+                    (list z0 a b c d))))))
+
+(ert-deftest pcase-tests-cl-arglist-&aux-sub-patterns ()
+  (should (equal (list 1 2)
+                 (pcase nil
+                   ((cl-arglist (&aux (`(,a ,b) (list 1 2))))
+                    (list a b ))))))
+
+(ert-deftest pcase-tests-cl-arglist-all ()
+  (should (equal '(1 2 3 4 5 (:k1 111 :k2 222) 111 222 333 444)
+                 (pcase (list 1 2 3 4 5 :k1 111 :k2 222)
+                   ((cl-arglist ( a b c
+                                  &optional d e
+                                  &rest r
+                                  &key k1 k2
+                                  &aux (x1 333) (x2 444)))
+                    (list a b c d e r k1 k2 x1 x2))))))
+
 ;;; pcase-tests.el ends here.
-- 
2.34.1

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Stefan Kangas]

severity 67611 wishlist
tags 67611 + notabug wontfix
close 67611
thanks

Okamsn <okamsn@protonmail.com> writes:

> Hello,
>
> Because I wrote this patch with the thought that others might want it, I
> don't have any nontrivial examples to share right now. The best example
> I have for the use of the optional arguments is for the implementing of
> the optional arguments, which isn't very convincing.
>
> I've updated the patch to rename the pattern to `cl-arglist` and to
> avoid creating intermediate variables using the `let` pattern, but I'm
> fine with resting the discussion here until a stronger argument can be
> made in favor of the patch.
>
> Thank you.

Thanks for the patch.  I can only echo the sentiment already given here,
that making `pcase' more complex won't do much for its popularity.

It sounds like we mostly agree that no change should be made here, at
least not for the moment, so I'm inclined to close this one as wontfix.
It's always awkward to have to say no to a well-reasoned patch, but
sometimes a decision has to be made.  I hope you can understand, and
apologies for not accepting your patch.  I'm closing the bug with this
message.

Thank you again for contributing.

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[João Távora]

On Thu, Jan 11, 2024 at 9:12 PM Stefan Kangas <stefankangas@gmail.com> wrote:

> Thanks for the patch.  I can only echo the sentiment already given here,
> that making `pcase' more complex won't do much for its popularity.

This sentiment is not unanimous.  If pcase is naturally extensible,
using that ability is not making it more complex.  That'd be akin
to saying "defun" is made more complex because too many functions
are popping up.

Just wanted register this position. Though I don't know for sure if
the patch is simply adding a new extension to pcase or changing
its core structure.

I wish Okamsn would show one or two simple examples usage
of something you can't do with pcase today, but you would be
able to with the patch.

João

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Stefan Kangas]

João Távora <joaotavora@gmail.com> writes:

> On Thu, Jan 11, 2024 at 9:12 PM Stefan Kangas <stefankangas@gmail.com> wrote:
>
>> Thanks for the patch.  I can only echo the sentiment already given here,
>> that making `pcase' more complex won't do much for its popularity.
>
> This sentiment is not unanimous.  If pcase is naturally extensible,
> using that ability is not making it more complex.  That'd be akin
> to saying "defun" is made more complex because too many functions
> are popping up.
>
> Just wanted register this position. Though I don't know for sure if
> the patch is simply adding a new extension to pcase or changing
> its core structure.
>
> I wish Okamsn would show one or two simple examples usage
> of something you can't do with pcase today, but you would be
> able to with the patch.

feel free to reopen the bug report if you think it makes sense.

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[João Távora]

On Thu, Jan 11, 2024 at 10:13 PM Stefan Kangas <stefankangas@gmail.com> wrote:
>
> João Távora <joaotavora@gmail.com> writes:
>
> > On Thu, Jan 11, 2024 at 9:12 PM Stefan Kangas <stefankangas@gmail.com> wrote:
> >
> >> Thanks for the patch.  I can only echo the sentiment already given here,
> >> that making `pcase' more complex won't do much for its popularity.
> >
> > This sentiment is not unanimous.  If pcase is naturally extensible,
> > using that ability is not making it more complex.  That'd be akin
> > to saying "defun" is made more complex because too many functions
> > are popping up.
> >
> > Just wanted register this position. Though I don't know for sure if
> > the patch is simply adding a new extension to pcase or changing
> > its core structure.
> >
> > I wish Okamsn would show one or two simple examples usage
> > of something you can't do with pcase today, but you would be
> > able to with the patch.

In the meantime, I've had a look at the patch file to learn
about this pcase extension.

1. It is a pure extension.  The extension code happens in cl-macs.el

2. It is an alternative to cl-destructuring-bind, also defined
   in that file, with more typing involved.

3. It _seems_ it has the advantage that it relies on very little
   of cl-macs.el, like maybe just cl-copy-list.  Ie it could easily
   be changed to live in another file.  It could  even be a (better?)
   base to write cl-destructuring-bind and other cl-macs things on top
   of.  And to write other utils like Alexandria's
   cl-parse-ordinary-lambda-list or destructuring-case [1].

   A good lambda-list destructuring tool is valuable by itself, even
   without pcase integration.

4. Pcase integration is a "nice to have".  In the provided tests, the
   new extension is only tested as a destructuring aid, so I cannot tell
   very well how it fares int the matching aspect of pcase.  For example
   I did this experiment:

   (pcase (list 42 41 :c 42)
     ((cl-arglist (42 42 &key c))
      (list c))
     ((cl-arglist (42 b &rest more))
      (list b more)))

   This matches the second case, which is good and returns (41 (:c 42))

   But how do I construct a case that matches only if the provided
   value to c is 42, if this is at all possible?

> feel free to reopen the bug report if you think it makes sense.

I think it makes sense, but I don't know how to do that.  Just write
reopen 67611/thanks to this tracker?

João

[1]: https://gitlab.common-lisp.net/alexandria/alexandria

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Okamsn via Bug reports for GNU Emacs, the Swiss army knife of text editors]

João Távora wrote:
> 4. Pcase integration is a "nice to have".  In the provided tests, the
>     new extension is only tested as a destructuring aid, so I cannot tell
>     very well how it fares int the matching aspect of pcase.  For example
>     I did this experiment:
> 
>     (pcase (list 42 41 :c 42)
>       ((cl-arglist (42 42 &key c))
>        (list c))
>       ((cl-arglist (42 b &rest more))
>        (list b more)))
> ;; => (42 2)
>     This matches the second case, which is good and returns (41 (:c 42))
> 
>     But how do I construct a case that matches only if the provided
>     value to c is 42, if this is at all possible?

It is possible. You can give a pattern instead of a symbol for the 
variable, but you have to use a version of `&key` variables in which the 
pattern can't be confused for the normal `((KEY VAR) DEFAULT SUPPLIED)` 
form.  Please try the following:

     ;; => (42 2)
     (pcase (list :c 42)
       ((cl-arglist (&key ((:c (and 43 c)))))
        (list c 1))
       ((cl-arglist (&key ((:c (and 42 c)))))
        (list c 2)))

     ;; => (42 2)
     (pcase (list :c 42)
           ((cl-arglist (&key ((:c (and 43 c)))))
            (list c 1))
           ((cl-arglist (&key ((:c (and (pred (equal 42))
                                        c)))))
            (list c 2))
           ((cl-arglist (&key ((:c (and 44 c)))))
            (list c 3)))

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Stefan Kangas]

João Távora <joaotavora@gmail.com> writes:

> I think it makes sense, but I don't know how to do that.  Just write
> reopen 67611/thanks to this tracker?

Yes, on two separate lines to the control@ address.

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

>> Thanks for the patch.  I can only echo the sentiment already given here,
>> that making `pcase' more complex won't do much for its popularity.
> This sentiment is not unanimous.  If pcase is naturally extensible,
> using that ability is not making it more complex.  That'd be akin
> to saying "defun" is made more complex because too many functions
> are popping up.

Agreed.

> Just wanted register this position. Though I don't know for sure if
> the patch is simply adding a new extension to pcase or changing
> its core structure.

It's a pure extension.  The question is not whether the patch is good or
bad or whether it makes the existing infrastructure too complex.
It's rather where should such a thing live.

I don't think there's a clear enough need for it right now in Emacs core
to motivate its integration in Emacs proper.  Also, because several
people have expressed an opinion that leans towards recommending that
Emacs's own code should probably better avoid using this functionality.

I'd be quite happy to include such a think in GNU ELPA, OTOH.


        Stefan

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[João Távora]

[-- Attachment #1: Type: text/plain, Size: 2140 bytes --]

On Fri, Jan 12, 2024 at 3:05 AM Stefan Monnier <monnier@iro.umontreal.ca>
wrote:

> I don't think there's a clear enough need for it right now in Emacs core
> to motivate its integration in Emacs proper.  Also, because several
> people have expressed an opinion that leans towards recommending that
> Emacs's own code should probably better avoid using this functionality.

Those people are trying to come up with alternative pattern-matching
libraries which we start to see are not simpler or as powerful
as pcase.

But sure, other pattern-matching libraries exist out there.  See
CL's optima/trivia [1/2] for some very good ones.  Emacs just happens
to have pcase readily available.

> I'd be quite happy to include such a think in GNU ELPA, OTOH.

Could be, but why really?  Why are CL things which rest on such
high-quality well-known designs, older than many things Emacs,
relegated to a place where they're less discoverable?

Here, I think at least the new fresh implementation of
lambda-list parsing (which is the meat-and-bones of this patch)
is worth taking a look at.

It's the function 'cl--pcase-cl-lambda-var-groups'.

I would definitely consider grooming this function, renaming
it, and keeping it in core, exposing to general Elisp usage
in cl-macs.el (or cl-lambdalist.el, cl-ll.el), even if a new
pcase pattern that uses it goes to ELPA (but why, really?)

That util could help us write other lambda-list destructuring
alternatives that understand &optional, &rest.  Because with or
without it, we already use a lot of the &optional, &rest explicitly
in Emacs.  And we also use &key and &allow-other-keys in many other
places, though sometimes in ad-hoc lets-not-call-this-bull-by-its-name
fashion.

IOW there is no general purpose-util like Alexandria's
'parse-ordinary-lambda-list', and this could be it.  It could
not only be used to simplify and add coherence to many of these
existing compile-time structures, for example helping simplify
things and address FIXMEs in cl-lib.el.

João

[1] https://github.com/m2ym/optima
[2] https://github.com/guicho271828/trivia

[-- Attachment #2: Type: text/html, Size: 2723 bytes --]

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Stefan Monnier via Bug reports for GNU Emacs, the Swiss army knife of text editors]

>> I don't think there's a clear enough need for it right now in Emacs core
>> to motivate its integration in Emacs proper.  Also, because several
>> people have expressed an opinion that leans towards recommending that
>> Emacs's own code should probably better avoid using this functionality.
> Those people are trying to come up with alternative pattern-matching
> libraries which we start to see are not simpler or as powerful
> as pcase.

Only some of them are.  Others are perfectly happy with using `pcase`
but still aren't super happy about combining the complexity of `pcase`
with that of CL destructuring syntax.

Personally I'm rather put off by the difficulty of figuring out which
part is using CL syntax and which part is using Pcase: the transition
from Pcase to CL is fairly clear (marked by `cl-arglist` or somesuch),
but the other is much less so.

I'd be happier with a `cl-arglist` which cannot contain nested Pcase
patterns (i.e. a one-way street from Pcase to CL) with
`cl-destructuring-bind` reimplemented on top of it.

I'd also be interested in a new Pcase pattern that provides the part of
`cl-arglist` functionality that's missing from current Pcase patterns
(like "optional" elements in a list), but with a syntax that blends
better in Pcase patterns.

> IOW there is no general purpose-util like Alexandria's
> 'parse-ordinary-lambda-list', and this could be it.  It could
> not only be used to simplify and add coherence to many of these
> existing compile-time structures, for example helping simplify
> things and address FIXMEs in cl-lib.el.

That's a different question: improving up cl-lib's implementation would
be welcome, yes.  That's not what the current patch does, tho.


        Stefan

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[João Távora]

reopen 67611
thanks

On Fri, Jan 12, 2024 at 3:38 PM Stefan Monnier <monnier@iro.umontreal.ca> wrote:
>
> >> I don't think there's a clear enough need for it right now in Emacs core
> >> to motivate its integration in Emacs proper.  Also, because several
> >> people have expressed an opinion that leans towards recommending that
> >> Emacs's own code should probably better avoid using this functionality.
> > Those people are trying to come up with alternative pattern-matching
> > libraries which we start to see are not simpler or as powerful
> > as pcase.
>
> Only some of them are.  Others are perfectly happy with using `pcase`
> but still aren't super happy about combining the complexity of `pcase`
> with that of CL destructuring syntax.
>
> Personally I'm rather put off by the difficulty of figuring out which
> part is using CL syntax and which part is using Pcase: the transition
> from Pcase to CL is fairly clear (marked by `cl-arglist` or somesuch),
> but the other is much less so.
> I'd be happier with a `cl-arglist` which cannot contain nested Pcase
> patterns (i.e. a one-way street from Pcase to CL) with
> `cl-destructuring-bind` reimplemented on top of it.

Can a pcase extension even be a one-way street?   And if so, isn't
that contrary to the whole purpose of pcase itself? Why have this ban
specifically on a CL pattern (should really be called "lambda-list"
by the way) when we have a cl library in core and so many uses
of CL things that use CL-style lambda lists, with or without cl-*.el.

We have so many other less commonly used extensions, some of them
subtle performance problems, like seq extensions that rely on generic
functions.

Pcase is complicated and hard-to-follow yes.  Becasue complex pattern
matching is a complicated thing to express, just as regular expressions
are such a thing (I for one do not think 'rx' makes things particularly
simpler). If you ask me, we'd be better off designing an "explain pcase"
utility or designing font-lock rules that helps explain it.

The byte-compiler  is already traversing that anyway and flagging
unused variables and stuff.  Can't we use this to mark what is a
lexical variable and what is a literal symbol, for example?  Can't
we have a very clear highlighting of the pcase extension being
used, like highlighting the '`' or the 'cl-arglist' or the 'seq'.

> I'd also be interested in a new Pcase pattern that provides the part of
> `cl-arglist` functionality that's missing from current Pcase patterns
> (like "optional" elements in a list), but with a syntax that blends
> better in Pcase patterns.

I'd rather not reinvent half-baked CL things, as it's all
too common to discover later we should have gone full-baked and
we have digressed for no good reason.

> > IOW there is no general purpose-util like Alexandria's
> > 'parse-ordinary-lambda-list', and this could be it.  It could
> > not only be used to simplify and add coherence to many of these
> > existing compile-time structures, for example helping simplify
> > things and address FIXMEs in cl-lib.el.
>
> That's a different question: improving up cl-lib's implementation would
> be welcome, yes.  That's not what the current patch does, tho.

It provides a tool to help do that, of course.

Anyway if there's some common ground here, let's not throw
the entire baby out with the bathwater.

Maybe Okamsn can repurpose the helper function he created
to parse lambda lists to be akin to Alexandria's
parse-simple-lambda-list.  It seems it already is fairly
close (the alist retun type in Elisp is natural as we don't
have multiple values).  Also the function's implementaion
should be changed to rely on as little as possible of
existing cl-macs (cl-copy-list and cl-flet can maybe
be skipped -- and maybe added back again later).

Shoulnd't be a very hard job (I might be wrong).

Then we can consider merging that including figuring out
where to merge it.

And then we can continue discussing about the usefulness
the pcase patterns that can be built with it, sure.

I've reopened the bug.

João

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Stefan Kangas]

João Távora <joaotavora@gmail.com> writes:

> Pcase is complicated and hard-to-follow yes.  Becasue complex pattern
> matching is a complicated thing to express, just as regular expressions
> are such a thing

Pretty much, yes.  We could improve its documentation though.

We could add a tutorial to the ELisp manual, for example (probably not
included in the printed version).

> If you ask me, we'd be better off designing an "explain pcase"
> utility or designing font-lock rules that helps explain it.
>
> The byte-compiler  is already traversing that anyway and flagging
> unused variables and stuff.  Can't we use this to mark what is a
> lexical variable and what is a literal symbol, for example?  Can't
> we have a very clear highlighting of the pcase extension being
> used, like highlighting the '`' or the 'cl-arglist' or the 'seq'.

That would be very useful to explore, I think.

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

Would someone please tell me what syntax is being proposed here,
and show me an example, saying what it would mean?

I would like to try to adapt it it to cond*.  Maybe I could make it
simple enough for people to like it.


-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[João Távora]

Richard Stallman <rms@gnu.org> writes:

> Would someone please tell me what syntax is being proposed here,
> and show me an example, saying what it would mean?

Common-lisp style lambda lists.  The ones containing the &key and
&optional with more features.  It'd make it possible to use pcase for
things similar to cl-destructuring-bind, which I suppose you know.

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > > Would someone please tell me what syntax is being proposed here,
  > > and show me an example, saying what it would mean?

  > Common-lisp style lambda lists.  The ones containing the &key and
  > &optional with more features.

Thanks for answering, but its meaning is not concretely clear to me.

Could you tell me more concretely what this proposed feature would
look like in use?  Perhaps with an example including context?

pcase does not use lambda lists, and neither does cond*.  They are
based on the backquote construct, which does not use &-keywords.
I see a danger of conceptual incoherence here.

If we want to extend the kinds of constructs for destructuring lists,
we should extend the features of backquote.  That would give a more
coherent interface.

We could define ,? to specify an element that might br missing,
and ,& to specify a keyword argument.  These could work in backquote
for constructing lists as well as in destructiring.

(let ((x 9) (y 10) (z nil) (u 11) (v nil) (w '(12 13)))
  `(a ,x ,?y ,?z ,&(foo u) ,&(bar v) . ,w))

=> (a 9 10 foo 11 12 13)

That is my first stab at the design.  I think it is better,
for this purpose, than using parmlist keywords.
But maybe with more thinking we can find improvements.

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[João Távora]

On Wed, Jan 17, 2024 at 3:29 AM Richard Stallman <rms@gnu.org> wrote:

> Could you tell me more concretely what this proposed feature would
> look like in use?  Perhaps with an example including context?

Many examples in the patch, have you looked?

> pcase does not use lambda lists, and neither does cond*.

Pcase it extensible for any object structure the user may
think of you can think of. This proposal is an extension.

Here's an example

(pcase some-mistery-object
   ((cl-arglist (42 &key a b c))  ; this proposal
    (message "Oh, it starts it 42 and has c=%s" c))
   (`(,_ ,x ,_)
    (message "Boring three-element list with middle %s" x))
   (`[,_ ,x ,_]
    (message "Fancy vector with middle %s" x))
   ((franklinboing (nixneez)) ; my data-structure
    (message "This franklinboing has some nice nixneez %s=" nizneez)))

João

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  > > Could you tell me more concretely what this proposed feature would
  > > look like in use?  Perhaps with an example including context?

  > Many examples in the patch, have you looked?

I would not think of looking at a patch to code I don't understand.
To try to read and understand such a patch would be doing it the hard
way, and not wise.  Instead I asked you to send me examples so I could
get that information the easy way.

The examples in your patch could have done it if you had send me those
examples separatrly.  It's far more helpful to send an example than to
say, "Look through the patch for some."

  > (pcase some-mistery-object
  >    ((cl-arglist (42 &key a b c))  ; this proposal
  >     (message "Oh, it starts it 42 and has c=%s" c))
  >    (`(,_ ,x ,_)
  >     (message "Boring three-element list with middle %s" x))
  >    (`[,_ ,x ,_]
  >     (message "Fancy vector with middle %s" x))
  >    ((franklinboing (nixneez)) ; my data-structure
  >     (message "This franklinboing has some nice nixneez %s=" nizneez)))

Thanks.  Now I understand what your extension would be.

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[João Távora]

On Thu, Feb 8, 2024 at 3:49 AM Richard Stallman <rms@gnu.org> wrote:
>
> [[[ To any NSA and FBI agents reading my email: please consider    ]]]
> [[[ whether defending the US Constitution against all enemies,     ]]]
> [[[ foreign or domestic, requires you to follow Snowden's example. ]]]
>
>   > > Could you tell me more concretely what this proposed feature would
>   > > look like in use?  Perhaps with an example including context?
> examples separatrly.  It's far more helpful to send an example than to
> say, "Look through the patch for some."

You do this very often where you ask someone to summarize or explain
context just for you.  That's perfectly fine, you're polite and not
generally imposing.  But since we're all busy individuals, I also think
it's fine to point out that what you're looking for is close by.

>   > (pcase some-mistery-object
>   >    ((cl-arglist (42 &key a b c))  ; this proposal
>   >     (message "Oh, it starts it 42 and has c=%s" c))
>   >    (`(,_ ,x ,_)
>   >     (message "Boring three-element list with middle %s" x))
>   >    (`[,_ ,x ,_]
>   >     (message "Fancy vector with middle %s" x))
>   >    ((franklinboing (nixneez)) ; my data-structure
>   >     (message "This franklinboing has some nice nixneez %s=" nizneez)))
>
> Thanks.  Now I understand what your extension would be.

This is very similar from what you find in the patch in the form of ert tests.
Also it's not my extension.

Thanks,
João

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[Richard Stallman]

[[[ To any NSA and FBI agents reading my email: please consider    ]]]
[[[ whether defending the US Constitution against all enemies,     ]]]
[[[ foreign or domestic, requires you to follow Snowden's example. ]]]

  >   But since we're all busy individuals, I also think
  > it's fine to point out that what you're looking for is close by.

Thousands of incoming messages are close by in that same sense.  26 of
them have this same Subject line.  To find a specific one, not by a
string that uniquiely identifies it but by understanding what each one
says, would take a long time.  Then I would have to look through the
patch for examples.  That would be easy if the patch is short, but I
don't know how long it is.

If I made a habit of searching for everything myself rather than
asking for help from people who might find it quickly, I would fall
even more behind.

Thank you for helping me keep up.

  > Also it's not my extension.

I did not know who had wrote it, and I didn't intend the request
to be only to you.

-- 
Dr Richard Stallman (https://stallman.org)
Chief GNUisance of the GNU Project (https://gnu.org)
Founder, Free Software Foundation (https://fsf.org)
Internet Hall-of-Famer (https://internethalloffame.org)

bug#67611: [PATCH] Add a Pcase pattern `cl-lambda` equivalent to `cl-destructuring-bind`

[João Távora]

[-- Attachment #1: Type: text/plain, Size: 780 bytes --]

On Sun, Feb 11, 2024 at 3:28 AM Richard Stallman <rms@gnu.org> wrote:

> If I made a habit of searching for everything myself rather than
> asking for help from people who might find it quickly, I would fall
> even more behind.

I think your stance makes sense in an employer-employee relationship.
Personally, I don't search for "everything", just "some of it".  It's a
balance
worth honing.  As I wrote, asking is fine, so is replying that the answer

is nearby.  Sometimes I ask (in fact I did here, if you care to look up),
sometimes the answer really is nearby and it's just a question of using
a MUA to read up-thread.  You're free to ignore this advice, of course,
 I'm
just supplying it since you took issue with my "examples are in the patch".

João

[-- Attachment #2: Type: text/html, Size: 1156 bytes --]