From 9c6b22bb3e2126a1ab355b81ae4268ac53c2b6fe Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 8 Nov 2023 14:20:09 -0500 Subject: [PATCH] (derived-mode-all-parents): Speed up with a cache Most uses of the mode hierarchy don't really need to construct the list, they just need to iterate over it. With single inheritance we could do it just by jumping up from a mode to its parent, but to support the upcoming multiple inheritance we'd need a more complex and costly iterator. Luckily, the inheritance graph is mostly static so we can cache the list of all parents, making `derived-mode-all-parents` cheap enough to be the basis of iteration and keeping the API very simple. * lisp/subr.el (derived-mode-all-parents): Cache the result. (derived-mode--flush): New function. (derived-mode-set-parent): Use it. --- lisp/subr.el | 40 +++++++++++++++++++++++++++++++--------- 1 file changed, 31 insertions(+), 9 deletions(-) diff --git a/lisp/subr.el b/lisp/subr.el index 6a4c1abfb62..16f327ff699 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2682,14 +2682,28 @@ The variable list SPEC is the same as in `if-let*'." "Return all the parents of MODE, starting with MODE. The returned list is not fresh, don't modify it. \n(fn MODE)" ;`known-children' is for internal use only. - (if (memq mode known-children) - (error "Cycle in the major mode hierarchy: %S" mode) - (push mode known-children)) - (let* ((parent (or (get mode 'derived-mode-parent) - ;; If MODE is an alias, then follow the alias. - (let ((alias (symbol-function mode))) - (and (symbolp alias) alias))))) - (cons mode (if parent (derived-mode-all-parents parent known-children))))) + ;; Can't use `with-memoization' :-( + (let ((ps (get mode 'derived-mode--all-parents))) + (if ps ps + (if (memq mode known-children) + (error "Cycle in the major mode hierarchy: %S" mode) + (push mode known-children)) + (let* ((parent (or (get mode 'derived-mode-parent) + ;; If MODE is an alias, then follow the alias. + (let ((alias (symbol-function mode))) + (and (symbolp alias) alias))))) + (put mode 'derived-mode--all-parents + (cons mode + (when parent + ;; Can't use `cl-lib' here (nor `gv') :-( + ;;(cl-assert (not (equal parent mode))) + ;;(cl-pushnew mode (get parent 'derived-mode--followers)) + (let ((followers (get parent 'derived-mode--followers))) + (unless (memq mode followers) + (put parent 'derived-mode--followers + (cons mode followers)))) + (derived-mode-all-parents + parent known-children)))))))) (defun provided-mode-derived-p (mode &rest modes) "Non-nil if MODE is derived from one of MODES. @@ -2708,7 +2722,15 @@ Uses the `derived-mode-parent' property of the symbol to trace backwards." (defun derived-mode-set-parent (mode parent) "Declare PARENT to be the parent of MODE." - (put mode 'derived-mode-parent parent)) + (put mode 'derived-mode-parent parent) + (derived-mode--flush mode)) + +(defun derived-mode--flush (mode) + (put mode 'derived-mode--all-parents nil) + (let ((followers (get mode 'derived-mode--followers))) + (when followers ;; Common case. + (put mode 'derived-mode--followers nil) + (mapc #'derived-mode--flush followers)))) (defvar-local major-mode--suspended nil) (put 'major-mode--suspended 'permanent-local t) -- 2.39.2