Package: emacs;
Reported by: David Ponce <da_vid <at> orange.fr>
Date: Fri, 11 Apr 2025 07:16:01 UTC
Severity: normal
Found in version 31.0.50
View this message in rfc822 format
From: Stefan Monnier <monnier <at> iro.umontreal.ca> To: David Ponce <da_vid <at> orange.fr> Cc: 77725 <at> debbugs.gnu.org, Eli Zaretskii <eliz <at> gnu.org> Subject: bug#77725: 31.0.50; Add support for types accepted by `cl-typep' to cl-generic? Date: Wed, 16 Apr 2025 15:56:30 -0400
> Please find attached a first attempt at a cl-types.el to be merged in
> cl-lib. Please feel free to propose new names if mine are not good.
>
> For now, the new `cl-deftype' is named `cl-deftype2' for testing
> without impacting the existing environment.
👍🏾
> so I used the name `cl-types-of' which also better represent that this
> function returns a list of types.
+1
> WDYT?
See comments below.
> The proposed "cl-types-of" generalizer must have a higher priority than
> "typof" to correctly takes precedence over built-in types.
That's right.
> But, what about the defstruct and defclass types? Shouldn't such types
> have higher priority than cl-deftype and builtin types?
Actually, since Emacs-26 `(cl-)type-of` returns the proper struct type
for both defstruct and defclass types, so they both use the
`cl--generic-typeof-generalizer`.
[ That's still not the case for OClosures, sadly. ]
> I wouldn't want "cl-types-of" to have too much of a performance impact on
> method dispatch for defstruct and defclass types, unless it's really
> necessary.
The cost is doesn't depend on priority, it depends only on which
generalizers are used for which generic-functions: a generic function
whose methods don't use cl-types will not be affected at all. A generic
function which does have at least one method dispatching on a cl-type
will be affected, even if you never call it with an object of such cl-type.
> (defun cl-type-p (object)
> "Return non-nil if OBJECT is a used defined type.
> That is, a type of class `cl-type-class'."
> (and (symbolp object)
> (eq (type-of (cl-find-class object)) 'cl-type-class)))
Hmm... yeah... names...
Then again, I don't think we have an equivalent function to test if
a type is a bultin type or a struct type or a defclass type or an
OClosure type, so let's push this to the "cl--" namespace.
> (cl-defstruct
> (cl-type-class
> (:include cl--class)
> (:noinline t)
> (:constructor nil)
> (:constructor cl--type-class-make
> (name
> docstring
> parent-types
> &aux (parents
> (mapcar
> (lambda (type)
> (cl-check-type type (satisfies cl-type-p))
> (cl-find-class type))
> parent-types))))
> (:copier nil))
> "Type descriptors for user defined types.")
I'm thinking it might be useful to accept builtin types as parents.
E.g. we could make `cl-types-p` skip testing those cl-types whose parents
are incompatible with the output of `cl-type-p`.
I'd add a FIXME in there noting that 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).
> (defun cl-type-parents (name)
> "Get parents of type with NAME.
> NAME is a symbol representing a type."
> (cl--class-allparents (cl-find-class name)))
Let's push this to "cl--" as well.
> (defun cl-type-children (name)
> "Get children of the type with NAME.
> NAME is a symbol representing a type.
> Return a possibly empty list of types."
> (cl-check-type name (satisfies cl-type-p))
> (let (children)
> (dolist (elt cl--type-list)
> (or (eq name elt)
> (if (memq name (cl-type-parents elt))
> (push elt children))))
> children))
Same.
> (defun cl--type-generalize (name arglist body)
> "Generalize type with NAME for method dispatching.
> ARGLIST and BODY are passed to `cl-deftype'."
> (let ((oldtlist (copy-sequence cl--type-list))
> (oldplist (copy-sequence (symbol-plist name))))
> (condition-case err
> (pcase-let* ((`(,decls . ,body) (macroexp-parse-body body))
> (docstring (if (stringp (car decls))
> (pop decls)
> (cdr (assq :documentation decls))))
> (decls (cdr (assq 'declare decls)))
> (parents (cdr (assq 'subtype-of decls)))
Since we use the word "parents" everywhere, maybe we should look for
`parents` rather than `subtype-of`?
> (class (cl-find-class name))
> (reged (memq name cl--type-list)))
> (if (null class)
> (or (null reged)
> (error "Type generalized, but doesn't exist"))
> (or reged "Type exists, but not generalized")
I think there's an `error` missing here or something.
> (or (eq (type-of class) 'cl-type-class)
> (error "Type in another class: %S" (type-of class))))
> (or (listp parents) (setq parents (list parents)))
> (if (memq name parents)
> (error "Type in parents: %S" parents))
Not sure how useful is this test.
> ;; Setup a type descriptor for NAME. Can't use `setf' with
> ;; `cl-find-class', so fallback to plain `put' to set the
> ;; `cl--class' symbol property.
> (put name 'cl--class
> (cl--type-class-make name docstring parents))
Better use `setf` (with `cl--find-class`).
> ;; Clear cached value of specializers with NAME.
> (if class
> (cl--type-reset-specializers name)
> ;; Record new type.
> (push name cl--type-list))
Shouldn't we test `reged` before `push`ing?
Also, I think we should skip those types whose arglist is not empty
(and probably signal an error if `subtype-of` is specified at the same
time as a non-empty arglist).
> ;; Keep most specific types before more general types.
> (setq cl--type-list (merge-ordered-lists
> (cl--type-dag)
> (lambda (g)
> (error "Invalid DAG, %S" g))))
Why do we need sorting? Ah, it's so as to avoid sorting in
`cl-types-of`? Maybe clarify it in the comment, then.
> ;; Return the form to declare the type.
> `(cl-eval-when (compile load eval)
> (define-symbol-prop ',name 'cl-deftype-handler
> (cl-function
> (lambda (&cl-defs ('*) ,@arglist)
> ,docstring
> ,@body)))))
Hmm... wait, so all the code before is executed only during
macro-expansion and not at run-time? That doesn't sound right.
> (defmacro cl-type-undefine (name)
> "Remove the definitions of type with NAME.
> NAME is an unquoted symbol representing a type.
> Signal an error if other types inherit from NAME."
> `(progn
> (cl-check-type ',name (satisfies cl-type-p))
> (cl--type-undefine ',name)))
We don't have that for other types. I understand it's somewhat
dangerous for the other types and not for this one, but I still wonder
if we need it.
> ;; Assuming that `cl--type-list' is properly sorted from most specific
> ;; types to least specific ones, which should be guaranteed by
> ;; `merge-ordered-list' in `cl--type-generalize' this verions of
> ;; `cl-types-of' tries sequentially each type in `cl--type-list', but
> ;; stops on the first type that matches and returns the parents of the
> ;; type plus the builtin type of OBJECT. If no type is found, return
> ;; nil to fallback to the "typeof" generalizer.
That doesn't sound right: it works only if there are no types which are
overlapping and "incomparable" (like `cons-car-foo` and `cons-cdr-foo`).
We may be able to use the `subtype-of` info to skip some types (e.g. we
don't need to test the parents, or if we traverse the list in the other
direction, we don't need to test FOO if we already saw that the object
failed the test for one of FOO's parents), but in general we'll have to
check them all: we definitely can't stop at the first successful check.
Stefan
> (defvar cl--type-specializers (make-hash-table :test 'eq)
> "Memoize type specializers.
> Values are refreshed following the definition or removal of types.")
>
> (defun cl--type-reset-specializers (name)
> "Remove all cached value of specializers related to type with NAME."
> (maphash (lambda (key _)
> (if (memq name key)
> (remhash key cl--type-specializers)))
> cl--type-specializers))
BTW, you can also make `cl-types-of` return directly the complete list
of types+allparents, i.e. the ordered list of specializers. And then
your `cl--type-specializers` function could turn into the identity.
> ;;; Some tests
> ;;
> '(progn
> (cl-deftype2 unsigned-byte (&optional bits)
> "Unsigned integer."
> `(integer 0 ,(if (eq bits '*) bits (1- (ash 1 bits)))))
>
> (cl-deftype2 unsigned-16bits ()
> "Unsigned 16-bits integer."
> (declare (subtype-of unsigned-byte))
> '(unsigned-byte 16))
>
> (cl-deftype2 unsigned-8bits ()
> "Unsigned 8-bits integer."
> (declare (subtype-of unsigned-16bits))
> '(unsigned-byte 8))
I suggest to define something like `multiples-of-2`, `multiples-of-3`,
and `multiples-of-4`, so as to test more complex relationships between
types (with overlap but not inclusion).
Stefan
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.