diff options
Diffstat (limited to 'lisp/emacs-lisp')
| -rw-r--r-- | lisp/emacs-lisp/edebug.el | 17 | ||||
| -rw-r--r-- | lisp/emacs-lisp/pcase.el | 40 |
2 files changed, 30 insertions, 27 deletions
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 04a4829c5e6..782299454ea 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -55,6 +55,7 @@ (require 'backtrace) (require 'macroexp) (require 'cl-lib) +(require 'seq) (eval-when-compile (require 'pcase)) ;;; Options @@ -1866,6 +1867,22 @@ contains a circular object." (apply #'edebug-no-match cursor "Expected one of" original-specs)) )) +(cl-defmethod edebug--handle-&-spec-op ((_ (eql &lookup)) cursor specs) + "Compute the specs for `&lookup SPEC FUN ARGS...'. +Extracts the head of the data by matching it against SPEC, +and then matches the rest against the output of (FUN ARGS... HEAD)." + (pcase-let* + ((`(,spec ,fun . ,args) specs) + (exps (edebug-cursor-expressions cursor)) + (instrumented-head (edebug-match-one-spec cursor (or spec 'sexp))) + (consumed (- (length exps) + (length (edebug-cursor-expressions cursor)))) + (newspecs (apply fun (append args (seq-subseq exps 0 consumed))))) + (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps))) + ;; FIXME: What'd be the difference if we used `edebug-match-sublist', + ;; which is what `edebug-list-form-args' uses for the similar purpose + ;; when matching "normal" forms? + (append instrumented-head (edebug-match cursor newspecs)))) (cl-defmethod edebug--handle-&-spec-op ((_ (eql ¬)) cursor specs) ;; If any specs match, then fail diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 7a88bdf8de5..d6c96c1ec82 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -62,45 +62,32 @@ (defvar pcase--dontwarn-upats '(pcase--dontcare)) -(def-edebug-spec - pcase-PAT - (&or symbolp - ("or" &rest pcase-PAT) - ("and" &rest pcase-PAT) - ("guard" form) - ("pred" pcase-FUN) - ("app" pcase-FUN pcase-PAT) - pcase-MACRO +(def-edebug-spec pcase-PAT + (&or (&lookup symbolp pcase--get-edebug-spec) sexp)) -(def-edebug-spec - pcase-FUN +(def-edebug-spec pcase-FUN (&or lambda-expr ;; Punt on macros/special forms. (functionp &rest form) sexp)) -;; See bug#24717 -(put 'pcase-MACRO 'edebug-form-spec #'pcase--edebug-match-macro) - ;; Only called from edebug. (declare-function edebug-get-spec "edebug" (symbol)) -(declare-function edebug-match "edebug" (cursor specs)) +(defun pcase--get-edebug-spec (head) + (or (alist-get head '((quote sexp) + (or &rest pcase-PAT) + (and &rest pcase-PAT) + (guard form) + (pred &or ("not" pcase-FUN) pcase-FUN) + (app pcase-FUN pcase-PAT))) + (let ((me (pcase--get-macroexpander head))) + (and me (symbolp me) (edebug-get-spec me))))) (defun pcase--get-macroexpander (s) "Return the macroexpander for pcase pattern head S, or nil" (get s 'pcase-macroexpander)) -(defun pcase--edebug-match-macro (cursor) - (let (specs) - (mapatoms - (lambda (s) - (let ((m (pcase--get-macroexpander s))) - (when (and m (edebug-get-spec m)) - (push (cons (symbol-name s) (edebug-get-spec m)) - specs))))) - (edebug-match cursor (cons '&or specs)))) - ;;;###autoload (defmacro pcase (exp &rest cases) ;; FIXME: Add some "global pattern" to wrap every case? @@ -938,8 +925,7 @@ Otherwise, it defers to REST which is a list of branches of the form (t (error "Unknown pattern `%S'" upat))))) (t (error "Incorrect MATCH %S" (car matches))))) -(def-edebug-spec - pcase-QPAT +(def-edebug-spec pcase-QPAT ;; Cf. edebug spec for `backquote-form' in edebug.el. (&or ("," pcase-PAT) (pcase-QPAT [&rest [¬ ","] pcase-QPAT] |