From: Stefan Monnier Date: Thu, 8 May 2025 21:11:05 +0000 (-0400) Subject: cl-types: Improve error messages X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=f9611553e4b8c608c2e7ed7f3e61ab578a024e36;p=emacs.git cl-types: Improve error messages * lisp/emacs-lisp/cl-extra.el (cl--derived-type-generalizers): Check that the type is valid and fully defined. * lisp/emacs-lisp/cl-lib.el (cl-generic-generalizers) : Don't delegate to another method just because the type is invalid. * lisp/emacs-lisp/cl-preloaded.el (cl--define-derived-type): Minor simplification, and improvement to an error message. (cherry picked from commit ceba490da921399393200e704520d313eb1ac5c8) --- diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 5569ec3d752..de7caab6b29 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -1084,6 +1084,15 @@ TYPES is an internal argument." ;;;###autoload (defun cl--derived-type-generalizers (type) + ;; Make sure this derived type can be used without arguments. + (let ((expander (or (get type 'cl-deftype-handler) + (error "Type %S lacks cl-deftype-handler" type)))) + ;; Check that the type can be used without arguments. + (funcall expander) + ;; Check that we have a precomputed predicate since that's what + ;; `cl-types-of' uses. + (unless (get type 'cl-deftype-satisfies) + (error "Type %S lacks cl-deftype-satisfies" type))) ;; Add a new dispatch type to the dispatch list, then ;; synchronize with `cl--derived-type-list' so that both lists follow ;; the same type precedence order. diff --git a/lisp/emacs-lisp/cl-lib.el b/lisp/emacs-lisp/cl-lib.el index 745bdcfeeac..8bad4fa74e6 100644 --- a/lisp/emacs-lisp/cl-lib.el +++ b/lisp/emacs-lisp/cl-lib.el @@ -560,10 +560,7 @@ If ALIST is non-nil, the new pairs are prepended to it." (declare-function cl--derived-type-generalizers "cl-extra" (type)) (cl-defmethod cl-generic-generalizers :extra "derived-types" (type) "Support for dispatch on derived types, i.e. defined with `cl-deftype'." - (if (and (symbolp type) (cl-derived-type-class-p (cl--find-class type)) - ;; Make sure this derived type can be used without arguments. - (let ((expander (get type 'cl-deftype-handler))) - (and expander (with-demoted-errors "%S" (funcall expander))))) + (if (and (symbolp type) (cl-derived-type-class-p (cl--find-class type))) (cl--derived-type-generalizers type) (cl-call-next-method)))) diff --git a/lisp/emacs-lisp/cl-preloaded.el b/lisp/emacs-lisp/cl-preloaded.el index e4b467ceb24..d6962ba1dee 100644 --- a/lisp/emacs-lisp/cl-preloaded.el +++ b/lisp/emacs-lisp/cl-preloaded.el @@ -505,37 +505,26 @@ PARENTS is a list of types NAME is a subtype of, or nil." ;; "complement" another declaration of the same type, ;; so maybe we should turn this into a warning (and ;; not overwrite the `cl--find-class' in that case)? - (error "Type in another class: %S" (type-of class)))) + (error "Type %S already in another class: %S" name (type-of class)))) ;; Setup a type descriptor for NAME. (setf (cl--find-class name) (cl--derived-type-class-make name (function-documentation expander) parents)) (define-symbol-prop name 'cl-deftype-handler expander) (when predicate - (define-symbol-prop name 'cl-deftype-satisfies predicate)) - ;; Record new type. The constructor of the class - ;; `cl-type-class' already ensures that parent types must be - ;; defined before their "child" types (i.e. already added to - ;; the `cl--derived-type-list' for types defined with `cl-deftype'). - ;; So it is enough to simply push a new type at the beginning - ;; of the list. - ;; Redefinition is more complicated, because child types may - ;; be in the list, so moving the type to the head can be - ;; incorrect. The "cheap" solution is to leave the list - ;; unchanged (and hope the redefinition doesn't change the - ;; hierarchy too much). - ;; Side note: Redefinitions introduce other problems as well - ;; because the class object's `parents` slot contains - ;; references to `cl--class` objects, so after a redefinition - ;; via (setf (cl--find-class FOO) ...), the children's - ;; `parents` slots point to the old class object. That's a - ;; problem that affects all types and that we don't really try - ;; to solve currently. - (or (memq name cl--derived-type-list) - ;; Exclude types that can't be used without arguments. - ;; They'd signal errors in `cl-types-of'! - (not predicate) - (push name cl--derived-type-list)))) + (define-symbol-prop name 'cl-deftype-satisfies predicate) + ;; If the type can be used without arguments, record it for + ;; use by `cl-types-of'. + ;; The order in `cl--derived-type-list' is important, but the + ;; constructor of the class `cl-type-class' already ensures that + ;; parent types must be defined before their "child" types + ;; (i.e. already added to the `cl--derived-type-list' for types + ;; defined with `cl-deftype'). So it is enough to simply push + ;; a new type at the beginning of the list. + ;; Redefinition is a can of worms anyway, so we don't try to be clever + ;; in that case. + (or (memq name cl--derived-type-list) + (push name cl--derived-type-list))))) ;; Make sure functions defined with cl-defsubst can be inlined even in ;; packages which do not require CL. We don't put an autoload cookie