master: coerce derive-type: exclude rational types

The branch "master" has been updated in SBCL:
       via  2329ddf0dca2f182c77e2dea9f72a03fecae3069 (commit)
      from  8c7db506073866892480ecd686f164db8a4447aa (commit)

- Log -----------------------------------------------------------------
commit 2329ddf0dca2f182c77e2dea9f72a03fecae3069
Author: Stas Boukarev <[email protected]>
Date:   Mon Jun 1 06:15:08 2026 +0300

    coerce derive-type: exclude rational types
---
 src/compiler/srctran.lisp | 13 ++++++++++---
 tests/coerce.pure.lisp    |  8 ++++++--
 2 files changed, 16 insertions(+), 5 deletions(-)

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index c0fadb58f..ec545cbcd 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -8933,6 +8933,7 @@
                     symbol (or symbol (simple-array * (0)) extended-sequence function character)
                     sequence sequence))))
            :numeric nil)))
+    ;; Exclude some types if they are excluded from the input value
     (let ((value (lvar-type value))
           (exclude nil))
       (macrolet ((cases (&body cases)
@@ -8941,18 +8942,24 @@
                               collect `(unless (types-equal-or-intersect (specifier-type ',exclude) value)
                                          (setf exclude
                                                (if exclude
-                                                   (type-intersection exclude (specifier-type ',excluded))
+                                                   (type-union exclude (specifier-type ',excluded))
                                                    (specifier-type ',excluded))))))))
         (unless (or (eq value *universal-type*)
                     (opaque-type-p value))
+          (let* ((negated (type-negation value))
+                 (not-rational (type-intersection negated (specifier-type 'rational))))
+            (unless (eq not-rational *empty-type*)
+              (setf exclude not-rational)))
           (cases
            number number
            real real
-           sequence sequence
+           sequence (or list vector)
+           ;; symbol can be coerced to a function which can be an extended sequence
+           (or (and symbol (not null)) sequence) sequence
            (and array (not vector)) (and array (not vector))
            array (and array (not vector))
            (and array (not simple-array)) (and array (not simple-array))
-           (or (and symbol (not null)) function cons) function
+           (or symbol function sequence) function
            (or character string (and symbol (not null))) character)
           (when exclude
             (setf value-type
diff --git a/tests/coerce.pure.lisp b/tests/coerce.pure.lisp
index 1510cf057..0b7dfbbee 100644
--- a/tests/coerce.pure.lisp
+++ b/tests/coerce.pure.lisp
@@ -193,7 +193,7 @@
   (assert-type
    (lambda (x y)
      (coerce (the function x) y))
-   (or function sequence))
+   (or list (simple-array * (*)) function sb-kernel:extended-sequence))
   (assert-type
    (lambda (x y)
      (coerce (the (and symbol (not null)) x) y))
@@ -225,7 +225,11 @@
   (assert-type
    (lambda (x y)
      (coerce (the (not real) x) y))
-   (not real)))
+   (not real))
+  (assert-type
+   (lambda (x y)
+     (coerce (the (not fixnum) x) y))
+   (not fixnum)))
 
 (with-test (:name :numbero-to-list-error)
   (assert-error (coerce (opaque-identity 1)

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


hooks/post-receive
-- 
SBCL