bug#46326: 27.1.50; Excessive memory allocations with minibuffer-with-setup-hook

[Stefan Monnier]

> I have an issue on 27.1.50 with excessive memory allocations when using
> minibuffer-with-setup-hook with large closures and :append.

Indeed, we have a problem there.  I think it's fairly hard to fix it
for good without introducing incompatibilities, because `add-hook` has
been defined to compare its functions with `equal` "for ever" and
changing it to use `eq` or `function-equal` will inevitably break
code out there in subtle ways.

IOW I think the better fix is to change `minibuffer-with-setup-hook` to
use an indirection via a symbol.

As for reducing the impact of the underlying issue, I see we could
reduce the amount of `equal` tests being performed, by using `eq` for
the lookups in `hook--depth-alist`.
So before we install the "real" solution, could you try the patch below
and report how much it helps (if at all)?


        Stefan


diff --git a/lisp/subr.el b/lisp/subr.el
index c2be26a15f5..7b718a48a8d 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1830,12 +1834,13 @@ add-hook
     (unless (member function hook-value)
       (when (stringp function)          ;FIXME: Why?
        (setq function (purecopy function)))
+      ;; All those `equal' tests performed between functions can end up being
+      ;; costly since those functions may be large recursive and even cyclic
+      ;; structures, so we index `hook--depth-alist' with `eq'.  (bug#46326)
       (when (or (get hook 'hook--depth-alist) (not (zerop depth)))
         ;; Note: The main purpose of the above `when' test is to avoid running
         ;; this `setf' before `gv' is loaded during bootstrap.
-        (setf (alist-get function (get hook 'hook--depth-alist)
-                         0 'remove #'equal)
-              depth))
+        (push (cons function depth) (get hook 'hook--depth-alist)))
       (setq hook-value
            (if (< 0 depth)
                (append hook-value (list function))
@@ -1845,8 +1850,8 @@ add-hook
           (setq hook-value
                 (sort (if (< 0 depth) hook-value (copy-sequence hook-value))
                       (lambda (f1 f2)
-                        (< (alist-get f1 depth-alist 0 nil #'equal)
-                           (alist-get f2 depth-alist 0 nil #'equal))))))))
+                        (< (alist-get f1 depth-alist 0 nil #'eq)
+                           (alist-get f2 depth-alist 0 nil #'eq))))))))
     ;; Set the actual variable
     (if local
        (progn
@@ -1907,11 +1912,20 @@ remove-hook
               (not (and (consp (symbol-value hook))
                         (memq t (symbol-value hook)))))
       (setq local t))
-    (let ((hook-value (if local (symbol-value hook) (default-value hook))))
+    (let ((hook-value (if local (symbol-value hook) (default-value hook)))
+          (old-fun nil))
       ;; Remove the function, for both the list and the non-list cases.
       (if (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
-         (if (equal hook-value function) (setq hook-value nil))
-       (setq hook-value (delete function (copy-sequence hook-value))))
+         (when (equal hook-value function)
+           (setq old-fun hook-value)
+           (setq hook-value nil))
+       (when (setq old-fun (car (member function hook-value)))
+         (setq hook-value (remq old-fun hook-value))))
+      (when old-fun
+        ;; Remove auxiliary depth info to avoid leaks.
+        (put hook 'hook--depth-alist
+             (delq (assq old-fun (get hook 'hook--depth-alist))
+                   (get hook 'hook--depth-alist))))
       ;; If the function is on the global hook, we need to shadow it locally
       ;;(when (and local (member function (default-value hook))
       ;;              (not (member (cons 'not function) hook-value)))