summaryrefslogtreecommitdiff
path: root/lisp/emacs-lisp
diff options
context:
space:
mode:
authorAlan Mackenzie <acm@muc.de>2024-10-28 16:35:27 +0000
committerAlan Mackenzie <acm@muc.de>2024-10-28 16:35:27 +0000
commitfb5915665522f747daa8dfa11e91dc406d18edb7 (patch)
tree64a0c23a4810486d1b273a533614b927a88d14fb /lisp/emacs-lisp
parentc05a13ef0dc69497e275b627dbc8e2b25ece7711 (diff)
downloademacs-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.el37
-rw-r--r--lisp/emacs-lisp/pcase.el19
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 '&not)) 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."