Re: pcase generates an unprintable expansion for a form in test erc--restore-initialize-priors

[Stefan Monnier <monnier@iro.umontreal.ca>]

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

> I suspect it can be done with no change to the core pcase code by
> rewriting
>
>     (pcase-defmacro \` (qpat)
>
> so it does the recursion on its own (e.g. instead of expanding `(A . B)
> to a pattern which contains `A and `B).  Then at any level if it notices
> that no `,` was found during the recursion it can just use `equal`.

The patch below does that.
For that ERC test, the resulting code is still very heavily nested, of
course, but ... less so.


        Stefan

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: pcase.patch --]
[-- Type: text/x-diff, Size: 2056 bytes --]

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 1a58c60734a..bbc08493ec9 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -1124,21 +1124,35 @@ \`
  - True!  (The second element can be anything, and for the sake
    of the body forms, its value is bound to the symbol `forum'.)"
   (declare (debug (pcase-QPAT)))
+  (pcase--expand-\` qpat))
+
+(defun pcase--expand-\` (qpat)
   (cond
    ((eq (car-safe qpat) '\,) (cadr qpat))
    ((eq (car-safe qpat) '\,@) (error "Unsupported QPAT: %S" qpat))
    ((vectorp qpat)
-    `(and (pred vectorp)
-          (app length ,(length qpat))
-          ,@(let ((upats nil))
-              (dotimes (i (length qpat))
-                (push `(app (aref _ ,i) ,(list '\` (aref qpat i)))
-                      upats))
-              (nreverse upats))))
+    (let* ((trivial t)
+           (upats (mapcar (lambda (qpat)
+                            (let ((upat (pcase--expand-\` qpat)))
+                              (unless (eq (car-safe upat) 'quote)
+                                (setq trivial nil))
+                              upat))
+                          qpat)))
+      (if trivial
+          `',qpat
+        `(and (pred vectorp)
+              (app length ,(length qpat))
+              ,@(let ((i -1))
+                  (mapcar (lambda (upat) `(app (aref _ ,(setq i (+ i 1)))  ,upat))
+                          upats))))))
    ((consp qpat)
-    `(and (pred consp)
-          (app car-safe ,(list '\` (car qpat)))
-          (app cdr-safe ,(list '\` (cdr qpat)))))
+    (let ((upata (pcase--expand-\` (car qpat)))
+          (upatd (pcase--expand-\` (cdr qpat))))
+      (if (and (eq (car-safe upata) 'quote) (eq (car-safe upatd) 'quote))
+          `',qpat
+        `(and (pred consp)
+              (app car-safe ,upata)
+              (app cdr-safe ,upatd)))))
    ((or (stringp qpat) (numberp qpat) (symbolp qpat)) `',qpat)
    ;; In all other cases just raise an error so we can't break
    ;; backward compatibility when adding \` support for other