Subject: bug#72328: closed (Re: bug#72328: [PATCH] Nested backquote in pcase)

From: [email-masked] (GNU bug Tracking System)
Date: Tue, 24 Sep 2024 18:41:03 +0000

Your bug report

#72328: [PATCH] Nested backquote in pcase

which was filed against the emacs package, has been closed.

The explanation is attached below, along with your original report.
If you require more details, please reply to [email-masked].

-- 
72328: https://debbugs.gnu.org/cgi/bugreport.cgi?bug=72328
GNU Bug Tracking System
Contact [email-masked] with problems

Subject: Re: bug#72328: [PATCH] Nested backquote in pcase
From: Stefan Monnier <[email-masked]>
To: Eli Zaretskii <[email-masked]>
Cc: Michael Heerdegen <[email-masked]>, [email-masked], [email-masked]
Date: Tue, 24 Sep 2024 14:02:03 -0400
List-Id: <debbugs-submit.debbugs.gnu.org>

> Thanks, then Stefan, please feel free to install.

Done, thanks,

        Stefan

Subject: [PATCH] Nested backquote in pcase
From: Thuna <[email-masked]>
To: [email-masked]
Date: Sun, 28 Jul 2024 02:40:00 +0200
List-Id: <debbugs-submit.debbugs.gnu.org>

Assuming a hypothetical `(pcase-assert OBJ PAT)' I would expect the
following to succeed:

  (pcase-assert '`,nil ``,nil)
  (pcase-assert '`,1 ``,,(pred integerp))
  (pcase-assert '`,@(list) ``,@,`(list . ,_))

which is to say: a comma should match its argument as a pattern only if
it escapes the original backquote (currently comma at all depths
"escape" the original backquote).

In case there is any interest in this, I have prepared a patch which
both adds the above as tests to pcase-tests.el and implements them in
pcase.el.

>From 9e7ab85e84bbdaf2520dee52aeec8b650b349c6a Mon Sep 17 00:00:00 2001
From: Thuna <[email-masked]>
Date: Sun, 28 Jul 2024 02:34:20 +0200
Subject: [PATCH] Handle nested backquotes in pcase

* lisp/emacs-lisp/pcase.el (pcase--expand-\`): Treat nested commas and
comma-ats as literal symbol matches, only consider their arguments as
patterns (or error in the case of comma-at) if the comma escapes the
original backquote.
* test/lisp/emacs-lisp/pcase-tests.el (pcase-tests-nested-backquote):
Add tests for the behavior of nested backquote patterns.
---
 lisp/emacs-lisp/pcase.el            | 17 +++++++++++------
 test/lisp/emacs-lisp/pcase-tests.el |  5 +++++
 2 files changed, 16 insertions(+), 6 deletions(-)

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 5a7f3995311..a4c855432ce 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -1142,17 +1142,18 @@ \`
   (declare (debug (pcase-QPAT)))
   (pcase--expand-\` qpat))
 
-(defun pcase--expand-\` (qpat)
+(defun pcase--expand-\` (qpat &optional depth)
+  (unless depth (setq depth 0))
   (cond
-   ((eq (car-safe qpat) '\,) (cadr qpat))
-   ((or (eq (car-safe qpat) '\,@) (eq qpat '...))
+   ((and (<= depth 0) (eq (car-safe qpat) '\,)) (cadr qpat))
+   ((and (<= depth 0) (or (eq (car-safe qpat) '\,@) (eq qpat '...)))
     (error "Unsupported QPAT: %S" qpat))
    ((vectorp qpat)
     (let* ((trivial t)
            (contents nil)
            (upats nil))
       (dotimes (i (length qpat))
-        (let* ((upat (pcase--expand-\` (aref qpat i))))
+        (let* ((upat (pcase--expand-\` (aref qpat i) depth)))
           (if (eq (car-safe upat) 'quote)
               (push (cadr upat) contents)
             (setq trivial nil))
@@ -1163,8 +1164,12 @@ pcase--expand-\`
               (app length ,(length qpat))
               ,@(nreverse upats)))))
    ((consp qpat)
-    (let ((upata (pcase--expand-\` (car qpat)))
-          (upatd (pcase--expand-\` (cdr qpat))))
+    (let ((upata (pcase--expand-\` (car qpat) depth))
+          (upatd (pcase--expand-\`
+                  (cdr qpat)
+                  (cond ((eq (car qpat) '\`) (1+ depth))
+                        ((memq (car qpat) '(\, \,@)) (1- depth))
+                        (t depth)))))
       (if (and (eq (car-safe upata) 'quote) (eq (car-safe upatd) 'quote))
           `'(,(cadr upata) . ,(cadr upatd))
         `(and (pred consp)
diff --git a/test/lisp/emacs-lisp/pcase-tests.el b/test/lisp/emacs-lisp/pcase-tests.el
index e777b71920c..2649e754beb 100644
--- a/test/lisp/emacs-lisp/pcase-tests.el
+++ b/test/lisp/emacs-lisp/pcase-tests.el
@@ -191,4 +191,9 @@ pcase-tests-mutually-exclusive
         (should (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x)))
       (should-not (pcase--mutually-exclusive-p (nth 1 x) (nth 0 x))))))
 
+(ert-deftest pcase-tests-nested-backquote ()
+  (should (pcase '`,nil (``,nil t)))
+  (should (pcase '`,1 (``,,(pred integerp) t)))
+  (should (pcase '`,@(list) (``,@,`(list . ,_) t))))
+
 ;;; pcase-tests.el ends here.
-- 
2.44.2