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

From: David Ponce <[email-masked]>
Date: Tue, 15 Apr 2025 11:30:58 +0200

On 2025-04-14 20:27, Stefan Monnier wrote:
>> I understand more how cl-generic works, and I reworked gtype.el
>> (attached) according to your inputs and my better understanding.
> 
> Looks good, thanks.

Thank you for your review!  My answers below.

>> (eval-when-compile (require 'cl-macs))  ;For cl--find-class.
> 
> You can also use `cl-find-class` which doesn't require this gymnastics.

Done.  I didn't know about this public version of `cl--find-class'.
However, as it seems not possible to write:

`(setf (cl-find-class object) value)'

I had to use `put' instead in one place in `gtype--register'.

>> (define-inline gtype-p (object)
>>    "Return non-nil if the type of OBJECT is a gtype."
>>    (inline-letevals (object)
>>      (inline-quote
>>       (and (symbolp ,object)
>>            (eq (type-of (cl--find-class ,object)) 'gtype-class)))))
> 
> I hope this function is not speed-critical (and so can be a plain `defun`).
> 
>> (define-inline gtype-parents (name)
>>    "Get parents of type with NAME.
>> NAME is a symbol representing a type.
>> Return a possibly empty list of types."
>>    (inline-quote
>>     (cl--class-allparents (cl--find-class ,name))))
> 
> Same here.

Done.  I didn't notice any significant impact on performance :-)

>> (defun gtype--topologic-sort (graph &optional tie-breaker)
> 
> How is this different from `merge-ordered-lists`?

The result of the two functions are slightly different but seems
consistent, so I switched to `merge-ordered-lists'.

>> ;;;###autoload
>> (defmacro defgtype (name &optional parents &rest args)
>>    "Define NAME as a gtype that inherits from PARENTS.
> 
> Inheritance != subtyping.  Better stick to the term "subtype" here since
> there doesn't seem to be any inheritance going on here.

Done.

> I get the impression that the role/impact of PARENTS is not explained
> clearly enough.  The explanation should be clear enough that the reader
> can infer more or less what could happen if a parent is missing or if
> a non-parent is incorrectly listed as a parent.

This is a very good point.  Currently, the role of PARENTS is limited
to specify in which order gtype `gtype-of' will check gtypes.

This order is not automatically transposed to the type specifier of
`cl-deftype'.  And there is a risk of inconsistency here.

For instance, you can do something like this:

(defgtype a-fixnum nil ()
   'fixnum)

(gtype-of 10)
(a-fixnum fixnum)

(defgtype a-fixnum-between-1-10 a-fixnum ()
   `(satisfies ,(lambda (x) (and (numberp x) (> x 0) (< x 11)))))

(gtype-of 10.1)
(a-fixnum-between-1-10 float)
gtype--list
(a-fixnum-between-1-10 a-fixnum)

Clearly 10.1 is not "a-fixnum-between-1-10", because the type
specifier is incorrect; even if `a-fixnum-between-1-10' is a subtype
of `a-fixnum'.

The correct subtype could be:

(defgtype a-fixnum-between-1-10 a-fixnum ()
   `(and a-fixnum (satisfies ,(lambda (x) (> x 0) (< x 11)))))

But the type specifier is not produced automatically.

Not so easy to put all this in a docstring.  Any idea?

>>    (declare (debug cl-defmacro) (doc-string 4) (indent 3))
>>    (cl-with-gensyms (err)
>>      `(condition-case ,err
>>           (progn
>>             (cl-deftype ,name ,@args)
>>             (gtype--register ',name ',parents ',args))
>>         (error
>>          (gtype--unregister ',name)
>>          (error (error-message-string ,err))))))
> 
> Could we merge this into `cl-deftype`?

That would be great.  But I need some help here to correctly dispatch
all functions in gtype to Emacs libraries: cl-macs, cl-generic ?  May
be in this case, gtype should be moved to the cl namespace too.

Or do you envision something different?

>> (defmacro remgtype (name)
> 
> Try and stay within the namespace prefix.

Renamed to `gtype-remove'.

>> (defun gtype-of (object)
>>    "Return the most specific possible gtype OBJECT belongs to.
>> Return an unique list of types OBJECT belongs to, ordered from the
>> most specific type to the most general."
>>    ;; Ignore recursive call on the same OBJECT, which can legitimately
>>    ;; occur when, for example, a parent type is investigating whether
>>    ;; an object's type is that of one of its children.
>>    (unless (eq object gtype--object)
>>      (let ((gtype--object object)
>>            (found (list (cl-type-of object))))
>>        ;; Collect all gtypes OBJECT belongs to.
>>        (dolist (gtype gtype--list)
>>          (if (cl-typep object gtype)
>>              (push gtype found)))
>>        ;; Return an unique value of type.
>>        (with-memoization (gethash found gtype--unique)
>>          found))))
> 
> Since `gtype-of` is the function used to get the "tagcode" used for
> method-dispatch, it is speed-critical.

I agree.

> But the above looks rather costly.  🙁

emacs -Q on my laptop:

   Processors: 8 × Intel® Core™ i7-7700HQ CPU @ 2.80GHz
   Memory: 15,5 GiB of RAM

consistently takes around 1 millisecond to check 2000 gtypes, which
seems not so bad.

Here is the benchmark I use:

(defgtype cons-car-foo nil ()
   "A cons with a `foo' car."
   `(satisfies ,(lambda (x) (eq (car-safe x) 'foo))))

(defgtype cons-cdr-foo nil ()
   "A cons with a `foo' cdr."
   `(satisfies ,(lambda (x) (eq (cdr-safe x) 'foo))))

(gtype-of '(foo . foo))
=> (cons-car-foo cons-cdr-foo cons)

;; Create a very long list of gtypes that gtype-of will check
;; sequentially.
(let* ((count 2000)
        (gtype--list (let ((list '(cons-cdr-foo)))
                      (dotimes (_ count)
                        (push 'cons-car-foo list))
                      list))
        (object '(foo . foo))
        (runs 1))
   (garbage-collect)
   (benchmark-run
    (gtype-of object)
    runs))

=>(0.00107773 0 0.0)

> I think we could reduce this problem significantly with reasonably
> simple changes to `cl-generic`: we could provide to the TAGCODE-FUNCTION
> the list of specializers used by methods of the current
> generic-function, so we'd only need to check those types which are
> actually useful for the current dispatch.
> [ Hmm... well, maybe not completely "simple" since it might have
>    some problematic impact on the `cl--generic-prefill-dispatchers`
>    mechanism, but that should be solvable.  ]

I am afraid, this looks beyond my knowledge of cl-generic.

>> (defun gtype--specializers (tag &rest _)
>>    "If TAG is a gtype, return its specializers."
>>    (and (consp tag) (gtype-p (car tag))
>>         (with-memoization (gethash tag gtype--specializers)
>>           (merge-ordered-lists (mapcar #'gtype-parents tag)))))
> 
> AFAIK this function is only ever called with "tagcodes" returned by your
> own TAGCODE-FUNCTION, so I think the `gtype-p` test is redundant.

Good find. Done.

Please find attached the last version.

David