master: (coerce (the (not real) x) y) => (not real)

The branch "master" has been updated in SBCL:
       via  8f0bf3b28670f5cb77f4a7d7fd7f03f7dfc7d124 (commit)
      from  c418c07469974f9733e84cc2d4ffe50abd7a7259 (commit)

- Log -----------------------------------------------------------------
commit 8f0bf3b28670f5cb77f4a7d7fd7f03f7dfc7d124
Author: Stas Boukarev <[email protected]>
Date:   Thu May 28 15:01:47 2026 +0300

    (coerce (the (not real) x) y) => (not real)
---
 src/compiler/srctran.lisp | 20 ++++++++++++++++++++
 tests/coerce.pure.lisp    |  6 ++++++
 2 files changed, 26 insertions(+)

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 914a0a083..86c6a524e 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -8915,6 +8915,26 @@
                 symbol (or symbol (simple-array * (0)) extended-sequence function character)
                 sequence sequence)))
            :numeric nil)))
+    (let ((value (lvar-type value))
+          (exclude nil))
+      (macrolet ((cases (&body cases)
+                   `(progn
+                      ,@(loop for exclude in cases
+                              collect `(unless (types-equal-or-intersect (specifier-type ',exclude) value)
+                                         (setf exclude
+                                               (if exclude
+                                                   (type-intersection exclude (specifier-type ',exclude))
+                                                   (specifier-type ',exclude))))))))
+        (unless (or (eq value *universal-type*)
+                    (opaque-type-p value))
+          (cases
+           number
+           real)
+          (when exclude
+            (setf value-type
+                  (if value-type
+                      (type-difference value-type exclude)
+                      (type-negation exclude)))))))
     (if (and type-type value-type)
         (type-intersection type-type value-type)
         (or type-type value-type))))
diff --git a/tests/coerce.pure.lisp b/tests/coerce.pure.lisp
index 331cdef38..482b5163d 100644
--- a/tests/coerce.pure.lisp
+++ b/tests/coerce.pure.lisp
@@ -220,3 +220,9 @@
    (lambda (x n)
      (coerce n (if x 'single-float 'double-float)))
    float))
+
+(with-test (:name :coerce-excluded-types)
+  (assert-type
+   (lambda (x y)
+     (coerce (the (not real) x) y))
+   (not real)))

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


hooks/post-receive
-- 
SBCL