* Edebug: Generalize `&lookup`, use it for `cl-macrolet` and `cl-generic`

This allows the use of (declare (debug ...)) in the lexical macros
defined with `cl-macrolet`.  It also fixes the names used by Edebug
for the methods of `cl-generic` so it doesn't need to use gensym
and so they don't include the formal arg names any more.

* lisp/emacs-lisp/edebug.el (edebug--match-&-spec-op):
Rename from `edebug--handle-&-spec-op`.
(edebug--match-&-spec-op <&interpose>): Rename from `&lookup` and
generalize so it can let-bind dynamic variables around the rest of the parse.
(edebug-lexical-macro-ctx): Rename from `edebug--cl-macrolet-defs` and
make it into an alist.
(edebug-list-form-args): Use the specs from `edebug-lexical-macro-ctx`
when available.
(edebug--current-cl-macrolet-defs): Delete var.
(edebug-match-cl-macrolet-expr, edebug-match-cl-macrolet-name)
(edebug-match-cl-macrolet-body): Delete functions.
(def-declarations): Use new `&interpose`.
(edebug--match-declare-arg): Rename from `edebug--get-declare-spec` and
adjust to new calling convention.

* lisp/subr.el (def-edebug-elem-spec): Fix docstring.
(eval-after-load): Use `declare`.

* lisp/emacs-lisp/cl-generic.el: Fix Edebug names so we don't need
gensym any more and we only include the specializers but not the formal
arg names.
(cl--generic-edebug-name): New var.
(cl--generic-edebug-remember-name, cl--generic-edebug-make-name): New funs.
(cl-defgeneric, cl-defmethod): Use them.

* lisp/emacs-lisp/cl-macs.el: Add support for `debug` declarations in
`cl-macrolet`.
(cl-declarations-or-string):
Fix use of `lambda-doc` and allow use of `declare`.
(edebug-lexical-macro-ctx): Declare var.
(cl--edebug-macrolet-interposer): New function.
(cl-macrolet): Use it to pass the right `lexical-macro-ctx` to the body.

* lisp/emacs-lisp/pcase.el (pcase-PAT): Use new `&interpose`.
(pcase--edebug-match-pat-args): Rename from `pcase--get-edebug-spec` and
adjust to new calling convention.

* test/lisp/emacs-lisp/cl-generic-tests.el (cl-defgeneric/edebug/method):
Adjust to the new names.

* test/lisp/emacs-lisp/edebug-tests.el (edebug-cl-defmethod-qualifier)
(edebug-tests-cl-flet): Adjust to the new names.

* doc/lispref/edebug.texi (Specification List): Document &interpose.

4 files changed, 114 insertions, 108 deletions

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 229608395eb..279b9d137c9 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -189,6 +189,32 @@ SPECIALIZERS-FUNCTION takes as first argument a tag value TAG
       (setf (cl--generic name) (setq generic (cl--generic-make name))))
     generic))
 
+(defvar cl--generic-edebug-name nil)
+
+(defun cl--generic-edebug-remember-name (name pf &rest specs)
+  ;; Remember the name in `cl-defgeneric' so we can use it when building
+  ;; the names of its `:methods'.
+  (let ((cl--generic-edebug-name (car name)))
+    (funcall pf specs)))
+
+(defun cl--generic-edebug-make-name (in:method _oldname &rest quals-and-args)
+  ;; The name to use in Edebug for a method: use the generic
+  ;; function's name plus all its qualifiers and finish with
+  ;; its specializers.
+  (pcase-let*
+      ((basename (if in:method cl--generic-edebug-name (pop quals-and-args)))
+       (args (car (last quals-and-args)))
+       (`(,spec-args . ,_) (cl--generic-split-args args))
+       (specializers (mapcar (lambda (spec-arg)
+                               (if (eq '&context (car-safe (car spec-arg)))
+                                   spec-arg (cdr spec-arg)))
+                             spec-args)))
+    (format "%s %s"
+            (mapconcat (lambda (sexp) (format "%s" sexp))
+                       (cons basename (butlast quals-and-args))
+                       " ")
+            specializers)))
+
 ;;;###autoload
 (defmacro cl-defgeneric (name args &rest options-and-methods)
   "Create a generic function NAME.
@@ -206,31 +232,22 @@ DEFAULT-BODY, if present, is used as the body of a default method.
 \(fn NAME ARGS [DOC-STRING] [OPTIONS-AND-METHODS...] &rest DEFAULT-BODY)"
   (declare (indent 2) (doc-string 3)
            (debug
-            (&define [&name sexp] ;Allow (setf ...) additionally to symbols.
-                     listp lambda-doc
-                     [&rest [&or
-                             ("declare" &rest sexp)
-                             (":argument-precedence-order" &rest sexp)
-                             (&define ":method"
-                                      ;; FIXME: The `gensym'
-                                      ;; construct works around
-                                      ;; Bug#42672.  We'd rather want
-                                      ;; names like those generated by
-                                      ;; `cl-defmethod', but that
-                                      ;; requires larger changes to
-                                      ;; Edebug.
-                                      [&name "cl-generic-:method@" []]
-                                      [&name [] gensym] ;Make it unique!
-                                      [&name
-                                       [[&rest cl-generic--method-qualifier-p]
-                                        ;; FIXME: We don't actually want the
-                                        ;; argument's names to be considered
-                                        ;; part of the name of the defined
-                                        ;; function.
-                                        listp]] ;Formal args
-                                      lambda-doc
-                                      def-body)]]
-                     def-body)))
+            (&define
+             &interpose
+             [&name sexp] ;Allow (setf ...) additionally to symbols.
+             cl--generic-edebug-remember-name
+             listp lambda-doc
+             [&rest [&or
+                     ("declare" &rest sexp)
+                     (":argument-precedence-order" &rest sexp)
+                     (&define ":method"
+                              [&name
+                               [[&rest cl-generic--method-qualifier-p]
+                                listp] ;Formal args
+                               cl--generic-edebug-make-name in:method]
+                              lambda-doc
+                              def-body)]]
+             def-body)))
   (let* ((doc (if (stringp (car-safe options-and-methods))
                   (pop options-and-methods)))
          (declarations nil)
@@ -451,12 +468,9 @@ The set of acceptable TYPEs (also called \"specializers\") is defined
            (debug
             (&define                    ; this means we are defining something
              [&name [sexp   ;Allow (setf ...) additionally to symbols.
-                     ;; Multiple qualifiers are allowed.
-                     [&rest cl-generic--method-qualifier-p]
-                     ;; FIXME: We don't actually want the argument's names
-                     ;; to be considered part of the name of the
-                     ;; defined function.
-                     listp]]     ; arguments
+                     [&rest cl-generic--method-qualifier-p] ;qualifiers
+                     listp]             ; arguments
+                    cl--generic-edebug-make-name nil]
              lambda-doc                 ; documentation string
              def-body)))                ; part to be debugged
   (let ((qualifiers nil))
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index e2faf6df534..b9a8a3f1125 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -190,7 +190,7 @@ The name is made by appending a number to PREFIX, default \"T\"."
   '(&rest ("cl-declare" &rest sexp)))
 
 (def-edebug-elem-spec 'cl-declarations-or-string
-  '(&or lambda-doc cl-declarations))
+  '(lambda-doc &or ("declare" def-declarations) cl-declarations))
 
 (def-edebug-elem-spec 'cl-lambda-list
   '(([&rest cl-lambda-arg]
@@ -2193,6 +2193,20 @@ details.
             (macroexp-progn body)
             newenv)))))
 
+(defvar edebug-lexical-macro-ctx)
+
+(defun cl--edebug-macrolet-interposer (bindings pf &rest specs)
+  ;; (cl-assert (null (cdr bindings)))
+  (setq bindings (car bindings))
+  (let ((edebug-lexical-macro-ctx
+         (nconc (mapcar (lambda (binding)
+                          (cons (car binding)
+                                (when (eq 'declare (car-safe (nth 2 binding)))
+                                  (nth 1 (assq 'debug (cdr (nth 2 binding)))))))
+                        bindings)
+                edebug-lexical-macro-ctx)))
+    (funcall pf specs)))
+
 ;; The following ought to have a better definition for use with newer
 ;; byte compilers.
 ;;;###autoload
@@ -2202,7 +2216,13 @@ This is like `cl-flet', but for macros instead of functions.
 
 \(fn ((NAME ARGLIST BODY...) ...) FORM...)"
   (declare (indent 1)
-           (debug (cl-macrolet-expr)))
+           (debug (&interpose (&rest (&define [&name symbolp "@cl-macrolet@"]
+                                              [&name [] gensym] ;Make it unique!
+                                              cl-macro-list
+                                              cl-declarations-or-string
+                                              def-body))
+                              cl--edebug-macrolet-interposer
+                              cl-declarations body)))
   (if (cdr bindings)
       `(cl-macrolet (,(car bindings)) (cl-macrolet ,(cdr bindings) ,@body))
     (if (null bindings) (macroexp-progn body)
diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el
index 8fadeba6c9a..efca7305fea 100644
--- a/lisp/emacs-lisp/edebug.el
+++ b/lisp/emacs-lisp/edebug.el
@@ -1188,6 +1188,9 @@ purpose by adding an entry to this alist, and setting
 ;;;(message "all defs: %s   all forms: %s"  edebug-all-defs edebug-all-forms)
     (let ((result
            (cond
+            ;; IIUC, `&define' is treated specially here so as to avoid
+            ;; entering Edebug during the actual function's definition:
+            ;; we only want to enter Edebug later when the thing is called.
             (defining-form-p
               (if (or edebug-all-defs edebug-all-forms)
                   ;; If it is a defining form and we are edebugging defs,
@@ -1238,7 +1241,9 @@ purpose by adding an entry to this alist, and setting
 (defvar edebug-inside-func)  ;; whether code is inside function context.
 ;; Currently def-form sets this to nil; def-body sets it to t.
 
-(defvar edebug--cl-macrolet-defs) ;; Fully defined below.
+
+(defvar edebug-lexical-macro-ctx nil
+  "Alist mapping lexically scoped macro names to their debug spec.")
 
 (defun edebug-make-enter-wrapper (forms)
   ;; Generate the enter wrapper for some forms of a definition.
@@ -1549,13 +1554,10 @@ contains a circular object."
 (defsubst edebug-list-form-args (head cursor)
   ;; Process the arguments of a list form given that head of form is a symbol.
   ;; Helper for edebug-list-form
-  (let ((spec (edebug-get-spec head)))
+  (let* ((lex-spec (assq head edebug-lexical-macro-ctx))
+         (spec (if lex-spec (cdr lex-spec)
+                 (edebug-get-spec head))))
     (cond
-     ;; Treat cl-macrolet bindings like macros with no spec.
-     ((member head edebug--cl-macrolet-defs)
-      (if edebug-eval-macro-args
-	  (edebug-forms cursor)
-	(edebug-sexps cursor)))
      (spec
       (cond
        ((consp spec)
@@ -1569,7 +1571,7 @@ contains a circular object."
 					; but leave it in for compatibility.
        ))
      ;; No edebug-form-spec provided.
-     ((macrop head)
+     ((or lex-spec (macrop head))
       (if edebug-eval-macro-args
 	  (edebug-forms cursor)
 	(edebug-sexps cursor)))
@@ -1689,7 +1691,7 @@ contains a circular object."
 	     (first-char (and (symbolp spec) (aref (symbol-name spec) 0)))
 	     (match (cond
 		     ((eq ?& first-char);; "&" symbols take all following specs.
-		      (edebug--handle-&-spec-op spec cursor (cdr specs)))
+		      (edebug--match-&-spec-op spec cursor (cdr specs)))
 		     ((eq ?: first-char);; ":" symbols take one following spec.
 		      (setq rest (cdr (cdr specs)))
 		      (edebug--handle-:-spec-op spec cursor (car (cdr specs))))
@@ -1731,9 +1733,6 @@ contains a circular object."
 		(def-form . edebug-match-def-form)
 		;; Less frequently used:
 		;; (function . edebug-match-function)
-                (cl-macrolet-expr . edebug-match-cl-macrolet-expr)
-                (cl-macrolet-name . edebug-match-cl-macrolet-name)
-                (cl-macrolet-body . edebug-match-cl-macrolet-body)
 		(place . edebug-match-place)
 		(gate . edebug-match-gate)
 		;;   (nil . edebug-match-nil)  not this one - special case it.
@@ -1781,7 +1780,7 @@ contains a circular object."
 
 (defsubst edebug-match-body (cursor) (edebug-forms cursor))
 
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &optional)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &optional)) cursor specs)
   ;; Keep matching until one spec fails.
   (edebug-&optional-wrapper cursor specs 'edebug-&optional-wrapper))
 
@@ -1807,11 +1806,11 @@ contains a circular object."
   ;; Reuse the &optional handler with this as the remainder handler.
   (edebug-&optional-wrapper cursor specs remainder-handler))
 
-(cl-defgeneric edebug--handle-&-spec-op (op cursor specs)
+(cl-defgeneric edebug--match-&-spec-op (op cursor specs)
   "Handle &foo spec operators.
 &foo spec operators operate on all the subsequent SPECS.")
 
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &rest)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &rest)) cursor specs)
   ;; Repeatedly use specs until failure.
   (let ((edebug-&rest specs) ;; remember these
 	edebug-best-error
@@ -1819,7 +1818,7 @@ contains a circular object."
     (edebug-&rest-wrapper cursor specs 'edebug-&rest-wrapper)))
 
 
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &or)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &or)) cursor specs)
   ;; Keep matching until one spec succeeds, and return its results.
   ;; If none match, fail.
   ;; This needs to be optimized since most specs spend time here.
@@ -1843,40 +1842,48 @@ 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...'.
+(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 against the output of (FUN ARGS... HEAD)."
+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."
   (pcase-let*
       ((`(,spec ,fun . ,args) specs)
        (exps (edebug-cursor-expressions cursor))
        (instrumented-head (edebug-match-one-spec cursor spec))
        (consumed (- (length exps)
                     (length (edebug-cursor-expressions cursor))))
-       (newspecs (apply fun (append args (seq-subseq exps 0 consumed)))))
+       (head (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 &not)) cursor specs)
+    (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
   (if (null (catch 'no-match
 	      (let ((edebug-gate nil))
 		(save-excursion
-		  (edebug--handle-&-spec-op '&or cursor specs)))
+		  (edebug--match-&-spec-op '&or cursor specs)))
 	      nil))
       ;; This means something matched, so it is a no match.
       (edebug-no-match cursor "Unexpected"))
   ;; This means nothing matched, so it is OK.
   nil) ;; So, return nothing
 
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &key)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &key)) cursor specs)
   ;; Following specs must look like (<name> <spec>) ...
   ;; where <name> is the name of a keyword, and spec is its spec.
   ;; This really doesn't save much over the expanded form and takes time.
-  (edebug--handle-&-spec-op
+  (edebug--match-&-spec-op
    '&rest
    cursor
    (cons '&or
@@ -1885,7 +1892,7 @@ and then matches the rest against the output of (FUN ARGS... HEAD)."
                            (car (cdr pair))))
 		 specs))))
 
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &error)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &error)) cursor specs)
   ;; Signal an error, using the following string in the spec as argument.
   (let ((error-string (car specs))
         (edebug-error-point (edebug-before-offset cursor)))
@@ -1989,7 +1996,7 @@ and then matches the rest against the output of (FUN ARGS... HEAD)."
 (defun edebug-match-function (_cursor)
   (error "Use function-form instead of function in edebug spec"))
 
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &define)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &define)) cursor specs)
   ;; Match a defining form.
   ;; Normally, &define is interpreted specially other places.
   ;; This should only be called inside of a spec list to match the remainder
@@ -2003,7 +2010,7 @@ and then matches the rest against the output of (FUN ARGS... HEAD)."
       offsets)
     specs))
 
-(cl-defmethod edebug--handle-&-spec-op ((_ (eql &name)) cursor specs)
+(cl-defmethod edebug--match-&-spec-op ((_ (eql &name)) cursor specs)
   "Compute the name for `&name SPEC FUN` spec operator.
 
 The full syntax of that operator is:
@@ -2083,43 +2090,6 @@ SPEC is the symbol name prefix for `gensym'."
 	    suffix)))
   nil)
 
-(defvar edebug--cl-macrolet-defs nil
-  "List of symbols found within the bindings of enclosing `cl-macrolet' forms.")
-(defvar edebug--current-cl-macrolet-defs nil
-  "List of symbols found within the bindings of the current `cl-macrolet' form.")
-
-(defun edebug-match-cl-macrolet-expr (cursor)
-  "Match a `cl-macrolet' form at CURSOR."
-  (let (edebug--current-cl-macrolet-defs)
-    (edebug-match cursor
-                  '((&rest (&define cl-macrolet-name cl-macro-list
-                                    cl-declarations-or-string
-                                    def-body))
-                    cl-declarations cl-macrolet-body))))
-
-(defun edebug-match-cl-macrolet-name (cursor)
-  "Match the name in a `cl-macrolet' binding at CURSOR.
-Collect the names in `edebug--cl-macrolet-defs' where they
-will be checked by `edebug-list-form-args' and treated as
-macros without a spec."
-  (let ((name (edebug-top-element-required cursor "Expected name")))
-    (when (not (symbolp name))
-      (edebug-no-match cursor "Bad name:" name))
-    ;; Change edebug-def-name to avoid conflicts with
-    ;; names at global scope.
-    (setq edebug-def-name (gensym "edebug-anon"))
-    (edebug-move-cursor cursor)
-    (push name edebug--current-cl-macrolet-defs)
-    (list name)))
-
-(defun edebug-match-cl-macrolet-body (cursor)
-  "Match the body of a `cl-macrolet' expression at CURSOR.
-Put the definitions collected in `edebug--current-cl-macrolet-defs'
-into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
-  (let ((edebug--cl-macrolet-defs (nconc edebug--current-cl-macrolet-defs
-                                         edebug--cl-macrolet-defs)))
-    (edebug-match-body cursor)))
-
 (defun edebug-match-arg (cursor)
   ;; set the def-args bound in edebug-defining-form
   (let ((edebug-arg (edebug-top-element-required cursor "Expected arg")))
@@ -2210,11 +2180,11 @@ into `edebug--cl-macrolet-defs' which is checked in `edebug-list-form-args'."
        ))
     (put name 'edebug-form-spec spec))
 
-(defun edebug--get-declare-spec (head)
-  (get head 'edebug-declaration-spec))
+(defun edebug--match-declare-arg (head pf)
+  (funcall pf (get (car head) 'edebug-declaration-spec)))
 
 (def-edebug-elem-spec 'def-declarations
-  '(&rest &or (&lookup symbolp edebug--get-declare-spec) sexp))
+  '(&rest &or (&interpose symbolp edebug--match-declare-arg) sexp))
 
 (def-edebug-elem-spec 'lambda-list
   '(([&rest arg]
diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el
index 5d428ac846a..d3928fa5051 100644
--- a/lisp/emacs-lisp/pcase.el
+++ b/lisp/emacs-lisp/pcase.el
@@ -63,7 +63,7 @@
 (defvar pcase--dontwarn-upats '(pcase--dontcare))
 
 (def-edebug-elem-spec 'pcase-PAT
-  '(&or (&lookup symbolp pcase--get-edebug-spec) sexp))
+  '(&or (&interpose symbolp pcase--edebug-match-pat-args) sexp))
 
 (def-edebug-elem-spec 'pcase-FUN
   '(&or lambda-expr
@@ -73,7 +73,9 @@
 
 ;; Only called from edebug.
 (declare-function edebug-get-spec "edebug" (symbol))
-(defun pcase--get-edebug-spec (head)
+(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)
@@ -81,7 +83,7 @@
                         (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 (and me (symbolp me) (edebug-get-spec me))))))
 
 (defun pcase--get-macroexpander (s)
   "Return the macroexpander for pcase pattern head S, or nil"