master: substitute: warn about unfindable items

stassats via Sbcl-commits <[email protected]> Sat, 16 May 2026 00:30:14 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  a8ba1ef64f5187b14e4ada7234264556eb327e60 (commit)
      from  1d3cebea7e0415e697be5f17bded91bbd00588a4 (commit)

- Log -----------------------------------------------------------------
commit a8ba1ef64f5187b14e4ada7234264556eb327e60
Author: Stas Boukarev <[email protected]>
Date:   Sat May 16 03:28:08 2026 +0300

    substitute: warn about unfindable items
---
 src/compiler/seqtran.lisp | 26 +++++++++++++++++---------
 1 file changed, 17 insertions(+), 9 deletions(-)

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index d0a0add7d..fd3ebf23f 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -1309,11 +1309,11 @@
                         (specifier-type 'character))
                        (t
                         *universal-type*))))
-        (multiple-value-bind (key-type key) (and key
-                                                 (lvar-fun-type key))
+        (multiple-value-bind (key-type key-name) (and key
+                                                      (lvar-fun-type key))
           (let ((*compiler-error-context* node))
             (when (and (or (not key)
-                           (eq key 'identity))
+                           (eq key-name 'identity))
                        (not (types-equal-or-intersect item (sequence-element-type (lvar-type sequence)))))
               (compiler-style-warn "Item of type ~s can't be found in a sequence of type ~s."
                                    (type-specifier item)
@@ -1323,7 +1323,7 @@
                 (unless (types-equal-or-intersect item returns)
                   (compiler-style-warn "Item of type ~s can't be found using :key ~s which returns ~s."
                                        (type-specifier item)
-                                       key
+                                       key-name
                                        (type-specifier returns)))))))))))
 
 (defun check-sequence-ranges (sequence start end node &key (suffix "") name (warn t))
@@ -1407,9 +1407,10 @@
     (find position
      remove delete
      count)
-    ((item sequence &key key test start end &allow-other-keys) node)
+    ((item sequence &key key test test-not start end &allow-other-keys) node)
   (check-sequence-ranges sequence start end node)
-  (check-sequence-test item sequence test key node))
+  (unless test-not
+    (check-sequence-test item sequence test key node)))
 
 (defoptimizers ir2-hook
     (remove-duplicates delete-duplicates
@@ -1768,9 +1769,16 @@
                            (type-specifier seq-type))))))))
 
 (defoptimizers ir2-hook
-    (substitute substitute-if substitute-if-not
-                nsubstitute nsubstitute-if nsubstitute-if-not)
-    ((new x seq &key start end &allow-other-keys) node)
+    (substitute nsubstitute)
+    ((new old seq &key start end test test-not key &allow-other-keys) node)
+  (check-sequence-ranges seq start end node)
+  (check-sequence-item new seq node "Can't substitute ~a into ~a")
+  (unless test-not
+    (check-sequence-test old seq test key node)))
+
+(defoptimizers ir2-hook
+    (substitute-if substitute-if-not nsubstitute-if nsubstitute-if-not)
+    ((new p seq &key start end test test-not key &allow-other-keys) node)
   (check-sequence-ranges seq start end node)
   (check-sequence-item new seq node "Can't substitute ~a into ~a"))
 

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


hooks/post-receive
-- 
SBCL