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

From: David Ponce <[email-masked]>
Date: Wed, 21 May 2025 11:00:10 +0200

On 2025-05-20 00:05, Stefan Monnier wrote:
>>   ;;;###autoload
>>   (defun cl-types-of (object &optional types)
>>     "Return the atomic types OBJECT belongs to.
>> @@ -1044,11 +1046,18 @@ cl-types-of
>>                (funcall pred object)
>>              (condition-case-unless-debug e
>>                  (funcall pred object)
>> -             (error (setq cl--derived-type-list
>> -                          (delq type cl--derived-type-list))
>> -                    (warn  "cl-types-of %S: %s"
>> -                           type (error-message-string e))
>> -                    nil)))
>> +             ;; Catching `cl-type-error' means it comes from recursive
>> +             ;; calls to `cl-types-of', so propagate the error until
>> +             ;; escaping the outermost call to `cl-types-of'.
>> +             (cl-type-error
>> +              (signal (car e) (cdr e)))
>> +             (error
>> +              ;; If checking TYPE signals an error, disable TYPE and
>> +              ;; signal a `cl-type-error' error mentioning TYPE and
>> +              ;; the underlying error.
>> +              (setq cl--derived-type-list
>> +                    (delq type cl--derived-type-list))
>> +              (signal 'cl-type-error (list type e)))))
>>            (push type found))))
>>       (push (cl-type-of object) found)
>>       ;; Return the list of types OBJECT belongs to, which is also the list
> 
> Hmm... usually we have two preoccupations:
> 
> - Notify the existence of a problem.
> - Try and provide "graceful degradation", i.e. still do something
>    useful, despite the problem.
> - Make it easy to debug.
> 
> Both the "before" and "after" versions of the code above seem to satisfy
> those needs in more or less the same way, but your new code is more
> complex, so I'm wondering what do you see as the advantage?
> 
> BTW, a related option is to do something like:
> 
>      (let ((error t))
>        (unwind-protect
>            (prog1 (funcall pred object)
>                   (setq error nil))
>          (when error
>            (setq cl--derived-type-list
>                  (delq type cl--derived-type-list)))))
> 
> 

My code is slightly more complex to correctly handle recursive errors:

1. Avoid disabling again and again the type in error following nested
    `condition-case'.  Currently cleanup is just a `delq', but maybe in
    the future it could be more, or delegated to a user function, for
    example.  So, IMO, the behavior should be consistent, and
    regardless of the error, 1 error => 1 cleanup ;-)

2. Clearly mention the type in error to help fixing the issue.

For instance eval this derived type definition, badly recursive:

  (cl-deftype T1 ()
   `(satisfies ,(lambda (o) (memq 'T1 (cl-types-of o)))))

Then: (cl-types-of "any-object")

My proposal shows this message in the echo area:

   Error on derived type: T1, (excessive-lisp-nesting 1601)

And this line in the *Message* buffer:

   forward-sexp-default-function: Error on derived type: T1, (excessive-lisp-nesting 1601)

Your `unwind' proposal shows this message in the echo area:

   Args out of range: 79, 83

And these lines in the *Message* buffer:

   cl-prin1: (error "Lisp nesting exceeds ‘max-lisp-eval-depth’") [10 times]
   make-text-button: Args out of range: 79, 83

If my proposal is too complex, at least, the current behavior using
`warn' is better.

Thanks
David

I reattached my patch where an autoload cookie was missing.

diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el
index 1fe0411062f..ae833e709ad 100644
--- a/lisp/emacs-lisp/cl-extra.el
+++ b/lisp/emacs-lisp/cl-extra.el
@@ -1025,6 +1025,9 @@ cl--types-of-memo
 ;; - 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
+(define-error 'cl-type-error "Error on derived type")
+
 ;;;###autoload
 (defun cl-types-of (object &optional types)
   "Return the atomic types OBJECT belongs to.
@@ -1044,11 +1047,18 @@ cl-types-of
              (funcall pred object)
            (condition-case-unless-debug e
                (funcall pred object)
-             (error (setq cl--derived-type-list
-                          (delq type cl--derived-type-list))
-                    (warn  "cl-types-of %S: %s"
-                           type (error-message-string e))
-                    nil)))
+             ;; Catching `cl-type-error' means it comes from recursive
+             ;; calls to `cl-types-of', so propagate the error until
+             ;; escaping the outermost call to `cl-types-of'.
+             (cl-type-error
+              (signal (car e) (cdr e)))
+             (error
+              ;; If checking TYPE signals an error, disable TYPE and
+              ;; signal a `cl-type-error' error mentioning TYPE and
+              ;; the underlying error.
+              (setq cl--derived-type-list
+                    (delq type cl--derived-type-list))
+              (signal 'cl-type-error (list type e)))))
          (push type found))))
     (push (cl-type-of object) found)
     ;; Return the list of types OBJECT belongs to, which is also the list