Subject: bug#74052: Master: edebug fails to instrument nested pcase guard form.

From: Stefan Monnier <[email-masked]>
Date: Mon, 28 Oct 2024 09:49:55 -0400

Hi Alan,

> #########################################################################
>
> Diagnosis:
> ----------
>
> In pcase.el pcase--edebug-match-pat-args, which is the function of an
> edebug &interpose clause, the code fails to call PF (the supplied
> parsing function).  This call is absolutely required by the interface of
> the pertinent version of function edebug--match-&-spec-op.  It's absence
> leads to the lack of instrumentation of the guard form.

+1

> diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
> index b96d2437b8a..f6710de126c 100644
> --- a/lisp/emacs-lisp/edebug.el
> +++ b/lisp/emacs-lisp/edebug.el
> @@ -1803,12 +1803,21 @@ edebug-&optional-wrapper
>  
>  (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."

+1

> +  ;; Note: PF is evaluated in FUN rather than in this function, so that
> +  ;; it can use any dynamic bindings created there.

Nitpick: PF is not "evaluated" but "called".

> @@ -1817,14 +1826,14 @@ edebug-&optional-wrapper
>                      (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)))

[ Having a hard time imagining how I ended up writing it like I did.  ]
+1

> @@ -84,14 +84,17 @@ 'pcase-FUN
>  (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 ((specs
> +         (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)))))
> +    (if specs
> +        (funcall pf specs)
>        (let ((me (pcase--get-macroexpander head)))
> -        (funcall pf (and me (symbolp me) (edebug-get-spec me))))))
> +        (funcall pf (and me (symbolp me) (edebug-get-spec me)))))))

+1 (tho I'd hoist the common `(funcall pf` out of the `if`).

And thanks!

        Stefan