master: coerce type derivation: preserve simple array dimensions

The branch "master" has been updated in SBCL:
       via  54d7e2b9026bbcb2954a727d67b809fd503d91d8 (commit)
      from  f5195f65be942f7562f3bf3edc885fed75317498 (commit)

- Log -----------------------------------------------------------------
commit 54d7e2b9026bbcb2954a727d67b809fd503d91d8
Author: Stas Boukarev <[email protected]>
Date:   Sat May 30 17:08:10 2026 +0300

    coerce type derivation: preserve simple array dimensions
---
 src/compiler/srctran.lisp | 58 +++++++++++++++++++++++++++++++----------------
 tests/coerce.pure.lisp    |  2 +-
 2 files changed, 39 insertions(+), 21 deletions(-)

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index b23d191c3..c0fadb58f 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -8894,26 +8894,44 @@
                                       (type-union type (specifier-type 'sequence))))
                                  ((not (types-equal-or-intersect type (specifier-type '(or number sequence symbol))))
                                   type))))
-               (cases
-                float (or float (complex float))
-                integer (or integer float (complex float))
-                ratio (or ratio float (complex float))
-                rational (or rational float (complex float))
-                complex complex
-                null (or null (simple-array * (0)) extended-sequence)
-                cons (or cons function (simple-array * (*)) extended-sequence)
-                (and (simple-array * (*)) (not (string 1))) (or (simple-array * (*)) list extended-sequence)
-                (simple-array * (*)) (or (simple-array * (*)) list extended-sequence character)
-                (and vector (not string)) sequence
-                vector (or sequence character)
-                (and array (not vector)) type
-                (and simple-array (not (string 1))) (or simple-array list extended-sequence)
-                simple-array (or simple-array list extended-sequence character)
-                (and array (not string)) (or sequence array)
-                array (or sequence array character)
-                (and symbol (not null)) (or (and symbol (not null)) function character)
-                symbol (or symbol (simple-array * (0)) extended-sequence function character)
-                sequence sequence)))
+               (if (and (array-type-p type)
+                        (not (array-type-complexp type))
+                        (typep (array-type-dimensions type) '(cons fixnum null)))
+                   (let ((length (car (array-type-dimensions type)))
+                         (et (array-type-specialized-element-type type)))
+                     (type-union (specifier-type 'sb-kernel:extended-sequence)
+                                 (cond ((> length 1)
+                                        (specifier-type 'cons))
+                                       ((= length 1)
+                                        (if (or (eq et *wild-type*)
+                                                (csubtypep et (specifier-type 'character)))
+                                            (specifier-type '(or cons character))
+                                            (specifier-type 'cons)))
+                                       (t
+                                        (specifier-type 'list)))
+                                 (make-array-type (array-type-dimensions type)
+                                                  :element-type *wild-type*
+                                                  :complexp nil)))
+                   (cases
+                    float (or float (complex float))
+                    integer (or integer float (complex float))
+                    ratio (or ratio float (complex float))
+                    rational (or rational float (complex float))
+                    complex complex
+                    null (or null (simple-array * (0)) extended-sequence)
+                    cons (or cons function (simple-array * (*)) extended-sequence)
+                    (and (simple-array * (*)) (not (string 1))) (or (simple-array * (*)) list extended-sequence)
+                    (simple-array * (*)) (or (simple-array * (*)) list extended-sequence character)
+                    (and vector (not string)) sequence
+                    vector (or sequence character)
+                    (and array (not vector)) type
+                    (and simple-array (not (string 1))) (or simple-array list extended-sequence)
+                    simple-array (or simple-array list extended-sequence character)
+                    (and array (not string)) (or sequence array)
+                    array (or sequence array character)
+                    (and symbol (not null)) (or (and symbol (not null)) function character)
+                    symbol (or symbol (simple-array * (0)) extended-sequence function character)
+                    sequence sequence))))
            :numeric nil)))
     (let ((value (lvar-type value))
           (exclude nil))
diff --git a/tests/coerce.pure.lisp b/tests/coerce.pure.lisp
index 482b5163d..32f2fce05 100644
--- a/tests/coerce.pure.lisp
+++ b/tests/coerce.pure.lisp
@@ -189,7 +189,7 @@
   (assert-type
      (lambda (y)
        (coerce "ab" y))
-     (or list (simple-array * (*)) sb-kernel:extended-sequence))
+     (or cons (simple-array * (2)) sb-kernel:extended-sequence))
   (assert-type
    (lambda (x y)
      (coerce (the function x) y))

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


hooks/post-receive
-- 
SBCL