master: Turn (copy-list small-constant) into (list , @constant)

stassats via Sbcl-commits <[email protected]> Fri, 05 Jun 2026 00:19:25 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  9deb748799125a1ee6c4feee6bfa22ddd2b035cc (commit)
      from  a3cfdde6a335d9b1f0028006f19ce0a71694a32c (commit)

- Log -----------------------------------------------------------------
commit 9deb748799125a1ee6c4feee6bfa22ddd2b035cc
Author: Stas Boukarev <[email protected]>
Date:   Fri Jun 5 03:16:36 2026 +0300

    Turn (copy-list small-constant) into (list ,@constant)
---
 src/compiler/array-tran.lisp |  2 +-
 src/compiler/seqtran.lisp    | 15 +++++++++++++++
 2 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index c88f9aacd..18245c6fa 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -184,7 +184,7 @@
     (loop until (atom list)
           do (pop list)
              (incf length))
-    length))
+    (values length list)))
 
 (defun constant-sequence-element-type (sequence &optional key)
   (let (min
diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index c1a5c0d7c..3c9c5663f 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -2156,6 +2156,10 @@
          'seq))
       (give-up-ir1-transform)))
 
+(defun quote-list (list)
+  (loop for e in list
+        collect (list 'quote e)))
+
 (make-defs ((($fun $proper)
              (copy-list nil)
              (list-copy-seq t)))
@@ -2170,6 +2174,17 @@
          (remove-if-not *
           (change-full-call combination 'copy-remove-if-not)
           'seq))
+       (and (constant-lvar-p seq)
+            (let ((list (lvar-value seq)))
+              (when (proper-or-dotted-list-p list)
+                (multiple-value-bind (length dotted) (dotted-list-length list)
+                  (when (<= length 10)
+                    (if dotted
+                        (let ((last (last list)))
+                          `(list* ,@(quote-list (butlast list))
+                                  ',(car last)
+                                  ',(cdr last)))
+                        `(list ,@(quote-list list))))))))
        (when (policy node (or (> speed space) (> instrument-consing 1)))
          ;; If speed is more important than space, or cons profiling is wanted,
          ;; then inline the whole copy loop.

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


hooks/post-receive
-- 
SBCL