X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcode%2Flate-type.lisp;h=63431b9f85aad4fc6d7bda8e1eb0e0a8e1a1f8ee;hb=a6a12ed609d5467ec43b411283e5b3568fee81df;hp=d1eaa9e40be7acb7ea798c3d04e8b0215bdb0ad0;hpb=0b9304783ffb07853927ec7ab67378602d4f39b4;p=sbcl.git

diff --git a/src/code/late-type.lisp b/src/code/late-type.lisp
index d1eaa9e..63431b9 100644
--- a/src/code/late-type.lisp
+++ b/src/code/late-type.lisp
@@ -3297,10 +3297,20 @@ used for a COMPLEX component.~:@>"
     ((type= type (specifier-type 'base-char)) 'base-char)
     ((type= type (specifier-type 'extended-char)) 'extended-char)
     ((type= type (specifier-type 'standard-char)) 'standard-char)
-    (t (let ((pairs (character-set-type-pairs type)))
-        `(member ,@(loop for (low . high) in pairs
+    (t
+     ;; Unparse into either MEMBER or CHARACTER-SET. We use MEMBER if there
+     ;; are at most as many characters than there are character code ranges.
+     (let* ((pairs (character-set-type-pairs type))
+            (count (length pairs))
+            (chars (loop named outer
+                         for (low . high) in pairs
                          nconc (loop for code from low upto high
-                                     collect (sb!xc:code-char code))))))))
+                                     collect (sb!xc:code-char code)
+                                     when (minusp (decf count))
+                                     do (return-from outer t)))))
+       (if (eq chars t)
+           `(character-set ,pairs)
+           `(member ,@chars))))))
 
 (!define-type-method (character-set :singleton-p) (type)
   (let* ((pairs (character-set-type-pairs type))