From 612d73167688a9a9742478373933c4af5e3f8720 Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 8 Apr 2021 22:48:02 +0200 Subject: [PATCH] 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 27ed07b6673..68211ec4106 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 dd6487603d3..5c3e603b92e 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))) -- 2.39.5