[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 52270aa: Optimise tail calls in `and` and `or` forms in `cl-label
From: |
Mattias Engdegård |
Subject: |
master 52270aa: Optimise tail calls in `and` and `or` forms in `cl-labels` functions |
Date: |
Thu, 18 Mar 2021 08:37:57 -0400 (EDT) |
branch: master
commit 52270aa0dc3313f42986a07413bf5b600d9fecbe
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
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 c38dc44..73ff4e6 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 2e5f302..df1d26a 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)))
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 52270aa: Optimise tail calls in `and` and `or` forms in `cl-labels` functions,
Mattias Engdegård <=