diff options
author | Alan Mackenzie <acm@muc.de> | 2024-10-28 16:35:27 +0000 |
---|---|---|
committer | Alan Mackenzie <acm@muc.de> | 2024-10-28 16:35:27 +0000 |
commit | fb5915665522f747daa8dfa11e91dc406d18edb7 (patch) | |
tree | 64a0c23a4810486d1b273a533614b927a88d14fb /lisp/emacs-lisp | |
parent | c05a13ef0dc69497e275b627dbc8e2b25ece7711 (diff) | |
download | emacs-fb5915665522f747daa8dfa11e91dc406d18edb7.tar.gz emacs-fb5915665522f747daa8dfa11e91dc406d18edb7.tar.bz2 emacs-fb5915665522f747daa8dfa11e91dc406d18edb7.zip |
Call PF correctly from pcase--edebug-match-pat-args
Also correct a doc string and insert commentary. This fixes
bug#74052.
* lisp/emacs-lisp/edebug.el
(edebug--match-&-spec-op <&interpose>): Correct and complete
the doc string, which now says MUST call exactly once, and
documents the return values of FUN, PF and
edebug--match-&-spec-op. Also remove an unneeded `(...)
construct.
* lisp/emacs-lisp/pcase.el (pcase--edebug-match-pat-args): Call
PF also for the main cases handled.
Diffstat (limited to 'lisp/emacs-lisp')
-rw-r--r-- | lisp/emacs-lisp/edebug.el | 37 | ||||
-rw-r--r-- | lisp/emacs-lisp/pcase.el | 19 |
2 files changed, 34 insertions, 22 deletions
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index b96d2437b8a..d09229ee890 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -1803,12 +1803,21 @@ infinite loops when the code/environment contains a circular object.") (cl-defmethod edebug--match-&-spec-op ((_ (eql '&interpose)) cursor specs) "Compute the specs for `&interpose SPEC FUN ARGS...'. -Extracts the head of the data by matching it against SPEC, -and then matches the rest by calling (FUN HEAD PF ARGS...) -where PF is the parsing function which FUN can call exactly once, -passing it the specs that it needs to match. -Note that HEAD will always be a list, since specs are defined to match -a sequence of elements." +SPECS is a list (SPEC FUN ARGS...), where SPEC is an edebug +specification, FUN is the function from the &interpose form which +transforms the edebug spec, and the optional ARGS is a list of final +arguments to be supplied to FUN. + +Extracts the head of the data by matching it against SPEC, and then +matches the rest by calling (FUN HEAD PF ARGS...). PF is the parsing +function which FUN must call exactly once, passing it one argument, the +specs that it needs to match. FUN's value must be the value of this PF +call, which in turn will be the value of this function. + +Note that HEAD will always be a list, since specs is defined to match a +sequence of elements." + ;; Note: PF is called in FUN rather than in this function, so that it + ;; can use any dynamic bindings created there. (pcase-let* ((`(,spec ,fun . ,args) specs) (exps (edebug-cursor-expressions cursor)) @@ -1817,14 +1826,14 @@ a sequence of elements." (length (edebug-cursor-expressions cursor)))) (head (seq-subseq exps 0 consumed))) (cl-assert (eq (edebug-cursor-expressions cursor) (nthcdr consumed exps))) - (apply fun `(,head - ,(lambda (newspecs) - ;; 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))) - ,@args)))) + (apply fun head + (lambda (newspecs) + ;; 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))) + args))) (cl-defmethod edebug--match-&-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 898d460c144..9812621d50e 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -84,14 +84,17 @@ (defun pcase--edebug-match-pat-args (head pf) ;; (cl-assert (null (cdr head))) (setq head (car 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))) - (funcall pf (and me (symbolp me) (edebug-get-spec me)))))) + (let ((specs + (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)))))) + (funcall pf specs))) (defun pcase--get-macroexpander (s) "Return the macroexpander for pcase pattern head S, or nil." |