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