Re: [PATCH] Improve detection of local function calls in methods

[akater <nuclearspace@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 1209 bytes --]

Stefan Monnier <monnier@iro.umontreal.ca> writes:

> Hmm... IIUC this fails to account for the case where
> #'cl-call-next-method is passed to a function (the most common case (or
> more precisely, the only case I've seen so far) being when it's passed
> to `apply`).

Right.  cl-flet should have reminded me that cl-call-next-method is a
local function, not a local macro.

> [ I'm not completely sure what you mean, but (defvar foo) has an effect

I was referring to hypothetical

#+begin_example elisp
(let* (...
       cl-generic--uses-crm)
  (declare (special cl-generic--uses-crm))
  ...)
#+end_example

But it doesn't matter anymore.  See the new patches.

Notes:

- I splitted patches in two because the first diff looks significantly
  better this way.

- Normally I'd put uses-cnm binding/declaration right before where it's
  used.  However, putting it earlier gives a cleaner diff; also,
  uses-cnm means “parsed body uses cnm” so I think it's OK to put it
  right on the same line as (parsed-body ..), and this also utilizes the
  whitespace better.

I don't know if all this is appropriate style; I provide patches this
way in the hope it's acceptable.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: cl--generic-lambda fix --]
[-- Type: text/x-diff, Size: 4851 bytes --]

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


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: cl--generic-lambda cleanup --]
[-- Type: text/x-diff, Size: 1171 bytes --]

From 9d506f6bdee01bce3dfe2fed8d159dfd4ce9d0ef Mon Sep 17 00:00:00 2001
From: akater <nuclearspace@gmail.com>
Date: Sun, 29 Aug 2021 10:38:12 +0000
Subject: [PATCH 2/2] ; * lisp/emacs-lisp/cl-generic.el (cl--generic-lambda):
 Cleanup

---
 lisp/emacs-lisp/cl-generic.el | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index 8fdd905785..fd57599b1e 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -415,9 +415,9 @@ defun cl--generic-lambda (args body)
                                        (cl-pushnew nmp uses-cnm :test #'eq)))
                                     (cl--labels-convert f)))
                             newenv)))))
-                ;; 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 uses-cnm))
+                )
            (cons (not (not uses-cnm))
                  `#'(lambda (,@(if uses-cnm (list cnm)) ,@args)
                       ,@(car parsed-body)
-- 
2.31.1