master: Lower :test for remove-duplicates
stassats via Sbcl-commits <[email protected]> Fri, 29 May 2026 21:51:29 +0000
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via c418c07469974f9733e84cc2d4ffe50abd7a7259 (commit)
from ad49eb30511b45b4544513713a431cee08af67a7 (commit)
- Log -----------------------------------------------------------------
commit c418c07469974f9733e84cc2d4ffe50abd7a7259
Author: Stas Boukarev <[email protected]>
Date: Wed May 27 16:45:26 2026 +0300
Lower :test for remove-duplicates
---
src/compiler/seqtran.lisp | 35 +++++++++++++++++++++++++++++++++--
1 file changed, 33 insertions(+), 2 deletions(-)
diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index b862061fe..7f0fbc0fc 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -731,6 +731,27 @@
(unless (eq test test-origin)
test)))
+(defun change-test-based-on-sequence-type (test sequence key)
+ (let* ((test (if test
+ (lvar-fun-is test '(eql equal equalp char= char-equal =))
+ 'eql))
+ (test-origin test))
+ (when test
+ (unless (eq test 'eq)
+ (let ((elt (sequence-element-type sequence key)))
+ (setf test (change-test-based-on-item test elt))
+ (unless (eq test 'eq)
+ (cond ((and (memq test '(equalp =))
+ (csubtypep elt (specifier-type 'integer)))
+ (setf test (if (csubtypep elt (specifier-type 'fixnum))
+ 'eq
+ 'eql)))
+ ((and (eq test 'char=)
+ (csubtypep elt (specifier-type 'character)))
+ (setf test 'eq)))))))
+ (unless (eq test test-origin)
+ test)))
+
(defun change-test-based-on-two-sequences-types (test sequence1 sequence2 key)
(let* ((test (if test
(lvar-fun-is test '(eql equal equalp char= char-equal =))
@@ -4306,6 +4327,12 @@
(change-keyword-value (find-global-fun new-test t) :test test node))
nil))
+(defun lower-one-sequence-test (node test sequence key)
+ (let ((new-test (change-test-based-on-sequence-type test sequence key)))
+ (when new-test
+ (change-keyword-value (find-global-fun new-test t) :test test node))
+ nil))
+
(defoptimizers optimizer
(remove delete count find position copy-remove)
((item sequence &rest args &key
@@ -4345,9 +4372,13 @@
((sequence &rest args &key
((test test-keyword))
((test-not test-not-keyword))
- &allow-other-keys))
+ key
+ &allow-other-keys)
+ node)
(test-not-complementer test test-keyword test-not test-not-keyword
- args))
+ args)
+ (unless test-not
+ (lower-one-sequence-test node test sequence key)))
(defoptimizers optimizer
(substitute nsubstitute subst nsubst)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL