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

From: David Ponce <[email-masked]>
Date: Wed, 7 May 2025 12:35:59 +0200

On 2025-05-07 04:51, Stefan Monnier wrote:
[...]
>> I guess a general solution is much more complex than what I thought.
>> And maybe risk to be more costly than the current implementation
>> without set of cl-types.
> 
> There's probably some way to do better than the naïve loop we have now,
> but ... we can keep that for later.

OK.  I wonder if a intermediate acceptable solution could be to manually
map builtin types returned by `type-of' to a symbol that identifies an
unique set of cl-types?  But, as you say we can keep that for later ;-)

>> Please find attached a patch proposal for the branch.  Mainly to
>> ensure that types not suitable for cl-defmethod (erroneous type or
>> type with arguments) will signal an "Unknown specializer" error when
>> trying to use them as argument type in cl-defmethod.
> 
> Good point.  But see below.
> 
>>            (condition-case-unless-debug e
>>                (cl-typep object type)
>> -           (error (setq cl--type-list (delq type cl--type-list))
>> -                  (warn  "cl-types-of %S: %s"
>> -                         type (error-message-string e)))))
>> +           (error
>> +            ;; Temporarily raise the recursion limit to avoid
>> +            ;; another recursion error while processing error.
>> +            (let ((max-lisp-eval-depth (+ 800 max-lisp-eval-depth)))
> 
> We almost never do that in ELisp except in very specific circumstances
> where we decide it's really worth the trouble (even in though in theory
> it could be necessary in pretty much all error handlers).
> Is there a reason why it's more necessary here than usual?
> Maybe a simpler fix is to replace `warn` with `message`?

Yes, `message' will definitely work better, but errors will be less
highlighted.  But a message is always better than nothing ;-)

I wouldn't want ill-defined types entering infinite recursion to
break error handling, just because the depth limit is reached,
thus preventing `warn' to be called.  And no error handling in
`cl-types-of' is not an option IMHO, because Emacs risks to become
unusable if methods based on cl-types, used for example in a display
context, crash.  In fact, I don't like the idea of ​​well-defined
things being disrupted by ill-defined ones ;-)

> 
>> +              ;; Remove the type in error from valid specializers.
>> +              (cl-remprop type 'cl--class)
> 
> I think that's rather drastic.  Just because it signals errors in
> `cl-types-of` doesn't mean it can't be useful in other places.
> 
>> +              (setq cl--type-dispatch-list (delq type cl--type-dispatch-list))
> 
> Why do we need this?  The `(if types` test above presumes that we're OK
> with the assumption that we don't need to catch/silence errors for types
> in `cl--type-dispatch-list`.

I just wanted to keep both lists consistent. If a type is no longer in
the main list, it shouldn't be in the dispatch list either.  But maybe
your last change to `cl-generic-generalizers` is enough?

> 
>> --- a/lisp/emacs-lisp/cl-macs.el
>> +++ b/lisp/emacs-lisp/cl-macs.el
>> @@ -3816,18 +3816,22 @@ cl-deftype
>>           (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)
>> -       (define-symbol-prop ',name 'cl-deftype-handler
>> -                           (cl-function
>> -                            (lambda (&cl-defs ('*) ,@arglist)
>> -                              ,@decls
>> -                              ,@forms))))))
>> +    ;; Don't register types that can't be used without arguments for
>> +    ;; dispatch.  They'd signal errors in `cl-types-of'!
>> +    (let ((noarg (memq (car arglist) '(nil &rest &optional &keys))))
>> +      ;;(or noarg (message "Can't dispatch type with argument, `%S'" name))
>> +      `(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.
>> +         ,@(if noarg `((cl--type-deftype ',name ',parents ,docstring)))
>> +         (define-symbol-prop ',name 'cl-deftype-handler
>> +                             (cl-function
>> +                              (lambda (&cl-defs ('*) ,@arglist)
>> +                                ,@decls
>> +                                ,@forms)))))))
> 
> I intend to use the `cl--type-class` struct in `cl--class` for purposes
> like browsing types (via `C-h o`) like we can do already for structs and
> built-in types, so we should register the types with `cl--type-deftype`
> regardless if they can be used for dispatch.
> 
> So I installed an alternative solution to this problem in
> `cl-generic-generalizers`, we call the `cl-type-handler` to make sure
> it's valid to use the type without arguments.

I didn't know that.  Fine for me.

While testing, I discovered two nasty bugs in `cl-types-of' illustrated
by the following recipe:

(cl-deftype T1 ()
   "Ill-defined type."
   '(satisfies unknown-predicate))

(cl-types-of 12)
Raise this warning as expected:
Warning (emacs): cl-types-of T1: Symbol’s function definition is void: unknown-predicate

But returns this incorrect list of types:
=> (T1 kmacro-register frame-register fixnum integer number integer-or-marker number-or-marker atom t)

(cl-defmethod test-T1 ((obj T1))
   (format "test-T1 %S" obj))
Should signal an "unknown specializer" for T1, but do not.

Even worse:
(test-T1 nil) => No applicable method, as expected
(test-T1 12)  => "test-T1 12" which is plain wrong

This because always return a wrong cached value from `cl--type-unique':
(cl-types-of 12)
=> (T1 kmacro-register frame-register fixnum integer number integer-or-marker number-or-marker atom t)

The first problem is that the error handler didn't return nil, so
the type in error is pushed in `found'.

The second problem is a nasty side effect of `nreverse' which
causes a wrong key pushed in the `gtype--unique' hash table.

The attached patch solved both issues for me.  To compute the DAG,
I preferred to use a `dolist' loop rather than a `mapcar'+`reverse'
combination, to avoid going through the list twice.

David
diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index bd7bb96dd6a..f232f06718e 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -1035,24 +1035,26 @@ cl-types-of
       (and
        ;; If OBJECT is of type, add type to the matching list.
        (if types
-           ;; For method dispatch, we don't need to filter out errors, since
-           ;; we can presume that method dispatch is used only on
+           ;; For method dispatch, we don't need to filter out errors,
+           ;; since we can presume that method dispatch is used only on
            ;; sanely-defined types.
            (cl-typep object type)
          (condition-case-unless-debug e
              (cl-typep object type)
            (error (setq cl--type-list (delq type cl--type-list))
                   (warn  "cl-types-of %S: %s"
-                         type (error-message-string e)))))
+                         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)
       ;; Compute an ordered list of types from the DAG.
-      (merge-ordered-lists
-       (mapcar (lambda (type) (cl--class-allparents (cl--find-class type)))
-               (nreverse found))))))
+      (let (dag)
+        (dolist (type found)
+          (push (cl--class-allparents (cl--find-class type)) dag))
+        (merge-ordered-lists dag)))))
 
 (defvar cl--type-dispatch-list nil
   "List of types that need to be checked during dispatch.")