master: Make character-set unparser more useful when cross-compiling

The branch "master" has been updated in SBCL:
       via  52d8f80c929a6d847e75eba4c5c5270b4e32e819 (commit)
      from  b8eb8dc4866aae826ba5f8df5b120b05c90fddcd (commit)

- Log -----------------------------------------------------------------
commit 52d8f80c929a6d847e75eba4c5c5270b4e32e819
Author: Douglas Katzman <[email protected]>
Date:   Wed Jul 29 14:59:57 2026 -0400

    Make character-set unparser more useful when cross-compiling
    
    It's still possible to get it to fail in the way described in the comment,
    but it's much more likely not to now.
---
 src/code/type.lisp | 23 ++++++++++++++++++-----
 1 file changed, 18 insertions(+), 5 deletions(-)

diff --git a/src/code/type.lisp b/src/code/type.lisp
index d7d9e218e..94838edf6 100644
--- a/src/code/type.lisp
+++ b/src/code/type.lisp
@@ -3248,12 +3248,19 @@ expansion happened."
     (new-ctype character-set-type 0 pairs)))
 
 (defun character-set-type-from-characters (characters)
-  ;; Constructor asserts that pairs are properly sorted
-  (make-character-set-type (mapcar (lambda (x)
+  ;; IF isn't strictly needed, because MAKE-CHARACTER-SET-TYPE can return *EMPTY-TYPE*,
+  ;; however the MEMBER translator unconditionally calls CHARACTER-SET-TYPE-FROM-CHARACTERS
+  ;; on NIL all the time, which is bothersome when trying to discern why so many character
+  ;; set types arise.  User code almost can't make an empty one (it can, but rarely).
+  (if characters
+      (make-character-set-type
+                           (mapcar (lambda (x)
                                      (let ((code (sb-xc:char-code x)))
                                        (cons code code)))
+                                   ;; Constructor asserts that pairs are properly sorted
                                    (sort (delete-duplicates characters) #'<
-                                         :key #'sb-xc:char-code))))
+                                         :key #'sb-xc:char-code)))
+      *empty-type*))
 
 (declaim (ftype (sfunction (t &key (:complexp t)
                                    (:element-type t)
@@ -5217,12 +5224,18 @@ expansion happened."
             (chars (loop named outer
                          for (low . high) in pairs
                          nconc (loop for code from low upto high
-                                     collect (code-char code)
+                                     collect code
                                      when (minusp (decf count))
                                      do (return-from outer t)))))
        (if (eq chars t)
            `(character-set ,pairs)
-           `(member ,@chars))))))
+           ;; Until we know we're unparsing as MEMBER, don't call CODE-CHAR. This is a subtle
+           ;; boon to the cross-compiler which was otherwise unable to print any diagnostic
+           ;; involving certain character-sets. Think about it: we manipulate sets containing
+           ;; non-standard characters, the most prevalent being #\NULL. Unparsing such sets
+           ;; would fail with "The value 0 is not of type (OR (INTEGER 10 10) (INTEGER 32 126))"
+           ;; thereby turning your debug session into a yak-shaving exercise.
+           `(member ,@(mapcar #'code-char chars)))))))
 
 (define-type-method (character-set :singleton-p) (type)
   (let* ((pairs (character-set-type-pairs type))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL