master 1d1b664fbb: (function-history): New symbol property (bug#53632)

[Stefan Monnier]

branch: master
commit 1d1b664fbb9232aa40d8daa54a689cfd63d38aa9
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

    (function-history): New symbol property (bug#53632)
    
    Rework the code we have in Fdefalias that tries to keep track
    of definitions so as to be able to undo them later.
    
    We used to store in `load-history` when an autoload is redefined as
    a non-autoload and in the `autoload` symbol property we used to store
    the autoload data that used to be used before it got overriden.
    
    Instead, store the history of the function definition of
    a symbol in its `function-history` symbol property.
    To make this list cheap in the default case, the latest value is not stored
    in the list (since it's in the `symbol-function`) and neither is the first
    file.  So if there's only been a single definition (the most common case),
    the list is empty and the property is just not present at all.
    
    The patch also gets rid of the `autoload` vs `defun` distinction in
    `load-history` which seems unnecessary (a significant part of the
    motivation for this patch was to get rid of the special handling of
    autoloads in this part of the code).
    
    * src/data.c (add_to_function_history): New function.
    (defalias): Use it.  Don't add the `t` entries for autoloads and always
    use `defun` regardless of the kind of definition.
    Change `Vautoload_queue` to only hold the function
    symbols since the rest is now available from `function-history`.
    * src/eval.c (un_autoload): Adjust accordingly.
    
    * src/lread.c (load-history): Udate docstring.
    
    * lisp/loadhist.el (loadhist-unload-filename): New var.
    (unload-feature): Bind it.
    (loadhist-unload-element): Document its availability.
    (loadhist--restore-autoload): Delete var.
    (loadhist--unload-function): Delete function.
    (loadhist-unload-element): Delete the `t` and `autoload` methods.
    Rewrite the `defun` method using `function-history`.
    
    * lisp/help-fns.el: Require `seq`.
    (help-fns--autoloaded-p): Rewrite.
    (help-fns-function-description-header): Adjust call accordingly.
    
    * doc/lispref/loading.texi (Where Defined): Remove `autoload` and `t`
    entries from `load-history` since we don't generate them any more.
    Document the `function-history` which replaces the `autoload` property.
    (Unloading): Adjust symbol property name accordingly.
    
    * test/lisp/loadhist-resources/loadhist--bar.el:
    * test/lisp/loadhist-resources/loadhist--foo.el: New files.
    * test/lisp/loadhist-tests.el (loadhist-tests-unload-feature-nested)
    (loadhist-tests-unload-feature-notnested): New tests.
---
 doc/lispref/loading.texi                      | 24 ++++++++---
 etc/NEWS                                      |  6 +++
 lisp/help-fns.el                              | 23 +++-------
 lisp/loadhist.el                              | 54 +++++++++++------------
 src/data.c                                    | 62 +++++++++++++++++++++------
 src/eval.c                                    | 14 +++---
 src/lread.c                                   |  9 ++--
 test/lisp/loadhist-resources/loadhist--bar.el | 27 ++++++++++++
 test/lisp/loadhist-resources/loadhist--foo.el | 29 +++++++++++++
 test/lisp/loadhist-tests.el                   | 47 ++++++++++++++++++++
 10 files changed, 218 insertions(+), 77 deletions(-)

diff --git a/doc/lispref/loading.texi b/doc/lispref/loading.texi
index 5957b8ac38..6179270dd3 100644
--- a/doc/lispref/loading.texi
+++ b/doc/lispref/loading.texi
@@ -1067,13 +1067,8 @@ list elements have these forms:
 The symbol @var{var} was defined as a variable.
 @item (defun . @var{fun})
 The function @var{fun} was defined.
-@item (t . @var{fun})
-The function @var{fun} was previously an autoload before this library
-redefined it as a function.  The following element is always
 @code{(defun . @var{fun})}, which represents defining @var{fun} as a
 function.
-@item (autoload . @var{fun})
-The function @var{fun} was defined as an autoload.
 @item (defface . @var{face})
 The face @var{face} was defined.
 @item (require . @var{feature})
@@ -1096,6 +1091,23 @@ The value of @code{load-history} may have one element 
whose @sc{car} is
 by adding the symbols defined to the element for the file being visited,
 rather than replacing that element.  @xref{Eval}.
 
+In addition to @code{load-history}, every function keeps track of its
+own history in the symbol property @code{function-history}.
+The reason why functions are treated specially in this respect is that
+it is common for functions to be defined in two steps in two different
+files (typically, one of them is an autoload), so in order to be
+able to properly @emph{unload} a file, we need to know more precisely
+what that file did to the function definition.
+
+@kindex{function-history}
+The symbol property @code{function-history} holds a list of the form
+@code{(@var{file1} @var{def2} @var{file2} @var{def3} ...)} where
+@var{file1} is the last file that changed the definition and
+@var{def2} was the definition before @var{file1}, set by @var{file2},
+etc... Logically this list should end with the name of the first file
+that defined this function, but to save space this last element
+is usually omitted.
+
 @node Unloading
 @section Unloading
 @cindex unloading packages
@@ -1110,7 +1122,7 @@ It undefines all functions, macros, and variables defined 
in that
 library with @code{defun}, @code{defalias}, @code{defsubst},
 @code{defmacro}, @code{defconst}, @code{defvar}, and @code{defcustom}.
 It then restores any autoloads formerly associated with those symbols.
-(Loading saves these in the @code{autoload} property of the symbol.)
+(Loading saves these in the @code{function-history} property of the symbol.)
 
 Before restoring the previous definitions, @code{unload-feature} runs
 @code{remove-hook} to remove functions defined by the library from certain
diff --git a/etc/NEWS b/etc/NEWS
index 4583cfb095..5d4a59975c 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -129,6 +129,9 @@ example, if point is before an Emoji sequence, pressing 
<Delete> will
 delete the entire sequence, not just a single character at its
 beginning.
 
+** 'load-history' does not treat autoloads specially any more.
+An autoload definition appears just as a (defun . NAME) and the
+(t . NAME) entries are not generated any more.
 
 * Changes in Emacs 29.1
 
@@ -1471,6 +1474,9 @@ The property ':position' now specifies the position of 
the underline
 when used as part of a property list specification for the
 ':underline' attribute.
 
+** 'defalias' records a more precise history of definitions.
+This is recorded in the `function-history` symbol property.
+
 
 * Changes in Emacs 29.1 on Non-Free Operating Systems
 
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 98a1b11e08..36c7966919 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -33,6 +33,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'seq)
 (require 'help-mode)
 (require 'radix-tree)
 (eval-when-compile (require 'subr-x))   ;For when-let.
@@ -678,19 +679,9 @@ suitable file is found, return nil."
     (terpri)))
 
 ;; We could use `symbol-file' but this is a wee bit more efficient.
-(defun help-fns--autoloaded-p (function file)
-  "Return non-nil if FUNCTION has previously been autoloaded.
-FILE is the file where FUNCTION was probably defined."
-  (let* ((file (file-name-sans-extension (file-truename file)))
-        (load-hist load-history)
-        (target (cons t function))
-        found)
-    (while (and load-hist (not found))
-      (and (stringp (caar load-hist))
-          (equal (file-name-sans-extension (caar load-hist)) file)
-          (setq found (member target (cdar load-hist))))
-      (setq load-hist (cdr load-hist)))
-    found))
+(defun help-fns--autoloaded-p (function)
+  "Return non-nil if FUNCTION has previously been autoloaded."
+  (seq-some #'autoloadp (get function 'function-history)))
 
 (defun help-fns--interactive-only (function)
   "Insert some help blurb if FUNCTION should only be used interactively."
@@ -873,13 +864,13 @@ Returns a list of the form (REAL-FUNCTION DEF ALIASED 
REAL-DEF)."
   "Print a line describing FUNCTION to `standard-output'."
   (pcase-let* ((`(,_real-function ,def ,aliased ,real-def)
                 (help-fns--analyze-function function))
-               (file-name (find-lisp-object-file-name function (if aliased 
'defun
-                                                                 def)))
+               (file-name (find-lisp-object-file-name
+                           function (if aliased 'defun def)))
                (beg (if (and (or (byte-code-function-p def)
                                  (keymapp def)
                                  (memq (car-safe def) '(macro lambda closure)))
                              (stringp file-name)
-                             (help-fns--autoloaded-p function file-name))
+                             (help-fns--autoloaded-p function))
                         (concat
                          "an autoloaded " (if (commandp def)
                                               "interactive "))
diff --git a/lisp/loadhist.el b/lisp/loadhist.el
index 48058f4053..39481ab068 100644
--- a/lisp/loadhist.el
+++ b/lisp/loadhist.el
@@ -157,38 +157,35 @@ documentation of `unload-feature' for details.")
           ;; mode, or proposed is not nil and not major-mode, and so we use it.
           (funcall (or proposed 'fundamental-mode)))))))
 
+(defvar loadhist-unload-filename nil)
+
 (cl-defgeneric loadhist-unload-element (x)
-  "Unload an element from the `load-history'."
+  "Unload an element from the `load-history'.
+The variable `loadhist-unload-filename' holds the name of the file we're
+unloading."
   (message "Unexpected element %S in load-history" x))
 
-;; In `load-history', the definition of a previously autoloaded
-;; function is represented by 2 entries: (t . SYMBOL) comes before
-;; (defun . SYMBOL) and says we should restore SYMBOL's autoload when
-;; we undefine it.
-;; So we use this auxiliary variable to keep track of the last (t . SYMBOL)
-;; that occurred.
-(defvar loadhist--restore-autoload nil
-  "If non-nil, is a symbol for which to try to restore a previous autoload.")
-
-(cl-defmethod loadhist-unload-element ((x (head t)))
-  (setq loadhist--restore-autoload (cdr x)))
-
-(defun loadhist--unload-function (x)
-  (let ((fun (cdr x)))
-    (when (fboundp fun)
-      (when (fboundp 'ad-unadvise)
-       (ad-unadvise fun))
-      (let ((aload (get fun 'autoload)))
-       (defalias fun
-          (if (and aload (eq fun loadhist--restore-autoload))
-             (cons 'autoload aload)
-            nil)))))
-  (setq loadhist--restore-autoload nil))
-
 (cl-defmethod loadhist-unload-element ((x (head defun)))
-  (loadhist--unload-function x))
-(cl-defmethod loadhist-unload-element ((x (head autoload)))
-  (loadhist--unload-function x))
+  (let* ((fun (cdr x))
+         (hist (get fun 'function-history)))
+    (cond
+     ((null hist)
+      (defalias fun nil)
+      ;; Override the change that `defalias' just recorded.
+      (put fun 'function-history nil))
+     ((equal (car hist) loadhist-unload-filename)
+      (defalias fun (cadr hist))
+      ;; Set the history afterwards, to override the change that
+      ;; `defalias' records otherwise.
+      (put fun 'function-history (cddr hist)))
+     (t
+      ;; Unloading a file whose definition is "inactive" (i.e. has been
+      ;; overridden by another file): just remove it from the history,
+      ;; so future unloading of that other file has a chance to DTRT.
+      (let* ((tmp (plist-member hist loadhist-unload-filename))
+             (pos (- (length hist) (length tmp))))
+        (cl-assert (> pos 1))
+        (setcdr (nthcdr (- pos 2) hist) (cdr tmp)))))))
 
 (cl-defmethod loadhist-unload-element ((_ (head require))) nil)
 (cl-defmethod loadhist-unload-element ((_ (head defface))) nil)
@@ -257,6 +254,7 @@ something strange, such as redefining an Emacs function."
               (prin1-to-string dependents) file))))
   (let* ((unload-function-defs-list (feature-symbols feature))
          (file (pop unload-function-defs-list))
+         (loadhist-unload-filename file)
         (name (symbol-name feature))
          (unload-hook (intern-soft (concat name "-unload-hook")))
         (unload-func (intern-soft (concat name "-unload-function"))))
diff --git a/src/data.c b/src/data.c
index a5a76a2755..95d29ac9e9 100644
--- a/src/data.c
+++ b/src/data.c
@@ -859,6 +859,43 @@ DEFUN ("fset", Ffset, Sfset, 2, 2, 0,
   return definition;
 }
 
+static void
+add_to_function_history (Lisp_Object symbol, Lisp_Object olddef)
+{
+  eassert (!NILP (olddef));
+
+  Lisp_Object past = Fget (symbol, Qfunction_history);
+  Lisp_Object file = Qnil;
+  /* FIXME: Sadly, `Vload_file_name` gives less precise information
+     (it's sometimes non-nil when it shoujld be nil).  */
+  Lisp_Object tail = Vcurrent_load_list;
+  FOR_EACH_TAIL_SAFE (tail)
+    if (NILP (XCDR (tail)) && STRINGP (XCAR (tail)))
+      file = XCAR (tail);
+
+  Lisp_Object tem = Fplist_member (past, file);
+  if (!NILP (tem))
+    { /* New def from a file used before.
+         Overwrite the previous record associated with this file.  */
+      if (EQ (tem, past))
+        /* The new def is from the same file as the last change, so
+           there's nothing to do: unloading the file should revert to
+           the status before the last change rather than before this load.  */
+        return;
+      Lisp_Object pastlen = Flength (past);
+      Lisp_Object temlen = Flength (tem);
+      EMACS_INT tempos = XFIXNUM (pastlen) - XFIXNUM (temlen);
+      eassert (tempos > 1);
+      Lisp_Object prev = Fnthcdr (make_fixnum (tempos - 2), past);
+      /* Remove the previous info for this file.
+         E.g. change `hist` from (... OTHERFILE DEF3 THISFILE DEF2 ...)
+         to (... OTHERFILE DEF2). */
+      XSETCDR (prev, XCDR (tem));
+    }
+  /* Push new def from new file.  */
+  Fput (symbol, Qfunction_history, Fcons (file, Fcons (olddef, past)));
+}
+
 void
 defalias (Lisp_Object symbol, Lisp_Object definition)
 {
@@ -866,19 +903,19 @@ defalias (Lisp_Object symbol, Lisp_Object definition)
     bool autoload = AUTOLOADP (definition);
     if (!will_dump_p () || !autoload)
       { /* Only add autoload entries after dumping, because the ones before are
-          not useful and else we get loads of them from the loaddefs.el.  */
-        Lisp_Object function = XSYMBOL (symbol)->u.s.function;
-
-       if (AUTOLOADP (function))
-         /* Remember that the function was already an autoload.  */
-         LOADHIST_ATTACH (Fcons (Qt, symbol));
-       LOADHIST_ATTACH (Fcons (autoload ? Qautoload : Qdefun, symbol));
-
-        if (!NILP (Vautoload_queue) && !NILP (function))
-          Vautoload_queue = Fcons (Fcons (symbol, function), Vautoload_queue);
+          not useful and else we get loads of them from the loaddefs.el.
+          That saves us about 110KB in the pdmp file (Jan 2022).  */
+       LOADHIST_ATTACH (Fcons (Qdefun, symbol));
+      }
+  }
 
-        if (AUTOLOADP (function))
-          Fput (symbol, Qautoload, XCDR (function));
+  {
+    Lisp_Object olddef = XSYMBOL (symbol)->u.s.function;
+    if (!NILP (olddef))
+      {
+        if (!NILP (Vautoload_queue))
+          Vautoload_queue = Fcons (symbol, Vautoload_queue);
+        add_to_function_history (symbol, olddef);
       }
   }
 
@@ -4171,6 +4208,7 @@ syms_of_data (void)
 
   DEFSYM (Qinteractive_form, "interactive-form");
   DEFSYM (Qdefalias_fset_function, "defalias-fset-function");
+  DEFSYM (Qfunction_history, "function-history");
 
   DEFSYM (Qbyte_code_function_p, "byte-code-function-p");
 
diff --git a/src/eval.c b/src/eval.c
index b083a00a79..1076985d09 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -2250,21 +2250,17 @@ this does nothing and returns nil.  */)
 static void
 un_autoload (Lisp_Object oldqueue)
 {
-  Lisp_Object queue, first, second;
-
   /* Queue to unwind is current value of Vautoload_queue.
      oldqueue is the shadowed value to leave in Vautoload_queue.  */
-  queue = Vautoload_queue;
+  Lisp_Object queue = Vautoload_queue;
   Vautoload_queue = oldqueue;
   while (CONSP (queue))
     {
-      first = XCAR (queue);
-      second = Fcdr (first);
-      first = Fcar (first);
-      if (EQ (first, make_fixnum (0)))
-       Vfeatures = second;
+      Lisp_Object first = XCAR (queue);
+      if (CONSP (first) && EQ (XCAR (first), make_fixnum (0)))
+       Vfeatures = XCDR (first);
       else
-       Ffset (first, second);
+       Ffset (first, Fcar (Fcdr (Fget (first, Qfunction_history))));
       queue = XCDR (queue);
     }
 }
diff --git a/src/lread.c b/src/lread.c
index 9910db27de..713c03243c 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -5240,12 +5240,9 @@ for symbols and features not associated with any file.
 The remaining ENTRIES in the alist element describe the functions and
 variables defined in that file, the features provided, and the
 features required.  Each entry has the form `(provide . FEATURE)',
-`(require . FEATURE)', `(defun . FUNCTION)', `(autoload . SYMBOL)',
-`(defface . SYMBOL)', `(define-type . SYMBOL)',
-`(cl-defmethod METHOD SPECIALIZERS)', or `(t . SYMBOL)'.
-Entries like `(t . SYMBOL)' may precede a `(defun . FUNCTION)' entry,
-and mean that SYMBOL was an autoload before this file redefined it
-as a function.  In addition, entries may also be single symbols,
+`(require . FEATURE)', `(defun . FUNCTION)', `(defface . SYMBOL)',
+ `(define-type . SYMBOL)', or `(cl-defmethod METHOD SPECIALIZERS)'.
+In addition, entries may also be single symbols,
 which means that symbol was defined by `defvar' or `defconst'.
 
 During preloading, the file name recorded is relative to the main Lisp
diff --git a/test/lisp/loadhist-resources/loadhist--bar.el 
b/test/lisp/loadhist-resources/loadhist--bar.el
new file mode 100644
index 0000000000..5c8914ed57
--- /dev/null
+++ b/test/lisp/loadhist-resources/loadhist--bar.el
@@ -0,0 +1,27 @@
+;;; loadhist--bar.el --- Dummy package for loadhist-tests  -*- 
lexical-binding: t; -*-
+
+;; Copyright (C) 2022  Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Code:
+
+(autoload 'loadhist--foo-inc "loadhist--foo")
+
+(defun loadhist--bar-dec (x) (1- x))
+
+(provide 'loadhist--bar)
+;;; loadhist--bar.el ends here
diff --git a/test/lisp/loadhist-resources/loadhist--foo.el 
b/test/lisp/loadhist-resources/loadhist--foo.el
new file mode 100644
index 0000000000..3574c22013
--- /dev/null
+++ b/test/lisp/loadhist-resources/loadhist--foo.el
@@ -0,0 +1,29 @@
+;;; loadhist--foo.el --- Dummy package for loadhist-tests  -*- 
lexical-binding: t; -*-
+
+;; Copyright (C) 2022  Free Software Foundation, Inc.
+
+;; Author: Stefan Monnier <monnier@iro.umontreal.ca>
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+(autoload 'loadhist--bar-dec "loadhist--bar")
+
+(defun loadhist--foo-inc (x) (1+ x))
+
+(provide 'loadhist--foo)
+;;; loadhist--foo.el ends here
diff --git a/test/lisp/loadhist-tests.el b/test/lisp/loadhist-tests.el
index a941ac0632..ef5fc164d3 100644
--- a/test/lisp/loadhist-tests.el
+++ b/test/lisp/loadhist-tests.el
@@ -54,4 +54,51 @@
   (should-error (unload-feature 'dired))
   (unload-feature 'dired-x))
 
+(defvar loadhist--tests-dir (file-name-directory (macroexp-file-name)))
+
+(ert-deftest loadhist-tests-unload-feature-nested ()
+  (add-to-list 'load-path (expand-file-name
+                           "loadhist-resources/"
+                           loadhist--tests-dir))
+  (declare-function loadhist--foo-inc "loadhist--foo")
+  (declare-function loadhist--bar-dec "loadhist--dec")
+  (load "loadhist--foo" nil t)
+  (should (and (functionp 'loadhist--bar-dec) (functionp 'loadhist--foo-inc)))
+  (should (autoloadp (symbol-function 'loadhist--bar-dec)))
+  (load "loadhist--bar" nil t)
+  (should (and (functionp 'loadhist--bar-dec) (functionp 'loadhist--foo-inc)))
+  (should (not (autoloadp (symbol-function 'loadhist--bar-dec))))
+  (should (not (autoloadp (symbol-function 'loadhist--foo-inc))))
+  (should (equal (list 40 42)
+                 (list (loadhist--bar-dec 41) (loadhist--foo-inc 41))))
+  (unload-feature 'loadhist--bar)
+  (should (and (functionp 'loadhist--bar-dec) (functionp 'loadhist--foo-inc)))
+  (should (autoloadp (symbol-function 'loadhist--bar-dec)))
+  (should (not (autoloadp (symbol-function 'loadhist--foo-inc))))
+  (unload-feature 'loadhist--foo)
+  (should (null (symbol-function 'loadhist--bar-dec)))
+  (should (null (symbol-function 'loadhist--foo-inc)))
+  (should (null (get 'loadhist--bar-dec 'function-history)))
+  (should (null (get 'loadhist--foo-inc 'function-history))))
+
+(ert-deftest loadhist-tests-unload-feature-notnested ()
+  (add-to-list 'load-path (expand-file-name
+                           "loadhist-resources/"
+                           loadhist--tests-dir))
+  (load "loadhist--foo" nil t)
+  (load "loadhist--bar" nil t)
+  (should (equal (list 40 42)
+                 (list (loadhist--bar-dec 41) (loadhist--foo-inc 41))))
+  (unload-feature 'loadhist--foo)
+  (should (functionp 'loadhist--bar-dec))
+  (should (not (autoloadp (symbol-function 'loadhist--bar-dec))))
+  (should  (let ((f (symbol-function 'loadhist--foo-inc)))
+             ;; Both choices seem acceptable.
+             (or (null f) (autoloadp f))))
+  (unload-feature 'loadhist--bar)
+  (should (null (symbol-function 'loadhist--bar-dec)))
+  (should (null (symbol-function 'loadhist--foo-inc)))
+  (should (null (get 'loadhist--bar-dec 'function-history)))
+  (should (null (get 'loadhist--foo-inc 'function-history))))
+
 ;;; loadhist-tests.el ends here