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