master: Prevent var substitution with lvar-type-annotations

The branch "master" has been updated in SBCL:
       via  5f08e87681157259a06c3321fd795051e619f223 (commit)
      from  e1e0e2df5cfbc661d34da9cc89864218e2f3e8ae (commit)

- Log -----------------------------------------------------------------
commit 5f08e87681157259a06c3321fd795051e619f223
Author: Stas Boukarev <[email protected]>
Date:   Sun Aug 16 17:24:22 2026 +0300

    Prevent var substitution with lvar-type-annotations
    
    Which might cause type conflicts in new refs.
    This might make some things opaque, but type-annotations are used only
    in very specific cases, and preserving control flow with casts or
    combinations will be just as opaque.
---
 src/compiler/debug.lisp    | 12 +++++++++---
 src/compiler/ir1opt.lisp   | 13 ++++++++++---
 src/compiler/node.lisp     |  6 ++++++
 tests/compiler-2.pure.lisp |  7 +++++++
 4 files changed, 32 insertions(+), 6 deletions(-)

diff --git a/src/compiler/debug.lisp b/src/compiler/debug.lisp
index 3d36eb136..2d805f54e 100644
--- a/src/compiler/debug.lisp
+++ b/src/compiler/debug.lisp
@@ -27,6 +27,11 @@
 (defvar *seen-blocks*)
 (defvar *seen-funs*)
 
+(defvar *debug-print-types* nil)
+(defvar *debug-print-vop-temps* nil)
+#+sb-devel
+(defvar *debug-print-lvar-annotations* nil)
+
 ;;; Barf if NODE is in a block which wasn't reached during the graph
 ;;; walk.
 (defun check-node-reached (node)
@@ -980,6 +985,10 @@
                :unknown))
       (format t "uv~D " (cont-num cont))
       (format t "v~D " (cont-num cont)))
+  #+sb-devel
+  (when (and *debug-print-lvar-annotations*
+             (lvar-annotations cont))
+    (format t "~a " (lvar-annotations cont)))
   (values))
 
 (defun print-lvar-stack (stack &optional (stream *standard-output*))
@@ -989,9 +998,6 @@
                    (cont-num lvar)
                    rest)))
 
-(defvar *debug-print-types* nil)
-(defvar *debug-print-vop-temps* nil)
-
 ;;; Print out the nodes in BLOCK in a format oriented toward
 ;;; representing what the code does.
 (defun print-nodes (block)
diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index d24d40e1e..27a93a6af 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -2884,9 +2884,16 @@
                                          ;; (NODE-DERIVED-TYPE USE) would
                                          ;; be better -- APD, 2003-05-15
                                          (leaf-type var)))
-                     (propagate-lvar-annotations-to-refs arg var)
+
                      (propagate-to-refs var type)
-                     (unless (preserve-single-use-debug-var-p call var)
+                     ;; Don't substitute lvars with type annotations,
+                     ;; which might cause type conflicts in new refs.
+                     ;; This might make some things opaque, but type-annotations
+                     ;; are used only in very specific cases, and preserving
+                     ;; control flow with casts or combinations will be just as opaque.
+                     (unless (or (preserve-single-use-debug-var-p call var)
+                                 (find-if #'lvar-type-annotation-p (lvar-annotations arg)))
+                       (propagate-lvar-annotations-to-refs arg var)
                        (update-lvar-dependencies leaf arg)
                        (propagate-ref-dx use arg var)
                        (let ((use-component (node-component use)))
@@ -2902,7 +2909,7 @@
              (not (preserve-single-use-debug-var-p call var))
              (substitute-single-use-lvar arg var)))
        (t
-         (propagate-to-refs var type))))
+        (propagate-to-refs var type))))
    call
    :reoptimize t)
 
diff --git a/src/compiler/node.lisp b/src/compiler/node.lisp
index 3f13a16e0..b365f95c0 100644
--- a/src/compiler/node.lisp
+++ b/src/compiler/node.lisp
@@ -241,6 +241,7 @@
   lexenv
   fired)
 
+#+sb-devel
 (defprinter (lvar-annotation)
   fired)
 
@@ -287,6 +288,11 @@
   type
   context)
 
+#+sb-devel
+(defprinter (lvar-type-annotation)
+  fired
+  (type :princ (type-specifier type)))
+
 (defstruct (lvar-function-annotation
             (:include lvar-type-annotation)
             (:copier nil)))
diff --git a/tests/compiler-2.pure.lisp b/tests/compiler-2.pure.lisp
index 62872761f..7d6fc4128 100644
--- a/tests/compiler-2.pure.lisp
+++ b/tests/compiler-2.pure.lisp
@@ -5155,3 +5155,10 @@
                  (elt '(3 4) b)))
     ((0) (values 1 3))
     ((1) (values 2 4))))
+
+(with-test (:name :annotations-traveling-type-conflicts)
+  (checked-compile
+   `(lambda (x)
+      (let ((g (sb-kernel:the* (symbol :use-annotations t) x)))
+        (unless (typep g 'symbol)
+          g)))))

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


hooks/post-receive
-- 
SBCL