master: Skip common subexpr elim for lambda enclosed in a let

snuglas via Sbcl-commits <[email protected]> Tue, 04 Aug 2026 02:24:52 +0000
Newsgroups gmane.lisp.steel-bank.cvs
Message-ID <[email protected]>
The branch "master" has been updated in SBCL:
       via  9c53205f5f2eebe979d5b106030104c490633f5d (commit)
      from  100c9c2bdcdcb84ff04c8feef983a5b44695c97a (commit)

- Log -----------------------------------------------------------------
commit 9c53205f5f2eebe979d5b106030104c490633f5d
Author: Douglas Katzman <[email protected]>
Date:   Tue Aug 4 02:23:32 2026 +0000

    Skip common subexpr elim for lambda enclosed in a let
---
 src/compiler/ir1opt.lisp | 17 ++++++++++-------
 tests/lcse.impure.lisp   | 15 +++++++++++++++
 2 files changed, 25 insertions(+), 7 deletions(-)

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index dac393e31..6377d5aeb 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -1233,13 +1233,16 @@
 
 (defun find-active-let-lambda (node)
   (declare (type node node))
-  (loop for env = (node-lexenv node) then (lexenv-parent env)
-        while env
-        do (let ((l (lexenv-lambda env)))
-             (when (and l
-                        (functional-kind-eq l let)
-                        (not (functional-kind-eq l zombie)))
-               (return l)))))
+  (let ((home (node-home-lambda node)))
+    (loop for env = (node-lexenv node) then (lexenv-parent env)
+          while env
+          do (let ((l (lexenv-lambda env)))
+               (when l
+                 (unless (eq (lambda-home l) home)
+                   (return nil))
+                 (when (and (functional-kind-eq l let)
+                            (not (functional-kind-eq l zombie)))
+                   (return l)))))))
 
 (defun add-variable-to-let-lambda (let-lambda v)
   (declare (type clambda let-lambda)
diff --git a/tests/lcse.impure.lisp b/tests/lcse.impure.lisp
new file mode 100644
index 000000000..8261b0f03
--- /dev/null
+++ b/tests/lcse.impure.lisp
@@ -0,0 +1,15 @@
+(setq *evaluator-mode* :compile)
+
+(defstruct s
+  (x (make-array 3)))
+
+;; Don't creash evaluating this.
+;; The bug was that local common subexpression elimintation tried to add
+;; a REUSE-VAR binding into the LET which bound * instead of just giving up.
+(let (*)
+  (lambda ()
+    (let* ((s #.(make-s))
+           (a (s-x s))
+           (b (s-x s)))
+      (values (aref a 0)
+              (aref b 0)))))

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


hooks/post-receive
-- 
SBCL