master: Derive the type of (coerce n `(simple-array , e (*)))

stassats via Sbcl-commits <[email protected]> Mon, 15 Jun 2026 18:49:20 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  6e0c24685d41f8cf15884fcf04afa3243433a618 (commit)
      from  9f4f424b4ef384cdc14e0f906d211d5bb06ffc71 (commit)

- Log -----------------------------------------------------------------
commit 6e0c24685d41f8cf15884fcf04afa3243433a618
Author: Stas Boukarev <[email protected]>
Date:   Mon Jun 15 21:44:12 2026 +0300

    Derive the type of (coerce n `(simple-array ,e (*)))
---
 src/compiler/ir1util.lisp |  6 ++++++
 src/compiler/srctran.lisp | 10 ++++++++++
 tests/coerce.pure.lisp    | 10 +++++++++-
 3 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 10a8bfba4..a19c6d913 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -4235,3 +4235,9 @@ is :ANY, the function name is not checked."
     (let ((vars (make-gensym-list (length args))))
       `(lambda ,vars
          (,fun ,@vars)))))
+
+(defun array-dimensions-specifier-p (x)
+  (and (proper-list-p x)
+       (loop for d in x
+             always (or (typep d 'index)
+                        (eq d '*)))))
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 3e921ece4..03aa118da 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -8889,6 +8889,16 @@
                        (constant-cons-type (lvar-type type)))
                  (when constant
                    (handle-constant type)))
+               (combination-match type (list* (:constant type) * (:constant dimensions))
+                 (case type
+                   ((array simple-array vector)
+                    (when (typep dimensions '(cons cons null))
+                      (let ((dimensions (car dimensions)))
+                        (when (array-dimensions-specifier-p dimensions)
+                          (make-array-type dimensions
+                                           :element-type *wild-type*
+                                           :complexp (unless (eq type 'simple-array)
+                                                       :maybe))))))))
                (combination-match type ((:or list list*) (:constant type) &rest *)
                  (case type
                    ((array simple-array vector)
diff --git a/tests/coerce.pure.lisp b/tests/coerce.pure.lisp
index 0b7dfbbee..ff5a09e69 100644
--- a/tests/coerce.pure.lisp
+++ b/tests/coerce.pure.lisp
@@ -219,7 +219,15 @@
   (assert-type
    (lambda (x n)
      (coerce n (if x 'single-float 'double-float)))
-   float))
+   float)
+  (assert-type
+   (lambda (n e)
+     (coerce n `(simple-array ,e (* *))))
+   (simple-array * (* *)))
+  (assert-type
+   (lambda (n e)
+     (coerce n `(array ,e (*))))
+   vector))
 
 (with-test (:name :coerce-excluded-types)
   (assert-type

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


hooks/post-receive
-- 
SBCL