master: assignment-convert: Handle tail calls and cleanups better (again).
apache--- via Sbcl-commits <[email protected]>
| Newsgroups | gmane.lisp.steel-bank.cvs |
|---|---|
| Message-ID | <[email protected]> |
The branch "master" has been updated in SBCL:
via 4189ab7f19e64417304a9c0fb6e0314158462bbb (commit)
from b561a0680fb5988b86ca18a54a943c0247682f81 (commit)
- Log -----------------------------------------------------------------
commit 4189ab7f19e64417304a9c0fb6e0314158462bbb
Author: Charles Zhang <[email protected]>
Date: Mon Aug 10 18:13:55 2026 +0200
assignment-convert: Handle tail calls and cleanups better (again).
Instead of trying to compare cleanups modulo harmlessness directly as
in the code disabled in 6cbab77cdb3f3674f423980eb749dbeab2c406cb,
check for harmlessness of the cleanup nesting from the call node to
the lambda block directly. This allows us to re-enable the Fluet &
Weeks tests.
We also catch another case of assignment conversion where mutually
tail recursive functions are entered by tail calls from different
functions.
---
src/compiler/locall.lisp | 33 ++++++++++++++++-----------------
tests/compiler-ir.pure.lisp | 37 +++++++++++++++++++++++++++----------
2 files changed, 43 insertions(+), 27 deletions(-)
diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index 82f6b37c6..2328edd00 100644
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -1653,40 +1653,39 @@
(return-ctran nil)
(return-lvar nil)
(return-env nil)
- (return-cleanup nil))
- (flet ((return-point-agrees-p (call)
- (let ((ctran (or (node-next call)
- (block-start (first (block-succ (node-block call))))))
+ (return-cleanup nil)
+ (return-harmless nil))
+ (flet ((return-point-agrees-p (call fun)
+ (let ((ctran (if (node-tail-p call)
+ :tail
+ (or (node-next call)
+ (block-start (first (block-succ (node-block call)))))))
(lvar (and (valued-node-p call)
(node-lvar call)))
(env (node-home-lambda call))
- (cleanup (node-enclosing-cleanup call)))
+ (cleanup (node-enclosing-cleanup call))
+ (harmless (only-harmless-cleanups (node-block call)
+ (lambda-block fun))))
(aver env)
(cond ((null return-env)
(setq return-ctran ctran
return-lvar lvar
return-env env
- return-cleanup cleanup)
+ return-cleanup cleanup
+ return-harmless harmless)
t)
(t
;; We can only convert multiple outside calls
;; when they are all in the same environment, so
;; we don't muck up tail sets. This is not a
;; conceptual restriction though; it may be
- ;; possible to lift this if things are
- ;; reworked. The cleanup checking here is also
- ;; overly conservative. A better approach would
- ;; be to check for harmful cleanups with respect
- ;; to the messiest common ancestor, though care
- ;; would need to be taken with cleanup emission
- ;; as merging lambdas will anchor to a specific
- ;; predecessor's lexenv/cleanup, not to the
- ;; ancestor's.
+ ;; possible to lift this if things are reworked.
(and (or (eq (node-derived-type call) *empty-type*)
(and (eq return-ctran ctran)
(eq return-lvar lvar)))
(eq return-env env)
- (eq return-cleanup cleanup)))))))
+ (or (eq return-cleanup cleanup)
+ (and return-harmless harmless))))))))
(dolist (fun group)
(unless (ok-initial-convert-p fun)
(return-from maybe-convert-group-to-assignment nil))
@@ -1700,7 +1699,7 @@
(cond ((memq (node-home-lambda ref) group)
(unless (node-tail-p call)
(return-from maybe-convert-group-to-assignment nil)))
- ((return-point-agrees-p call)
+ ((return-point-agrees-p call fun)
(push call outside-calls))
(t
(return-from maybe-convert-group-to-assignment nil)))))
diff --git a/tests/compiler-ir.pure.lisp b/tests/compiler-ir.pure.lisp
index e19da0a83..aea3bc772 100644
--- a/tests/compiler-ir.pure.lisp
+++ b/tests/compiler-ir.pure.lisp
@@ -303,17 +303,36 @@
(assert (eq (funcall fun -3) 'GOOD))
(assert assignment))))
+;;; Check that we can convert a group of mutually tail recursive
+;;; lambdas entered by tail calls.
+#+sb-devel
+(with-test (:name (:assignment-convert :group-entered-by-tail-calls))
+ (let ((converted '()))
+ (let ((fun (inspect-ir
+ '(lambda (n)
+ (labels ((my-even? (n)
+ (if (zerop n) t (my-odd? (1- n))))
+ (my-odd? (n)
+ (if (zerop n) nil (my-even? (1- n)))))
+ (if (plusp n)
+ (my-even? n)
+ (my-odd? n))))
+ (lambda (component)
+ (dolist (lambda (sb-c::component-lambdas component))
+ (dolist (lambda-let (sb-c::lambda-lets lambda))
+ (when (sb-c::functional-kind-eq lambda-let sb-c::assignment)
+ (push lambda-let converted))))))))
+ (assert (eq (funcall fun 4) t))
+ (assert (eq (funcall fun 7) nil))
+ (assert (eq (funcall fun 0) nil))
+ (assert (= (length converted) 2))))) ; MY-EVEN?, MY-ODD?
+
;;; The example in 5.1 of Fluet and Weeks "Contification using
;;; Dominators", which the A_cont analysis can handle, but A_call
;;; cannot. In this case, FM, F, G and H all have the same
;;; continuation.
#+sb-devel
-(with-test (:name (:assignment-convert :fluet-weeks-5.1)
- ;; Unfortunately, this test and the next few almost work
- ;; but are defeated by the block tags inserted by LABELS
- ;; since we don't have smart enough cleanup logic in the
- ;; assignment conversion code.
- :fails-on :sbcl)
+(with-test (:name (:assignment-convert :fluet-weeks-5.1))
(let ((converted '()))
(let ((fun (inspect-ir
'(lambda (b x y flag)
@@ -347,8 +366,7 @@
;;; A modified version of the above test, but with an outside call for
;;; H.
#+sb-devel
-(with-test (:name (:assignment-convert :fluet-weeks-5.1-modified)
- :fails-on :sbcl)
+(with-test (:name (:assignment-convert :fluet-weeks-5.1-modified))
(let ((converted '()))
(let ((fun (inspect-ir
'(lambda (b x y flag)
@@ -388,8 +406,7 @@
;;; analysis. In this case, F, G1, G2 and H all have the same
;;; continuation.
#+sb-devel
-(with-test (:name (:assignment-convert :fluet-weeks-5.2)
- :fails-on :sbcl)
+(with-test (:name (:assignment-convert :fluet-weeks-5.2))
(let ((converted '()))
(let ((fun (inspect-ir
'(lambda (b x y flag)
-----------------------------------------------------------------------
hooks/post-receive
--
SBCL