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.

diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index c38dc44ff60ea0d50411a6c201cadbdf29428420..73ff4e6fd09f0b1e0b4d503130fb299f1754d9a2 100644 (file)
--- 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 2e5f3020b419f7b99fe860564d155748fbd4ee94..df1d26a074e1d8881e688d12d454bf868710bdaf 100644 (file)
--- 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)))