mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2025-12-06 06:20:55 -08:00
Code Issues Projects Releases Wiki Activity

cl-types: The big renaming to "derived types"

Browse source 
`cl-defstruct` also defines a type and is also in CL, so
"cl-type" is not precise enough to talk about those types
defined with `cl-deftype`.  Use the term "derived type" to be
more clear, as is done in the HyperSpec.

* doc/misc/cl.texi (Derived types): Move `cl-deftype` to this
new subsection.  Document the use of derived types as method specializers.

* lisp/emacs-lisp/cl-extra.el (cl--types-of-memo): Rename from
`cl--type-unique`.
(cl--derived-type-dispatch-list): Rename from `cl--type-dispatch-list`.
(cl--derived-type-generalizer): Rename from `cl--type-generalizer`.
(cl--derived-type-generalizers): Rename from `cl--type-generalizers`.

* lisp/emacs-lisp/cl-lib.el (cl-generic-generalizers) <derived-types>:
Rename from <cl-types-of>.  Catch but don't hide errors when a derived
type cannot be used as an atomic type specifier.

* lisp/emacs-lisp/cl-preloaded.el (cl--derived-type-list): Rename from
`cl--type-list`.
(cl-derived-type-class): Rename from `cl-type-class`.
(cl--derived-type-class-make): Rename from `cl--type-class-make`.
(cl--define-derived-type): Rename from `cl--type-deftype`.
This commit is contained in:
Stefan Monnier 2025-05-07 13:24:07 -04:00
parent f6f35644b7
commit b13044dae3
5 changed files with 73 additions and 49 deletions
Download patch file Download diff file Expand all files Collapse all files

47
lisp/emacs-lisp/cl-extra.el
View file

@ -965,7 +965,7 @@ Outputs to the current buffer."
(insert (propertize "\nClass Allocated Slots:\n\n" 'face 'bold))
(mapc #'cl--describe-class-slot cslots))))
;;;; Method dispatch on `cl-deftype' types.
;;;; Method dispatch on `cl-deftype' types (a.k.a "derived types").
;; Extend `cl-deftype' to define data types which are also valid
;; argument types for dispatching generic function methods (see also
@ -978,8 +978,8 @@ Outputs to the current buffer."
;; - `cl-types-of', that returns the types an object belongs to.
;; Ensure each type satisfies `eql'.
(defvar cl--type-unique (make-hash-table :test 'equal)
"Record an unique value of each type.")
(defvar cl--types-of-memo (make-hash-table :test 'equal)
"Memoization table used in `cl-types-of'.")
;; FIXME: `cl-types-of' CPU cost is proportional to the number of types
;; defined with `cl-deftype', so the more popular it gets, the slower
@ -1007,9 +1007,12 @@ Outputs to the current buffer."
;; one of them (`cl-typep' itself being a recursive function that
;; basically interprets the type language). This is going to slow
;; down dispatch very significantly for those generic functions that
;; have a method that dispatches on a user defined type, compared to
;; have a method that dispatches on a derived type, compared to
;; those that don't.
;;
;; As a simple optimization, the method dispatch tests only those
;; derived types which have been used as a specialize in a method.
;;
;; A possible further improvement:
;;
;; - based on the PARENTS declaration, create a map from builtin-type
@ -1019,19 +1022,18 @@ Outputs to the current buffer."
;; associated with the `t' "dummy parent". [ We could even go crazy
;; and try and guess PARENTS when not provided, by analyzing the
;; type's definition. ]
;;
;; - in `cl-types-of' start by calling `cl-type-of', then use the map
;; to find which cl-types may need to be checked.
;;
;;;###autoload
(defun cl-types-of (object &optional types)
"Return the types OBJECT belongs to.
"Return the atomic types OBJECT belongs to.
Return an unique list of types OBJECT belongs to, ordered from the
most specific type to the most general.
TYPES is an internal argument."
(let* ((found nil))
;; Build a list of all types OBJECT belongs to.
(dolist (type (or types cl--type-list))
(dolist (type (or types cl--derived-type-list))
(and
;; If OBJECT is of type, add type to the matching list.
(if types
@ -1041,25 +1043,28 @@ TYPES is an internal argument."
(cl-typep object type)
(condition-case-unless-debug e
(cl-typep object type)
(error (setq cl--type-list (delq type cl--type-list))
(error (setq cl--derived-type-list (delq type cl--derived-type-list))
(warn "cl-types-of %S: %s"
type (error-message-string e))
nil)))
(push type found)))
(push (cl-type-of object) found)
;; Return an unique value of the list of types OBJECT belongs to,
;; which is also the list of specifiers for OBJECT.
(with-memoization (gethash found cl--type-unique)
;; Return the list of types OBJECT belongs to, which is also the list
;; of specifiers for OBJECT. This memoization has two purposes:
;; - Speed up computation.
;; - Make sure we always return the same (eq) object, so that the
;; method dispatch's own caching works as it should.
(with-memoization (gethash found cl--types-of-memo)
;; Compute an ordered list of types from the DAG.
(let (dag)
(dolist (type found)
(push (cl--class-allparents (cl--find-class type)) dag))
(merge-ordered-lists dag)))))
(defvar cl--type-dispatch-list nil
(defvar cl--derived-type-dispatch-list nil
"List of types that need to be checked during dispatch.")
(cl-generic-define-generalizer cl--type-generalizer
(cl-generic-define-generalizer cl--derived-type-generalizer
;; FIXME: This priority can't be always right. :-(
;; E.g. a method dispatching on a type like (or number function),
;; should take precedence over a method on `t' but not over a method
@ -1070,22 +1075,22 @@ TYPES is an internal argument."
;; suffer from "undefined method ordering" problems, unless/until we
;; restrict it somehow to a subset that we can handle reliably.
20 ;; "typeof" < "cl-types-of" < "head" priority
(lambda (obj &rest _) `(cl-types-of ,obj cl--type-dispatch-list))
(lambda (obj &rest _) `(cl-types-of ,obj cl--derived-type-dispatch-list))
(lambda (tag &rest _) (if (consp tag) tag)))
;;;###autoload
(defun cl--type-generalizers (type)
(defun cl--derived-type-generalizers (type)
;; Add a new dispatch type to the dispatch list, then
;; synchronize with `cl--type-list' so that both lists follow
;; synchronize with `cl--derived-type-list' so that both lists follow
;; the same type precedence order.
;; The `merge-ordered-lists' is `cl-types-of' should we make this
;; ordering unnecessary, but it's still handy for all those types
;; that don't declare their parents.
(unless (memq type cl--type-dispatch-list)
(setq cl--type-dispatch-list
(seq-intersection cl--type-list
(cons type cl--type-dispatch-list))))
(list cl--type-generalizer))
(unless (memq type cl--derived-type-dispatch-list)
(setq cl--derived-type-dispatch-list
(seq-intersection cl--derived-type-list
(cons type cl--derived-type-dispatch-list))))
(list cl--derived-type-generalizer))
;;;; Trailer

12
lisp/emacs-lisp/cl-lib.el
View file

@ -566,14 +566,14 @@ If ALIST is non-nil, the new pairs are prepended to it."
;; Also, there is no mechanism to autoload methods, so this can't be
;; moved to `cl-extra.el'.
nil
(declare-function cl--type-generalizers "cl-extra" (type))
(cl-defmethod cl-generic-generalizers :extra "cl-types-of" (type)
"Support for dispatch on cl-types."
(if (and (symbolp type) (cl-type-class-p (cl--find-class type))
(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 (ignore-errors (funcall expander)))))
(cl--type-generalizers type)
(and expander (with-demoted-errors "%S" (funcall expander)))))
(cl--derived-type-generalizers type)
(cl-call-next-method))))
(defun cl--old-struct-type-of (orig-fun object)

13
lisp/emacs-lisp/cl-macs.el
View file

@ -3785,7 +3785,7 @@ macro that returns its `&whole' argument."
;;;###autoload
(defmacro cl-deftype (name arglist &rest body)
"Define NAME as a new data type.
"Define NAME as a new, so-called derived type.
The type NAME can then be used in `cl-typecase', `cl-check-type',
etc., and to some extent, as method specializer.
@ -3816,20 +3816,15 @@ If PARENTS is non-nil, ARGLIST must be nil."
(cl-callf (lambda (x) (delq declares x)) decls)))
(and parents arglist
(error "Parents specified, but arglist not empty"))
`(eval-and-compile ;;cl-eval-when (compile load eval)
;; FIXME: Where should `cl--type-deftype' go? Currently, code
;; using `cl-deftype' can use (eval-when-compile (require
;; 'cl-lib)), so `cl--type-deftype' needs to go either to
;; `cl-preloaded.el' or it should be autoloaded even when
;; `cl-lib' is not loaded.
(cl--type-deftype ',name ',parents ',arglist ,docstring)
`(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))))))
(static-if (not (fboundp 'cl--type-deftype))
(static-if (not (fboundp 'cl--define-derived-type))
nil ;; Can't define it yet!
(cl-deftype extended-char () '(and character (not base-char))))

22
lisp/emacs-lisp/cl-preloaded.el
View file

@ -467,18 +467,18 @@ The fields are used as follows:
;;;; Support for `cl-deftype'.
(defvar cl--type-list nil
(defvar cl--derived-type-list nil
"Precedence list of the defined cl-types.")
;; FIXME: The `cl-deftype-handler' property should arguably be turned
;; into a field of this struct (but it has performance and
;; compatibility implications, so let's not make that change for now).
(cl-defstruct
(cl-type-class
(cl-derived-type-class
(:include cl--class)
(:noinline t)
(:constructor nil)
(:constructor cl--type-class-make
(:constructor cl--derived-type-class-make
(name
docstring
parent-types
@ -489,15 +489,15 @@ The fields are used as follows:
(error "Unknown type: %S" type)))
parent-types))))
(:copier nil))
"Type descriptors for types defined by `cl-deftype'.")
"Type descriptors for derived types, i.e. defined by `cl-deftype'.")
(defun cl--type-deftype (name parents arglist &optional docstring)
"Register cl-type with NAME for method dispatching.
(defun cl--define-derived-type (name parents arglist &optional docstring)
"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."
(let* ((class (cl--find-class name)))
(when class
(or (cl-type-class-p class)
(or (cl-derived-type-class-p class)
;; FIXME: We have some uses `cl-deftype' in Emacs that
;; "complement" another declaration of the same type,
;; so maybe we should turn this into a warning (and
@ -505,11 +505,11 @@ 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--type-class-make name docstring parents))
(cl--derived-type-class-make name docstring parents))
;; 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--type-list' for types defined with `cl-deftype').
;; 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
@ -524,11 +524,11 @@ DOCSTRING is an optional documentation string."
;; `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--type-list)
(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)))
(push name cl--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