Support debug declarations in pcase macros

* lisp/emacs-lisp/pcase.el (pcase-MACRO): New edebug spec.
(pcase-UPAT): Use it.  Remove "`".
(pcase--edebug-match-macro): New function.
(pcase-defmacro): Support debug declarations.

* lisp/emacs-lisp/cl-macs.el (cl-struct) <pcase-defmacro>:
* lisp/emacs-lisp/eieio.el (eieio) <pcase-defmacro>:
* lisp/emacs-lisp/pcase.el (\`): <pcase-defmacro>: Add debug declaration.

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 69f2792f4bd4aac785c1de395bd05612159fcbde..41435b8b7b14cc64e43dd7a1afce32f6d53c95e4 100644 (file)
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2780,6 +2780,7 @@ non-nil value, that slot cannot be set via `setf'.
 Elements of FIELDS can be of the form (NAME UPAT) in which case the contents of
 field NAME is matched against UPAT, or they can be of the form NAME which
 is a shorthand for (NAME NAME)."
+  (declare (debug (sexp &rest [&or (sexp pcase-UPAT) sexp])))
   `(and (pred (pcase--flip cl-typep ',type))
         ,@(mapcar
            (lambda (field)

diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el
index bca53c0c8922ee5863df39241476f4ee55521e00..111459509bc1aeb01af886c097a61c5ac26f029b 100644 (file)
--- a/lisp/emacs-lisp/eieio.el
+++ b/lisp/emacs-lisp/eieio.el
@@ -348,6 +348,7 @@ variable name of the same name as the slot."
 Elements of FIELDS can be of the form (NAME UPAT) in which case the contents of
 field NAME is matched against UPAT, or they can be of the form NAME which
 is a shorthand for (NAME NAME)."
+  (declare (debug (&rest [&or (sexp pcase-UPAT) sexp])))
   (let ((is (make-symbol "table")))
     ;; FIXME: This generates a horrendous mess of redundant let bindings.
     ;; `pcase' needs to be improved somehow to introduce let-bindings more

diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index bbb278c863e136f25aa3fb0015428e1680408c8f..49603036ead85948d1f0de1ee49a4694886e8a85 100644 (file)
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -75,18 +75,11 @@
   (&or symbolp
        ("or" &rest pcase-UPAT)
        ("and" &rest pcase-UPAT)
-       ("`" pcase-QPAT)
        ("guard" form)
        ("let" pcase-UPAT form)
        ("pred" pcase-FUN)
        ("app" pcase-FUN pcase-UPAT)
-       sexp))
-
-(def-edebug-spec
-  pcase-QPAT
-  (&or ("," pcase-UPAT)
-       (pcase-QPAT . pcase-QPAT)
-       (vector &rest pcase-QPAT)
+       pcase-MACRO
        sexp))
 
 (def-edebug-spec
@@ -96,6 +89,18 @@
        (functionp &rest form)
        sexp))
 
+(def-edebug-spec pcase-MACRO pcase--edebug-match-macro)
+
+(defun pcase--edebug-match-macro (cursor)
+  (let (specs)
+    (mapatoms
+     (lambda (s)
+       (let ((m (get s 'pcase-macroexpander)))
+        (when (and m (get-edebug-spec m))
+          (push (cons (symbol-name s) (get-edebug-spec m))
+                specs)))))
+    (edebug-match cursor (cons '&or specs))))
+
 ;;;###autoload
 (defmacro pcase (exp &rest cases)
   "Perform ML-style pattern matching on EXP.
@@ -367,11 +372,14 @@ of the form (UPAT EXP)."
 (defmacro pcase-defmacro (name args &rest body)
   "Define a pcase UPattern macro."
   (declare (indent 2) (debug defun) (doc-string 3))
-  (let ((fsym (intern (format "%s--pcase-macroexpander" name))))
-    ;; Add the function via `fsym', so that an autoload cookie placed
-    ;;  on a pcase-defmacro will cause the macro to be loaded on demand.
+  ;; Add the function via `fsym', so that an autoload cookie placed
+  ;; on a pcase-defmacro will cause the macro to be loaded on demand.
+  (let ((fsym (intern (format "%s--pcase-macroexpander" name)))
+       (decl (assq 'declare body)))
+    (when decl (setq body (remove decl body)))
     `(progn
        (defun ,fsym ,args ,@body)
+       (put ',fsym 'edebug-form-spec ',(cadr (assq 'debug decl)))
        (put ',name 'pcase-macroexpander #',fsym))))
 
 (defun pcase--match (val upat)
@@ -833,6 +841,13 @@ Otherwise, it defers to REST which is a list of branches of the form
        (t (error "Unknown internal pattern `%S'" upat)))))
    (t (error "Incorrect MATCH %S" (car matches)))))
 
+(def-edebug-spec
+  pcase-QPAT
+  (&or ("," pcase-UPAT)
+       (pcase-QPAT . pcase-QPAT)
+       (vector &rest pcase-QPAT)
+       sexp))
+
 (pcase-defmacro \` (qpat)
   "Backquote-style pcase patterns.
 QPAT can take the following forms:
@@ -842,6 +857,7 @@ QPAT can take the following forms:
   ,UPAT                 matches if the UPattern UPAT matches.
   STRING                matches if the object is `equal' to STRING.
   ATOM                  matches if the object is `eq' to ATOM."
+  (declare (debug (pcase-QPAT)))
   (cond
    ((eq (car-safe qpat) '\,) (cadr qpat))
    ((vectorp qpat)