master: constraint: Inherit EQL var constraints from local calls as well.

The branch "master" has been updated in SBCL:
       via  6c0c0fdc2c09d90286e94ac22bf1632493aee8df (commit)
      from  87608fcd950556179aa66702c4fc3551ede42070 (commit)

- Log -----------------------------------------------------------------
commit 6c0c0fdc2c09d90286e94ac22bf1632493aee8df
Author: Charles Zhang <[email protected]>
Date:   Fri Aug 14 03:11:27 2026 +0200

    constraint: Inherit EQL var constraints from local calls as well.
    
    (defun f ()
      (declare (optimize speed))
      (labels ((phi (index)
                 (declare (type (integer 0) index))
                 (if (> index 9)
                     nil
                     (rec 0 index)))
               (rec (zoot gindex)
                 (declare (fixnum zoot))
                 (if (< zoot 5)
                     (rec (1+ zoot) gindex)
                     (phi (1+ gindex)))))
        (phi 0)))
    
    now no longer produces any notes.
    
    However, we don't have optimistic type propagation in CP itself, so
    neither the lower bound nor the integerness of GINDEX or INDEX can be
    derived.
---
 src/compiler/constraint.lisp | 24 +++++++++++++++++-------
 tests/compiler.pure.lisp     | 16 ++++++++++++++++
 2 files changed, 33 insertions(+), 7 deletions(-)

diff --git a/src/compiler/constraint.lisp b/src/compiler/constraint.lisp
index b00a5b123..b0e35cde2 100644
--- a/src/compiler/constraint.lisp
+++ b/src/compiler/constraint.lisp
@@ -1438,11 +1438,11 @@
           (let ((fun (combination-lambda node))
                 (call-in (combination-constraints-in node)))
             (when (functional-kind-eq fun nil assignment optional cleanup)
-              ;; Add type constraints from local call arguments. We
-              ;; clear the existing variable constraints first for
-              ;; local calls which participate in recursive
-              ;; dataflow. (e.g. an iterative loop written
-              ;; functionally instead of with SETQ)
+              ;; Add type constraints and any equality constraints
+              ;; from local call arguments. We clear the existing
+              ;; variable constraints first for local calls which
+              ;; participate in recursive dataflow. (e.g. an iterative
+              ;; loop written functionally instead of with SETQ)
               (let ((new (copy-conset gen))
                     (vars (lambda-vars fun))
                     (args (combination-args node)))
@@ -1453,9 +1453,19 @@
                 (loop for var in vars
                       for val in args
                       when (and val (lambda-var-constraints var))
-                        do (let ((type (lvar-type val)))
+                        do (let* ((arg-var (ok-lvar-lambda-var val gen))
+                                  (type (if arg-var
+                                            ;; Not strictly necessary
+                                            ;; to grab the type from
+                                            ;; constraints here
+                                            ;; straight away, but
+                                            ;; speeds up convergence.
+                                            (type-from-constraints arg-var gen (lvar-type val))
+                                            (lvar-type val))))
                              (when (type-for-constraints-p type)
-                               (conset-add-constraint new 'typep var type nil))))
+                               (conset-add-constraint new 'typep var type nil))
+                             (when arg-var
+                               (inherit-constraints (list var) arg-var gen new))))
                 (unless (and call-in (conset= call-in new))
                   (setf (combination-constraints-in node) new)
                   (when *constraint-blocks-p*
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 927df414e..d5bee63c9 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -6456,3 +6456,19 @@
            (funcall done nil))))
     ((t) nil)
     ((nil) nil)))
+
+(with-test (:name (:local-call-arg-type :constraint-eql-propagate))
+  (checked-compile '(lambda ()
+                     (declare (optimize speed))
+                     (labels ((phi (index)
+                                (declare (type (integer 0) index))
+                                (if (> index 9)
+                                    nil
+                                    (rec 0 index)))
+                              (rec (zoot gindex)
+                                (declare (fixnum zoot))
+                                (if (< zoot 5)
+                                    (rec (1+ zoot) gindex)
+                                    (phi (1+ gindex)))))
+                       (phi 0)))
+                   :allow-notes nil))

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


hooks/post-receive
-- 
SBCL