From 2fd4d66a93831a63d19a8ab2efb927136f196beb Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Thu, 26 Aug 2021 06:09:07 +0000
Subject: [PATCH 1/2] 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 | 51 ++++++++++++++++++++++++++---------
 1 file changed, 39 insertions(+), 12 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 4a69df15bc..8fdd905785 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -369,7 +369,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' and body.
       (when (interactive-form (cadr fun))
         (message "Interactive forms unsupported in generic functions: %S"
                  (interactive-form (cadr fun))))
@@ -377,24 +377,51 @@ defun cl--generic-lambda (args body)
       ;; destructuring args, `declare' and whatnot).
       (pcase (macroexpand fun macroenv)
         (`#'(lambda ,args . ,body)
-         (let* ((parsed-body (macroexp-parse-body body))
+         (let* ((parsed-body (macroexp-parse-body body)) uses-cnm
                 (cnm (make-symbol "cl--cnm"))
                 (nmp (make-symbol "cl--nmp"))
-                (nbody (macroexpand-all
-                        `(cl-flet ((cl-call-next-method ,cnm)
-                                   (cl-next-method-p ,nmp))
-                           ,@(cdr parsed-body))
-                        macroenv))
-                ;; FIXME: Rather than `grep' after the fact, the
-                ;; macroexpansion should directly set some flag when cnm
-                ;; is used.
+                (nbody
+                 ;; We duplicate the code from `cl-flet' augmenting it
+                 ;; with `cl-pushnew' forms to record the presence of
+                 ;; `cl-call-next-method', `cl-next-method-p'.
+                 ;; It would be better to avoid code duplication
+                 ;; but it's not clear how to do that reasonably enough.
+                 (let ((newenv
+                        (cons `(cl-call-next-method
+                                .
+                                ,(lambda (&rest args)
+                                   (cl-pushnew cnm uses-cnm :test #'eq)
+                                   (if (eq (car args) cl--labels-magic)
+                                       (list cl--labels-magic cnm)
+                                     `(funcall ,cnm ,@args))))
+                              (cons `(cl-next-method-p
+                                      .
+                                      ,(lambda (&rest args)
+                                         (cl-pushnew nmp uses-cnm :test #'eq)
+                                         (if (eq (car args) cl--labels-magic)
+                                             (list cl--labels-magic nmp)
+                                           `(funcall ,nmp ,@args))))
+                                    macroenv))))
+                   (macroexpand-all
+                    `(progn ,@(cdr parsed-body))
+                    ;; Don't override lexical-let's macro-expander
+                    (if (assq 'function newenv) newenv
+                      (cons (cons 'function
+                                  (lambda (f)
+                                    (cl-case f
+                                      (cl-call-next-method
+                                       (cl-pushnew cnm uses-cnm :test #'eq))
+                                      (cl-next-method-p
+                                       (cl-pushnew nmp uses-cnm :test #'eq)))
+                                    (cl--labels-convert f)))
+                            newenv)))))
                 ;; FIXME: Also, optimize the case where call-next-method is
                 ;; only called with explicit arguments.
-                (uses-cnm (macroexp--fgrep `((,cnm) (,nmp)) nbody)))
+                (uses-cnm 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