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

[Daniel Mendler]

For me it seems to fix the issue. @jakanakaevangeli, can you confirm? I 
would still prefer to see a "proper fix". But given the backward 
compatibility requirements such a fix may not exist.

Perhaps one could introduce some deprecation behavior. If a hook is 
removed and the object is not found via eq but found via equal, then 
print a warning? And then change the add-hook/remove-hook functions to 
eq only in some later version.

Furthermore as a stop-gap measure one may still apply my patched 
symbol-indirection `minibuffer-with-setup-hook`, and revert it once the 
proper fix has been applied.

(Using the symbol indirection seems to have other debuggability 
advantages. Closures are not particularly nice to debug in elisp, I hope 
we will also see some improvements regarding that. It is at least on my 
Elisp wishlist to have better introspection for closures, location info 
etc.)

Note that `set-transient-map` already uses the symbol indirection. It 
may make sense to link to this bug from there such that one can adjust 
this function also at some later point depending on the resolution of 
this issue. The comment in `set-transient-map` reads like a bug to me
"Don't use letrec, because equal (in add/remove-hook) would get trapped 
in a cycle." :)

Daniel

On 4/23/21 8:26 PM, Stefan Monnier wrote:
> > 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)))