From 004f2493a542dd0b804a30e97fc612884ca440f4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 26 Mar 2024 13:14:15 -0400 Subject: cl-preloaded.el: Fix the type lattice We generally want types to form not just a DAG but a lattice. If objects can be both `keyword` and `symbol-with-pos`, this means there should be a more precise type describing this intersection. If we ever find the need for such a refinement, we could add such a `keyword-with-pos` type, but here I took the simpler route of treating `keyword` not as a proper built-in type but as a second-class type like `natnum`. While fixing this problem, also fix the problem we had where `functionp` was not quite adequate to characterize objects of type `function`, by introducing a new predicate `cl-functionp` for that. * lisp/emacs-lisp/cl-preloaded.el (cl-functionp): New function. (function): Use it. (keyword): Don't declare it as a built-in type. (user-ptrp): Remove redundant declaration. * lisp/emacs-lisp/cl-generic.el (cl--generic--unreachable-types): Delete constant. (cl-generic-generalizers): Remove corresponding test. * lisp/emacs-lisp/cl-macs.el (cl-deftype-satisfies): Add entry for `keyword` type. * lisp/emacs-lisp/comp.el (comp-known-predicates): Fix type for negative result of `characterp`. Remove duplicate `numberp` entry. Fix types for `keywordp` now that `keyword` is not a built-in type any more. * test/src/data-tests.el (data-tests--cl-type-of): Add a few cases. Remove workaround for `function`. --- lisp/emacs-lisp/cl-generic.el | 11 ++--------- 1 file changed, 2 insertions(+), 9 deletions(-) (limited to 'lisp/emacs-lisp/cl-generic.el') diff --git a/lisp/emacs-lisp/cl-generic.el b/lisp/emacs-lisp/cl-generic.el index 62abe8d1589..8bda857afdd 100644 --- a/lisp/emacs-lisp/cl-generic.el +++ b/lisp/emacs-lisp/cl-generic.el @@ -1332,11 +1332,6 @@ These match if the argument is `eql' to VAL." ;;; Dispatch on "normal types". -(defconst cl--generic--unreachable-types - ;; FIXME: Try to make that list empty? - '(keyword) - "Built-in classes on which we cannot dispatch for technical reasons.") - (defun cl--generic-type-specializers (tag &rest _) (and (symbolp tag) (let ((class (cl--find-class tag))) @@ -1350,14 +1345,12 @@ These match if the argument is `eql' to VAL." (cl-defmethod cl-generic-generalizers :extra "typeof" (type) "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', ... + ;; FIXME: Add support for other "types" accepted by `cl-typep' such + ;; as `character', `face', `keyword', ...? (or (and (symbolp type) (not (eq type t)) ;; Handled by the `t-generalizer'. (let ((class (cl--find-class type))) - (when (memq type cl--generic--unreachable-types) - (error "Dispatch on %S is currently not supported" type)) (memq (type-of class) '(built-in-class cl-structure-class eieio--class))) (list cl--generic-typeof-generalizer)) -- cgit v1.2.3