feature/derived-mode-add-parents 9c6b22bb3e2 2/7: (derived-mode-all-parents): Speed up with a cache

[Stefan Monnier]

branch: feature/derived-mode-add-parents
commit 9c6b22bb3e2126a1ab355b81ae4268ac53c2b6fe
Author: Stefan Monnier <monnier@iro.umontreal.ca>
Commit: Stefan Monnier <monnier@iro.umontreal.ca>

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