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:
parent
d7459da58d
commit
9f50fdf1e7
2 changed files with 12 additions and 14 deletions
|
|
@ -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!
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue