[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 612d731: Self-TCO in `condition-case` error handlers
From: |
Mattias Engdegård |
Subject: |
master 612d731: Self-TCO in `condition-case` error handlers |
Date: |
Fri, 9 Apr 2021 04:58:01 -0400 (EDT) |
branch: master
commit 612d73167688a9a9742478373933c4af5e3f8720
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
Self-TCO in `condition-case` error handlers
* lisp/emacs-lisp/cl-macs.el (cl--self-tco): Recognise
`condition-case` handlers as being in the tail position.
* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels):
Extend test.
---
lisp/emacs-lisp/cl-macs.el | 7 +++++++
test/lisp/emacs-lisp/cl-macs-tests.el | 14 ++++++++++++--
2 files changed, 19 insertions(+), 2 deletions(-)
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 27ed07b..68211ec 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -2141,6 +2141,13 @@ Like `cl-flet' but the definitions can refer to previous
ones.
;; tail-called any more.
(not (memq var shadowings)))))
`(,(car exp) ,bindings . ,(funcall opt-exps exps)))
+ ((and `(condition-case ,err-var ,bodyform . ,handlers)
+ (guard (not (eq err-var var))))
+ `(condition-case ,err-var
+ (progn (setq ,retvar ,bodyform) nil)
+ . ,(mapcar (lambda (h)
+ (cons (car h) (funcall opt-exps (cdr h))))
+ handlers)))
('nil nil) ;No need to set `retvar' to return nil.
(_ `(progn (setq ,retvar ,exp) nil))))))
diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el
b/test/lisp/emacs-lisp/cl-macs-tests.el
index dd64876..5c3e603 100644
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -629,14 +629,24 @@ collection clause."
(let (n1)
(and xs
(progn (setq n1 (1+ n))
- (len2 (cdr xs) n1)))))))
+ (len2 (cdr xs) n1))))))
+ ;; Tail call in error handler.
+ (len3 (xs n)
+ (if xs
+ (condition-case nil
+ (/ 1 0)
+ (arith-error (len3 (cdr xs) (1+ n))))
+ n)))
(should (equal (len nil 0) 0))
(should (equal (len2 nil 0) 0))
+ (should (equal (len3 nil 0) 0))
(should (equal (len list-42 0) 42))
(should (equal (len2 list-42 0) 42))
+ (should (equal (len3 list-42 0) 42))
;; Should not bump into stack depth limits.
(should (equal (len list-42k 0) 42000))
- (should (equal (len2 list-42k 0) 42000))))
+ (should (equal (len2 list-42k 0) 42000))
+ (should (equal (len3 list-42k 0) 42000))))
;; Check that non-recursive functions are handled more efficiently.
(should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5)))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 612d731: Self-TCO in `condition-case` error handlers,
Mattias Engdegård <=