Simplify type hierarchy operations

Now that built-in types have classes that describe their
relationships exactly like struct/eieio/oclosure classes,
we can the code that navigates that DAG.

* lisp/emacs-lisp/cl-generic.el (cl--generic-struct-tag): Move to
`eieio-core.el`.
(cl--generic-type-specializers): Rename from
`cl--generic-struct-specializers`.  Make it work for any class.
(cl--generic-typeof-generalizer, cl--generic-oclosure-generalizer): Use it.
(cl--generic-struct-generalizer): Delete generalizer.
(cl-generic-generalizers :extra "cl-struct"): Delete method.
(prefill 0 cl--generic-generalizer): Move to after the typeof.
(cl-generic-generalizers :extra "typeof"): Rewrite to use
classes rather than `cl--all-builtin-types`.
(cl-generic--oclosure-specializers): Delete function.

* lisp/emacs-lisp/cl-preloaded.el (cl--direct-supertypes-of-type)
(cl--typeof-types, cl--all-builtin-types): Delete constants.

* lisp/emacs-lisp/comp-cstr.el (comp--typeof-builtin-types):
Delete constant.
(comp--cl-class-hierarchy): Simplify.
(comp--compute-typeof-types): Simplify now that
`comp--cl-class-hierarchy` and `comp--all-classes` work for built-in
types as well.
(comp--direct-supertypes): Just use `cl--class-parents`.
(comp-supertypes): Simplify since typeof-types should now be complete.

* lisp/emacs-lisp/eieio-core.el (eieio-defclass-autoload):
Use `superclasses` argument, so we can find parents before it's loaded.
(eieio--class-precedence-c3, eieio--class-precedence-dfs):
Don't add a `eieio-default-superclass` parent any more.
(eieio--class/struct-parents): Delete function.
(eieio--class-precedence-bfs): Use `eieio--class-parents` instead.
Don't stop when reaching `eieio-default-superclass`.
(cl--generic-struct-tag): Move from `cl-generic.el`.

1 files changed, 16 insertions, 51 deletions

diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el
index f439a97f88c..84eb800ec24 100644
--- a/lisp/emacs-lisp/cl-generic.el
+++ b/lisp/emacs-lisp/cl-generic.el
@@ -1330,62 +1330,31 @@ These match if the argument is `eql' to VAL."
 (cl--generic-prefill-dispatchers (terminal-parameter nil 'xterm--set-selection)
                                  (eql nil))
 
-;;; Support for cl-defstructs specializers.
+;;; Dispatch on "normal types".
 
-(defun cl--generic-struct-tag (name &rest _)
-  ;; Use exactly the same code as for `typeof'.
-  `(if ,name (type-of ,name) 'null))
-
-(defun cl--generic-struct-specializers (tag &rest _)
+(defun cl--generic-type-specializers (tag &rest _)
   (and (symbolp tag)
-       (let ((class (get tag 'cl--class)))
-         (when (cl-typep class 'cl-structure-class)
+       (let ((class (cl--find-class tag)))
+         (when class
            (cl--class-allparents class)))))
 
-(cl-generic-define-generalizer cl--generic-struct-generalizer
-  50 #'cl--generic-struct-tag
-  #'cl--generic-struct-specializers)
-
-(cl-defmethod cl-generic-generalizers :extra "cl-struct" (type)
-  "Support for dispatch on types defined by `cl-defstruct'."
-  (or
-   (when (symbolp type)
-     ;; Use the "cl--struct-class*" (inlinable) functions/macros rather than
-     ;; the "cl-struct-*" variants which aren't inlined, so that dispatch can
-     ;; take place without requiring cl-lib.
-     (let ((class (cl--find-class type)))
-       (and (cl-typep class 'cl-structure-class)
-            (or (null (cl--struct-class-type class))
-		(error "Can't dispatch on cl-struct %S: type is %S"
-                     type (cl--struct-class-type class)))
-            (progn (cl-assert (null (cl--struct-class-named class))) t)
-            (list cl--generic-struct-generalizer))))
-   (cl-call-next-method)))
-
-(cl--generic-prefill-dispatchers 0 cl--generic-generalizer)
-
-;;; Dispatch on "system types".
-
 (cl-generic-define-generalizer cl--generic-typeof-generalizer
   ;; FIXME: We could also change `type-of' to return `null' for nil.
   10 (lambda (name &rest _) `(if ,name (type-of ,name) 'null))
-  (lambda (tag &rest _)
-    (and (symbolp tag) (assq tag cl--typeof-types))))
+  #'cl--generic-type-specializers)
 
 (cl-defmethod cl-generic-generalizers :extra "typeof" (type)
-  "Support for dispatch on builtin types.
-See the full list and their hierarchy in `cl--typeof-types'."
+  "Support for dispatch on types.
+This currently works for built-in types and types built on top of records."
   ;; FIXME: Add support for other types accepted by `cl-typep' such
   ;; as `character', `face', `function', ...
   (or
-   (and (memq type cl--all-builtin-types)
-        (progn
-          ;; FIXME: While this wrinkle in the semantics can be occasionally
-          ;; problematic, this warning is more often annoying than helpful.
-          ;;(if (memq type '(vector array sequence))
-          ;;    (message "`%S' also matches CL structs and EIEIO classes"
-          ;;             type))
-          (list cl--generic-typeof-generalizer)))
+   (and (symbolp type)
+        (not (eq type t)) ;; Handled by the `t-generalizer'.
+        (let ((class (cl--find-class type)))
+          (memq (type-of class)
+                '(built-in-class cl-structure-class eieio--class)))
+        (list cl--generic-typeof-generalizer))
    (cl-call-next-method)))
 
 (cl--generic-prefill-dispatchers 0 integer)
@@ -1393,6 +1362,8 @@ See the full list and their hierarchy in `cl--typeof-types'."
 (cl--generic-prefill-dispatchers 0 cl--generic-generalizer integer)
 (cl--generic-prefill-dispatchers 0 (eql 'x) integer)
 
+(cl--generic-prefill-dispatchers 0 cl--generic-generalizer)
+
 ;;; Dispatch on major mode.
 
 ;; Two parts:
@@ -1430,19 +1401,13 @@ Used internally for the (major-mode MODE) context specializers."
 (defun cl--generic-oclosure-tag (name &rest _)
   `(oclosure-type ,name))
 
-(defun cl-generic--oclosure-specializers (tag &rest _)
-  (and (symbolp tag)
-       (let ((class (cl--find-class tag)))
-         (when (cl-typep class 'oclosure--class)
-           (oclosure--class-allparents class)))))
-
 (cl-generic-define-generalizer cl--generic-oclosure-generalizer
   ;; Give slightly higher priority than the struct specializer, so that
   ;; for a generic function with methods dispatching structs and on OClosures,
   ;; we first try `oclosure-type' before `type-of' since `type-of' will return
   ;; non-nil for an OClosure as well.
   51 #'cl--generic-oclosure-tag
-  #'cl-generic--oclosure-specializers)
+  #'cl--generic-type-specializers)
 
 (cl-defmethod cl-generic-generalizers :extra "oclosure-struct" (type)
   "Support for dispatch on types defined by `oclosure-define'."