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