Subject: Re: bug#77725: 31.0.50; Add support for types accepted by `cl-typep' to cl-generic?

From: David Ponce <[email-masked]>
Date: Thu, 17 Apr 2025 14:30:07 +0200

[...]
> 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.

Good to know :-)

>> (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.

Done.

>> (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 tried to do that, but I am not sure I well understood your point.
Please let me know if the code is what you expect.

> 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).

Done.

>> (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.

Done.  As it is now internal, I used a macro to reduce function calls
in cl-types-of (see your point below about making `cl-types-of`
returns directly the complete list of types+allparents).

> 
>> (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.

Done.

>> (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`?

Make sense.  I used parents.

> 
>>                       (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.

Good catch. Fixed.

>>              (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.

I removed testing if parents is a list, this is always true.
The other test prevents to define a type whose parent is itself.

>>            ;; 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`).

I switched to `cl--find-class' everywhere for consistency.

>>            ;; 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?

Not sure to understand this point.  name needs to be in cl--type-list
before to call merge-ordered-lists on the DAG.

> 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).

Signal an error if arglist and parents are both non-nil.

>>            ;; 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.

Done.

>>            ;; 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.

OMG! You are right. I fixed that.

>> (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.

I thought it could be useful, for example to cleanup the environment
when you kind of uninstall a library which defined types.  Maybe it
could help during tests?

>> ;; 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.

Good point.  But you lost me regarding possible optimizations :-(
I returned to the previous version that check all types.

>> (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.

Good idea.  I did that, which seems to work well :-)

>> ;;; Some tests
[...]
> 
> 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).

Do you have any examples in mind?

Thank you for your help.

David