master: Don't verify-arg-count for XEPs with known calls

The branch "master" has been updated in SBCL:
       via  5598c57d2552b44d956c9ad849d46eb3bce4872f (commit)
      from  0056dfb1490375048fe4e62f2e5af4c94a325a83 (commit)

- Log -----------------------------------------------------------------
commit 5598c57d2552b44d956c9ad849d46eb3bce4872f
Author: Stas Boukarev <[email protected]>
Date:   Wed May 6 22:40:12 2026 +0300

    Don't verify-arg-count for XEPs with known calls
---
 src/compiler/ir1opt.lisp    | 25 +++++++++++++++++++++----
 src/compiler/ir1util.lisp   | 12 ++++++++++++
 tests/compiler-ir.pure.lisp |  9 +++++++++
 3 files changed, 42 insertions(+), 4 deletions(-)

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index cd6abdc07..0431cd88b 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1563,10 +1563,27 @@
                                                    (let ((package (sb-xc:symbol-package (classoid-name type))))
                                                      (or (eq package *cl-package*)
                                                          (and package (system-package-p package)))))))))))
-         (cond ((functional-p leaf)
-                (convert-call-if-possible
-                 (lvar-uses (basic-combination-fun call))
-                 call))
+         (cond ((listp (lvar-uses fun-lvar))
+                (loop for use in (lvar-uses fun-lvar)
+                      do (when (ref-p use)
+                           (let* ((leaf (ref-leaf use))
+                                  (type (leaf-type leaf)))
+                             (when (and (fun-type-p type)
+                                        (lambda-p leaf)
+                                        (functional-kind-eq leaf external)
+                                        (let ((arg-count (length (combination-args call))))
+                                          (block nil
+                                            (map-callers (lambda (caller)
+                                                           (unless (= arg-count (length (combination-args caller)))
+                                                             (return)))
+                                                         leaf
+                                                         :not-a-caller (lambda () (return)))
+                                            t)))
+                               (disable-arg-count-checking leaf type (length (combination-args call))))))))
+               ((functional-p leaf)
+                   (convert-call-if-possible
+                    (lvar-uses (basic-combination-fun call))
+                    call))
                ((not leaf))
                ((and (global-var-p leaf)
                      (eq (global-var-kind leaf) :global-function)
diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 022f874c0..3f07bdc74 100644
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -3616,6 +3616,18 @@ is :ANY, the function name is not checked."
                   when (eq v lambda-var)
                   do (funcall function combination arg))))))))
 
+(defun map-callers (function lambda &key not-a-caller)
+  (declare (dynamic-extent function)
+           (dynamic-extent not-a-caller))
+  (loop for ref in (leaf-refs lambda)
+        for lvar = (node-lvar ref)
+        for dest = (and lvar (lvar-dest lvar))
+        do (cond ((and (combination-p dest)
+                       (eq (combination-fun dest) lvar))
+                  (funcall function dest))
+                 (not-a-caller
+                  (funcall not-a-caller)))))
+
 (declaim (ftype (sfunction (function t &key (:leaf-set t) (:multiple-uses t) (:cast t)) null) map-refs))
 (defun map-refs (function leaf/lvar &key leaf-set
                                          multiple-uses
diff --git a/tests/compiler-ir.pure.lisp b/tests/compiler-ir.pure.lisp
index 7cdcec2b8..20f481d22 100644
--- a/tests/compiler-ir.pure.lisp
+++ b/tests/compiler-ir.pure.lisp
@@ -661,3 +661,12 @@
                     :key (lambda (x) (and (combination-p x)
                                           (combination-fun-source-name x nil))))
              0)))
+
+(with-test (:name :xep-calls-no-arg-count-checking)
+  (assert (= (count 'sb-c:verify-arg-count
+                    (ir2-vops '(lambda (n)
+                                (funcall (if n
+                                             (lambda (a) (+ a 2))
+                                             (lambda (b) (+ b 1)))
+                                 1))))
+             1)))

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


hooks/post-receive
-- 
SBCL