Commit 2e47de36 authored by Johan Bockgård's avatar Johan Bockgård

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.
parent 66a53da5
......@@ -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)
......
......@@ -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
......
......@@ -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)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment