1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-15 10:30:25 -08:00

(cl-deftype): Don't set cl-deftype-handler directly

In order to make it easier to change that in the future, let
`cl--define-derived-type` take care of storing the derived
type's function into `cl-deftype-handler`.

* lisp/emacs-lisp/cl-preloaded.el (cl--define-derived-type):
Change calling convention.  Set `cl-deftype-handler`.
* lisp/emacs-lisp/cl-macs.el (cl-deftype): Don't set `cl-deftype-handler`,
instead pass the function to `cl--define-derived-type`.
This commit is contained in:
Stefan Monnier 2025-05-07 13:54:47 -04:00
parent d7459da58d
commit 9f50fdf1e7
2 changed files with 12 additions and 14 deletions

View file

@ -3803,9 +3803,6 @@ If PARENTS is non-nil, ARGLIST must be nil."
(declare (debug cl-defmacro) (doc-string 3) (indent 2))
(pcase-let*
((`(,decls . ,forms) (macroexp-parse-body body))
(docstring (if (stringp (car decls))
(car decls)
(cadr (assq :documentation decls))))
(declares (assq 'declare decls))
(parent-decl (assq 'parents (cdr declares)))
(parents (cdr parent-decl)))
@ -3817,12 +3814,10 @@ If PARENTS is non-nil, ARGLIST must be nil."
(and parents arglist
(error "Parents specified, but arglist not empty"))
`(eval-and-compile
(cl--define-derived-type ',name ',parents ',arglist ,docstring)
(define-symbol-prop ',name 'cl-deftype-handler
(cl-function
(lambda (&cl-defs ('*) ,@arglist)
,@decls
,@forms))))))
(cl--define-derived-type
',name
(cl-function (lambda (&cl-defs ('*) ,@arglist) ,@decls ,@forms))
',parents))))
(static-if (not (fboundp 'cl--define-derived-type))
nil ;; Can't define it yet!

View file

@ -491,10 +491,11 @@ The fields are used as follows:
(:copier nil))
"Type descriptors for derived types, i.e. defined by `cl-deftype'.")
(defun cl--define-derived-type (name parents arglist &optional docstring)
(defun cl--define-derived-type (name expander &optional parents)
"Register derived type with NAME for method dispatching.
PARENTS is a list of types NAME is a subtype of, or nil.
DOCSTRING is an optional documentation string."
EXPANDER is the function that computes the type specifier from
the arguments passed to the derived type.
PARENTS is a list of types NAME is a subtype of, or nil."
(let* ((class (cl--find-class name)))
(when class
(or (cl-derived-type-class-p class)
@ -505,7 +506,9 @@ DOCSTRING is an optional documentation string."
(error "Type in another class: %S" (type-of class))))
;; Setup a type descriptor for NAME.
(setf (cl--find-class name)
(cl--derived-type-class-make name docstring parents))
(cl--derived-type-class-make name (function-documentation expander)
parents))
(define-symbol-prop name 'cl-deftype-handler expander)
;; 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
@ -527,7 +530,7 @@ DOCSTRING is an optional documentation string."
(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 (memq (car arglist) '(nil &rest &optional &keys)))
(not (ignore-errors (funcall expander)))
(push name cl--derived-type-list))))
;; Make sure functions defined with cl-defsubst can be inlined even in