master: Better types for (floor/ceiling (integer -5 5) integer)

The branch "master" has been updated in SBCL:
       via  c24646fff59ebcd56819b551d126ee837000a4f5 (commit)
      from  c1f893b2dff39b06ba7df00ba4f1f812ebdb05f3 (commit)

- Log -----------------------------------------------------------------
commit c24646fff59ebcd56819b551d126ee837000a4f5
Author: Stas Boukarev <[email protected]>
Date:   Wed Apr 8 21:06:53 2026 +0300

    Better types for (floor/ceiling (integer -5 5) integer)
---
 src/compiler/srctran.lisp | 29 ++++++++++++++++++-----------
 tests/arith-2.pure.lisp   | 16 +++++++++++++++-
 2 files changed, 33 insertions(+), 12 deletions(-)

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index aa6331272..b01e52049 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -2615,17 +2615,24 @@
            (defun ,q-aux (number-type divisor-type &optional float)
              (let* ((number-interval (numeric-type->interval number-type))
                     (divisor-interval (numeric-type->interval divisor-type))
-                    (div (interval-div number-interval divisor-interval))
-                    (quot (if float
-                              (,(symbolicate "F" q-name) div number-interval divisor-interval)
-                              (,q-name div))))
-               (make-numeric-type :class (if float
-                                             'float
-                                             'rational)
-                                  :format float
-                                  :low (interval-low quot)
-                                  :high (interval-high quot)
-                                  :normalize-zeros nil)))
+                    (div (interval-div number-interval divisor-interval
+                                       (and (rational-type-p number-type)
+                                            (integer-type-p divisor-type)))))
+               (flet ((make-quot (div)
+                        (let ((quot (if float
+                                        (,(symbolicate "F" q-name) div number-interval divisor-interval)
+                                        (,q-name div))))
+                          (make-numeric-type :class (if float
+                                                        'float
+                                                        'rational)
+                                             :format float
+                                             :low (interval-low quot)
+                                             :high (interval-high quot)
+                                             :normalize-zeros nil))))
+                 (if (listp div)
+                     (type-union (make-quot (first div))
+                                 (make-quot (second div)))
+                     (make-quot div)))))
            ;; Compute type of remainder.
            (defun ,r-aux (number-type divisor-type &optional same)
              (declare (ignore same))
diff --git a/tests/arith-2.pure.lisp b/tests/arith-2.pure.lisp
index 05172c2d2..7ac4ac732 100644
--- a/tests/arith-2.pure.lisp
+++ b/tests/arith-2.pure.lisp
@@ -2467,7 +2467,6 @@
                    (ash (the (signed-byte ,(* 2 sb-vm:n-word-bits)) x)
                         ,(- sb-vm:n-word-bits)))))))
 
-
 (with-test (:name :truncate-by-zero-type)
   (assert-type
    (lambda (n x)
@@ -2475,3 +2474,18 @@
               ((and integer (not (member 1 -1))) x))
      (truncate n x))
    (values (integer -4 4) (integer -9 9) &optional)))
+
+
+(with-test (:name :floor-by-integer-type)
+  (assert-type
+   (lambda (n x)
+     (declare ((integer -5 5) n)
+              (integer x))
+     (floor n x))
+   (values (integer -5 5) integer &optional))
+  (assert-type
+   (lambda (n x)
+     (declare ((rational -6 5) n)
+              (integer x))
+     (ceiling n x))
+   (values (integer -6 6) rational &optional)))

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


hooks/post-receive
-- 
SBCL