master: Transform delete-if-not

The branch "master" has been updated in SBCL:
       via  dd3bf6030c96bd4449e1ed1d5d126ff37953c861 (commit)
      from  b52e4b75c9adcd70339da32fe7fc1f7390d39141 (commit)

- Log -----------------------------------------------------------------
commit dd3bf6030c96bd4449e1ed1d5d126ff37953c861
Author: Douglas Katzman <[email protected]>
Date:   Wed Apr 15 20:26:36 2026 +0000

    Transform delete-if-not
    
    Otherwise (delete (complement #'foo) ...) might actually get worse,
    because it's no longer open-coded after the IF-NOT-COMPLEMENTER changes
    the call to (delete-if-not #'foo)
---
 src/compiler/seqtran.lisp | 23 +++++++++++++++--------
 1 file changed, 15 insertions(+), 8 deletions(-)

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 78c30eea8..10d6ab51e 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -769,16 +769,23 @@
       (give-up-ir1-transform)))
   `(delq item list))
 
+(flet ((transform (cond)
+         `(do ((x list (cdr x))
+               (splice '()))
+           ((endp x) list)
+           (cond (,cond
+                  (if (null splice)
+                      (setq list (cdr x))
+                      (rplacd splice (cdr x))))
+                 (t (setq splice x))))))
+
 (deftransform delete-if ((pred list) (t list))
   "open code"
-  '(do ((x list (cdr x))
-        (splice '()))
-       ((endp x) list)
-     (cond ((funcall pred (car x))
-            (if (null splice)
-                (setq list (cdr x))
-                (rplacd splice (cdr x))))
-           (t (setq splice x)))))
+  (transform '(funcall pred (car x))))
+
+(deftransform delete-if-not ((pred list) (t list))
+  "open code"
+  (transform '(not (funcall pred (car x))))))
 
 (deftransform fill ((seq item &key (start 0) (end nil))
                     (list t &key (:start t) (:end t)))

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


hooks/post-receive
-- 
SBCL