master 8d11b7e4275 1/2: * Fix 'cl--typeof-types' computation

[Andrea Corallo]

branch: master
commit 8d11b7e4275affdf66f28ec4a719fc8124252a3d
Author: Andrea Corallo <acorallo@gnu.org>
Commit: Andrea Corallo <acorallo@gnu.org>

    * Fix 'cl--typeof-types' computation
    
    * lisp/emacs-lisp/cl-preloaded.el (cl--supertypes-lane)
    (cl--supertypes-lanes-res): Define vars.
    (cl--supertypes-for-typeof-types-rec): Define function.
    (cl--supertypes-for-typeof-types): Reimplement.
---
 lisp/emacs-lisp/cl-preloaded.el | 27 +++++++++++++++++----------
 1 file changed, 17 insertions(+), 10 deletions(-)

diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el
index b2b921192ff..512cf31ead5 100644
--- a/lisp/emacs-lisp/cl-preloaded.el
+++ b/lisp/emacs-lisp/cl-preloaded.el
@@ -98,17 +98,24 @@ Each element has the form (TYPE . SUPERTYPES) where TYPE is 
one of
 the symbols returned by `type-of', and SUPERTYPES is the list of its
 supertypes from the most specific to least specific.")
 
+(defvar cl--supertypes-lane nil)
+(defvar cl--supertypes-lanes-res nil)
+
+(defun cl--supertypes-for-typeof-types-rec (type)
+  ;; Walk recursively the DAG upwards, when the top is reached collect
+  ;; the current lane in `cl--supertypes-lanes-res'.
+  (push type cl--supertypes-lane)
+  (if-let ((parents (gethash type cl--direct-supertypes-of-type)))
+      (dolist (parent parents)
+        (cl--supertypes-for-typeof-types-rec parent))
+    (push (reverse (cdr cl--supertypes-lane)) ;; Don't include `t'.
+          cl--supertypes-lanes-res ))
+  (pop cl--supertypes-lane))
+
 (defun cl--supertypes-for-typeof-types (type)
-  (cl-loop with agenda = (list type)
-           while agenda
-           for element = (car agenda)
-           unless (or (eq element t) ;; no t in `cl--typeof-types'.
-                      (memq element res))
-             append (list element) into res
-           do (cl-loop for c in (gethash element cl--direct-supertypes-of-type)
-                       do (setq agenda (append agenda (list c))))
-           do (setq agenda (cdr agenda))
-           finally (cl-return res)))
+  (let (cl--supertypes-lane cl--supertypes-lanes-res)
+    (cl--supertypes-for-typeof-types-rec type)
+    (merge-ordered-lists cl--supertypes-lanes-res)))
 
 (maphash (lambda (type _)
            (push (cl--supertypes-for-typeof-types type) cl--typeof-types))