(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.

diff --git a/lisp/subr.el b/lisp/subr.el
index 6a4c1abfb6216ccff9bf04c02a174eb240e2a650..16f327ff699f03bdef14b708d0f625aaf2872b44 100644 (file)
--- 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)