From 099c63eb1c107531252fde859dee7466de05f210 Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Thu, 26 Aug 2021 06:09:07 +0000
Subject: [PATCH] Improve detection of local function calls in methods

* lisp/emacs-lisp/cl-generic.el (cl--generic-lambda):
Rather than `grep' after the fact,
the macroexpansion records directly
when cl-call-next-method or cl-next-method-p are used.
---
 lisp/emacs-lisp/cl-generic.el | 34 +++++++++++++++++++++++++---------
 1 file changed, 25 insertions(+), 9 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 4a69df15bc..d5d77fe553 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -361,6 +361,14 @@ defun cl--generic-split-args (args)
       (cons (nreverse specializers)
             (nreverse (delq nil plain-args)))))
 
+  (defvar cl-generic--uses-cnm nil
+    ;; It would be better to declare the variable special
+    ;; locally where it's used
+    ;; but there is no support for local special declarations in Elisp.
+    "In a runtime environment, keeps a list of flags that indicate
+the presence of `cl-call-next-method' or `cl-next-method-p'
+in a method body.")
+
   (defun cl--generic-lambda (args body)
     "Make the lambda expression for a method with ARGS and BODY."
     (pcase-let* ((`(,spec-args . ,plain-args)
@@ -369,7 +377,7 @@ defun cl--generic-lambda (args body)
                  (macroenv (cons `(cl-generic-current-method-specializers
                                    . ,(lambda () spec-args))
                                  macroexpand-all-environment)))
-      (require 'cl-lib)        ;Needed to expand `cl-flet' and `cl-function'.
+      (require 'cl-lib)        ;Needed to expand `cl-function', `cl-macrolet'.
       (when (interactive-form (cadr fun))
         (message "Interactive forms unsupported in generic functions: %S"
                  (interactive-form (cadr fun))))
@@ -380,21 +388,29 @@ defun cl--generic-lambda (args body)
          (let* ((parsed-body (macroexp-parse-body body))
                 (cnm (make-symbol "cl--cnm"))
                 (nmp (make-symbol "cl--nmp"))
+                (cl-generic--uses-cnm)
                 (nbody (macroexpand-all
-                        `(cl-flet ((cl-call-next-method ,cnm)
-                                   (cl-next-method-p ,nmp))
+                        `(cl-macrolet ((cl-call-next-method
+                                        (&rest args)
+                                        (prog1 `(funcall ,',cnm ,@args)
+                                          (cl-pushnew
+                                           ',cnm cl-generic--uses-cnm
+                                           :test #'eq)))
+                                       (cl-next-method-p
+                                        ()
+                                        (prog1 `(funcall ,',nmp)
+                                          (cl-pushnew
+                                           ',nmp cl-generic--uses-cnm
+                                           :test #'eq))))
                            ,@(cdr parsed-body))
                         macroenv))
-                ;; FIXME: Rather than `grep' after the fact, the
-                ;; macroexpansion should directly set some flag when cnm
-                ;; is used.
-                ;; FIXME: Also, optimize the case where call-next-method is
+                ;; FIXME: Optimize the case where call-next-method is
                 ;; only called with explicit arguments.
-                (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
+                (uses-cnm cl-generic--uses-cnm))
            (cons (not (not uses-cnm))
                  `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
                       ,@(car parsed-body)
-                      ,(if (not (assq nmp uses-cnm))
+                      ,(if (not (memq nmp uses-cnm))
                            nbody
                          `(let ((,nmp (lambda ()
                                         (cl--generic-isnot-nnm-p ,cnm))))
-- 
2.31.1