procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Optimise tail calls in and and or forms in cl-labels functions

Browse source 
* 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.
This commit is contained in:
Mattias Engdegård 2021-03-18 13:33:09 +01:00
parent ce1b4acd71
commit 52270aa0dc
2 changed files with 26 additions and 5 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
lisp/emacs-lisp/cl-macs.el
View file

@ -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

25
test/lisp/emacs-lisp/cl-macs-tests.el
View file

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