master: (reverse (list a b c)) => (list c b a)
stassats via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via db35d456122e0be7795fd50e713ce0b76a8f996d (commit)
from a60b90261b5078692fcac2a698f477211275a0df (commit)
- Log -----------------------------------------------------------------
commit db35d456122e0be7795fd50e713ce0b76a8f996d
Author: Stas Boukarev <[email protected]>
Date: Fri Aug 28 22:38:22 2026 +0300
(reverse (list a b c)) => (list c b a)
---
src/compiler/array-tran.lisp | 6 +-----
src/compiler/constraint-back.lisp | 8 +++----
src/compiler/fndb.lisp | 16 ++++++++++----
src/compiler/ir1util.lisp | 5 ++++-
src/compiler/seqtran.lisp | 44 +++++++++++++++++++++++++++++++--------
src/compiler/srctran.lisp | 18 ++++++++--------
src/compiler/typetran.lisp | 6 +-----
7 files changed, 66 insertions(+), 37 deletions(-)
diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 15a30dfb8..328b957d9 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -1396,11 +1396,7 @@
;; Case (5) - :INITIAL-CONTENTS and indeterminate length
(t
(let* ((listp (csubtypep (lvar-type initial-contents) (specifier-type 'list)))
- (inline-fill (cond ((and (lvar-matches initial-contents :fun-names '(reverse nreverse
- sb-impl::list-reverse
- sb-impl::vector-reverse
- sb-impl::list-nreverse
- sb-impl::vector-nreverse))
+ (inline-fill (cond ((and (lvar-matches initial-contents :fun-names '(reverse nreverse))
;; Nothing should be modifying the original sequence
(almost-immediately-used-p initial-contents (lvar-use initial-contents)
:flushable t))
diff --git a/src/compiler/constraint-back.lisp b/src/compiler/constraint-back.lisp
index 97bb7ac76..f0eb50abe 100644
--- a/src/compiler/constraint-back.lisp
+++ b/src/compiler/constraint-back.lisp
@@ -319,8 +319,8 @@
(cond
((and var
(eql nth-value 1)
- (lvar-csubtypep x integer)
- (lvar-csubtypep d integer))
+ (lvar-subtypep x integer)
+ (lvar-subtypep d integer))
(flet ((derive-quot (target &optional sign)
;; If the remainder is non-zero then the divisor is at least 2
(let* ((q (first (mv-bind-vars (node-lvar node))))
@@ -382,13 +382,13 @@
(when divisor-var
(conset-add-constraint-to-eql gen 'typep divisor-var (specifier-type '(and integer (not (integer -1 1)))) nil alternative))))
(>
- (when (lvar-csubtypep constraint (integer 0))
+ (when (lvar-subtypep constraint (integer 0))
(conset-add-constraint-to-eql gen 'typep var (specifier-type '(integer 1)) nil consequent)
(derive-quot consequent (specifier-type '(integer 1)))
(when divisor-var
(conset-add-constraint-to-eql gen 'typep divisor-var (specifier-type '(and integer (not (integer -1 1)))) nil consequent))))
(<
- (when (lvar-csubtypep constraint (integer * 0))
+ (when (lvar-subtypep constraint (integer * 0))
(conset-add-constraint-to-eql gen 'typep var (specifier-type '(integer * -1)) nil consequent)
(derive-quot consequent (specifier-type '(integer * -1)))
(when divisor-var
diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp
index 8c4626220..9cfc51cfe 100644
--- a/src/compiler/fndb.lisp
+++ b/src/compiler/fndb.lisp
@@ -651,23 +651,31 @@
(defknown length ((read-only proper-sequence)) index (foldable flushable dx-safe))
(defknown reverse ((read-only proper-sequence)) consed-sequence (flushable foldable-read-only)
- :derive-type (sequence-result-nth-arg 0 :preserve-dimensions t))
+ :derive-type (sequence-result-nth-arg 0 :preserve-dimensions t)
+ :result-arg 0)
(defknown nreverse ((modifying sequence)) sequence (important-result)
:derive-type (sequence-result-nth-arg 0 :preserve-dimensions t
- :preserve-vector-type t))
+ :preserve-vector-type t)
+ :result-arg 0)
(defknown (list-reverse-into-vector list-reverse-into-vector-cddr)
(proper-list) simple-vector
(flushable no-verify-arg-count))
(defknown sb-impl::vector-nreverse (vector) vector (important-result no-verify-arg-count)
:result-arg 0)
+(defknown sb-impl::list-nreverse (list) list (important-result no-verify-arg-count)
+ :result-arg 0)
+(defknown sb-impl::vector-reverse (vector) vector (no-verify-arg-count)
+ :result-arg 0)
+(defknown sb-impl::list-reverse (list) list (no-verify-arg-count)
+ :result-arg 0)
(defknown make-sequence (type-specifier index
&key
(:initial-element t))
- consed-sequence
- (movable foldable-read-only)
+ consed-sequence
+ (movable foldable-read-only)
:derive-type (creation-result-type-specifier-nth-arg 0))
(defknown concatenate (type-specifier &rest (read-only proper-sequence)) consed-sequence
diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index a20d0238d..f9e2b381c 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -4235,9 +4235,12 @@ is :ANY, the function name is not checked."
(defmacro lvar-intersectp (lvar type)
`(types-equal-or-intersect (lvar-type ,lvar) (specifier-type ',type)))
-(defmacro lvar-csubtypep (lvar type)
+(defmacro lvar-subtypep (lvar type)
`(csubtypep (lvar-type ,lvar) (specifier-type ',type)))
+(defun combination-name (combination)
+ (lvar-fun-name (combination-fun combination) t))
+
(defun replace-node-type (node type)
(setf (node-derived-type node) type
(lvar-%derived-type (node-lvar node)) nil))
diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 59c1b3d89..4643dd2d7 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -2695,7 +2695,7 @@
(give-up-ir1-transform))
(if (and (or (not start) (lvar-value-is start 0))
(eq end nil)
- (lvar-csubtypep sequence simple-bit-vector))
+ (lvar-subtypep sequence simple-bit-vector))
`(let* ((length (vector-length sequence))
(count 0)
(words (floor length sb-vm:n-word-bits)))
@@ -4192,17 +4192,43 @@
(declare (ignore ,@ignored))
(append ,@arguments)))))
-(deftransform reverse ((sequence) (vector) * :important nil)
- `(sb-impl::vector-reverse sequence))
-(deftransform reverse ((sequence) (list) * :important nil)
- `(sb-impl::list-reverse sequence))
+(defoptimizer (reverse rewrite-full-call) ((list) node)
+ (cond ((lvar-subtypep list list)
+ 'sb-impl::list-reverse)
+ ((lvar-subtypep list vector)
+ 'sb-impl::vector-reverse)))
-(deftransform nreverse ((sequence) (vector) * :important nil)
- `(sb-impl::vector-nreverse sequence))
+(defoptimizer (nreverse rewrite-full-call) ((list) node)
+ (cond ((lvar-subtypep list list)
+ 'sb-impl::list-nreverse)
+ ((lvar-subtypep list vector)
+ 'sb-impl::vector-nreverse)))
-(deftransform nreverse ((sequence) (list) * :important nil)
- `(sb-impl::list-nreverse sequence))
+(deftransforms (reverse nreverse) ((sequence) ((or vector list)) * :node node :important nil)
+ (or (combination-case sequence
+ (list *
+ (setf (combination-args combination) (reverse args))
+ 'sequence)
+ (list* *
+ (let ((last (last args)))
+ (cond ((lvar-subtypep (car last) null)
+ (setf (combination-args combination)
+ (append (cdr (reverse args)) last))
+ 'sequence)
+ (t
+ (splice-fun-args sequence 'list* nil)
+ (let ((vars (make-gensym-list (length args))))
+ `(lambda ,vars
+ (,(case (combination-name node)
+ (reverse 'revappend)
+ (nreverse 'nreconc))
+ ,(car (last vars))
+ (list ,@(reverse (butlast vars))))))))))
+ (initialize-vector *
+ (setf (combination-args combination) (reverse args))
+ 'sequence))
+ (give-up-ir1-transform)))
(deftransforms (intersection nintersection)
((list1 list2 &key key test test-not))
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 427566ffd..36a5c4f23 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -680,7 +680,7 @@
(setf cut t))))
(splice-fun-args x 'logand 2)
(if cut
- (if (lvar-csubtypep x word)
+ (if (lvar-subtypep x word)
`(lambda (x y z)
(declare (ignore z))
(not (logtest x (logand most-positive-word y))))
@@ -5946,12 +5946,12 @@
;; Don't allow mixing integer 0 and float zero, which have different negations
(defun float-contagion-for-negate (a b &optional no-rational)
(cond ((and (not no-rational)
- (lvar-csubtypep a (or rational (complex rational)))
- (lvar-csubtypep b (or rational (complex rational)))))
- ((lvar-csubtypep a (and number (not (or (eql 0) (complex rational)))))
- (or (lvar-csubtypep b (and number (not (or (eql 0) (complex rational)))))
+ (lvar-subtypep a (or rational (complex rational)))
+ (lvar-subtypep b (or rational (complex rational)))))
+ ((lvar-subtypep a (and number (not (or (eql 0) (complex rational)))))
+ (or (lvar-subtypep b (and number (not (or (eql 0) (complex rational)))))
a))
- ((lvar-csubtypep b (and number (not (or (eql 0) (complex rational)))))
+ ((lvar-subtypep b (and number (not (or (eql 0) (complex rational)))))
b)))
(defun negate-lvar (x outer-node &key test minus-zero-ignored
@@ -6050,7 +6050,7 @@
(cond ((or (float-safe-p)
(loop for arg in args
do
- (if (lvar-csubtypep arg (and number (not (or (eql 0) (complex rational)))))
+ (if (lvar-subtypep arg (and number (not (or (eql 0) (complex rational)))))
(setf good arg)
(setf all-good nil))
finally (return all-good)))
@@ -6173,7 +6173,7 @@
(negate-truncation combination args 'ffloor t))
(sin (*)
(when (or (float-safe-p)
- (lvar-csubtypep (first args)
+ (lvar-subtypep (first args)
(and number (not (or (eql 0) (complex rational))))))
(negate-lvar (first args) test any-branch)))))))))
(negate-lvar x test any-branch)))))
@@ -9251,7 +9251,7 @@
((or null vector) t &rest t) *
:policy (= space 0))
(cond ((eq (array-type-upgraded-element-type (lvar-type vector) :ignore-null t) *wild-type*)
- (unless (lvar-csubtypep vector null)
+ (unless (lvar-subtypep vector null)
(give-up-ir1-transform)))
(t
(wrap-if
diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index d9ab1793b..62d4eeb6a 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -2044,11 +2044,7 @@
(if ,already-type-p
x
,(cond ((eq dimension '*)
- (cond ((and (lvar-matches x :fun-names '(reverse nreverse
- sb-impl::list-reverse
- sb-impl::vector-reverse
- sb-impl::list-nreverse
- sb-impl::vector-nreverse))
+ (cond ((and (lvar-matches x :fun-names '(reverse nreverse))
(almost-immediately-used-p x (lvar-use x) :flushable t))
(splice-fun-args x :any 1)
;; The make-array transform can handle this
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL