emacs-diffs
[Top][All Lists]
Advanced

[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)))



reply via email to

[Prev in Thread] Current Thread [Next in Thread]