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.

(cherry picked from commit fb5915665522f747daa8dfa11e91dc406d18edb7)

diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index d3aceab6d4f89172d7f29d5bc5014a1fac660b4f..6ee1cecaea771d9de3862ee77f6e158cfa9290fc 100644 (file)
--- 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 898d460c14401b758b61e34671781499d52999ba..9812621d50ebd8afcea928871ad3bd470d3d0f50 100644 (file)
--- 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."