From 52270aa0dc3313f42986a07413bf5b600d9fecbe Mon Sep 17 00:00:00 2001 From: =?utf8?q?Mattias=20Engdeg=C3=A5rd?= Date: Thu, 18 Mar 2021 13:33:09 +0100 Subject: [PATCH] Optimise tail calls in `and` and `or` forms in `cl-labels` functions * lisp/emacs-lisp/cl-macs.el (cl--self-tco): Handle `and` and `or`. * test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels): Add test cases. --- lisp/emacs-lisp/cl-macs.el | 6 ++++++ test/lisp/emacs-lisp/cl-macs-tests.el | 25 ++++++++++++++++++++----- 2 files changed, 26 insertions(+), 5 deletions(-) diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index c38dc44ff60..73ff4e6fd09 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2100,6 +2100,12 @@ Like `cl-flet' but the definitions can refer to previous ones. (`(progn . ,exps) `(progn . ,(funcall opt-exps exps))) (`(if ,cond ,then . ,else) `(if ,cond ,(funcall opt then) . ,(funcall opt-exps else))) + (`(and . ,exps) `(and . ,(funcall opt-exps exps))) + (`(or ,arg) (funcall opt arg)) + (`(or ,arg . ,args) + (let ((val (make-symbol "val"))) + `(let ((,val ,arg)) + (if ,val ,(funcall opt val) ,(funcall opt `(or . ,args)))))) (`(cond . ,conds) (let ((cs '())) (while conds diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el index 2e5f3020b41..df1d26a074e 100644 --- a/test/lisp/emacs-lisp/cl-macs-tests.el +++ b/test/lisp/emacs-lisp/cl-macs-tests.el @@ -617,11 +617,26 @@ collection clause." (cl-labels ((len (xs) (if xs (1+ (len (cdr xs))) 0))) (should (equal (len (make-list 42 t)) 42))) - ;; Simple tail-recursive function. - (cl-labels ((len (xs n) (if xs (len (cdr xs) (1+ n)) n))) - (should (equal (len (make-list 42 t) 0) 42)) - ;; Should not bump into stack depth limits. - (should (equal (len (make-list 42000 t) 0) 42000))) + (let ((list-42 (make-list 42 t)) + (list-42k (make-list 42000 t))) + + (cl-labels + ;; Simple tail-recursive function. + ((len (xs n) (if xs (len (cdr xs) (1+ n)) n)) + ;; Slightly obfuscated version to exercise tail calls from + ;; `let', `progn', `and' and `or'. + (len2 (xs n) (or (and (not xs) n) + (let (n1) + (and xs + (progn (setq n1 (1+ n)) + (len2 (cdr xs) n1))))))) + (should (equal (len nil 0) 0)) + (should (equal (len2 nil 0) 0)) + (should (equal (len list-42 0) 42)) + (should (equal (len2 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)))) ;; Check that non-recursive functions are handled more efficiently. (should (pcase (macroexpand '(cl-labels ((f (x) (+ x 1))) (f 5))) -- 2.39.5