master: More coerce type exclusion derivation

stassats via Sbcl-commits <[email protected]> Fri, 29 May 2026 21:51:34 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  6f4581f924cc164a7e9754036841421e57666b8b (commit)
      from  8f0bf3b28670f5cb77f4a7d7fd7f03f7dfc7d124 (commit)

- Log -----------------------------------------------------------------
commit 6f4581f924cc164a7e9754036841421e57666b8b
Author: Stas Boukarev <[email protected]>
Date:   Fri May 29 03:06:03 2026 +0300

    More coerce type exclusion derivation
---
 src/compiler/srctran.lisp | 15 ++++++++++-----
 1 file changed, 10 insertions(+), 5 deletions(-)

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 86c6a524e..88ec395d1 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -8919,17 +8919,22 @@
           (exclude nil))
       (macrolet ((cases (&body cases)
                    `(progn
-                      ,@(loop for exclude in cases
+                      ,@(loop for (exclude excluded) on cases by #'cddr
                               collect `(unless (types-equal-or-intersect (specifier-type ',exclude) value)
                                          (setf exclude
                                                (if exclude
-                                                   (type-intersection exclude (specifier-type ',exclude))
-                                                   (specifier-type ',exclude))))))))
+                                                   (type-intersection exclude (specifier-type ',excluded))
+                                                   (specifier-type ',excluded))))))))
         (unless (or (eq value *universal-type*)
                     (opaque-type-p value))
           (cases
-           number
-           real)
+           number number
+           real real
+           sequence sequence
+           (and array (not vector)) (and array (not vector))
+           array (and array (not vector))
+           (or (and symbol (not null)) function cons) function
+           (or character string (and symbol (not null))) character)
           (when exclude
             (setf value-type
                   (if value-type

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


hooks/post-receive
-- 
SBCL