1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00

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`.
This commit is contained in:
Stefan Monnier 2024-03-08 01:48:59 -05:00
parent 945af4d9d1
commit bd017175d4
4 changed files with 49 additions and 154 deletions

View file

@ -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'."