* lisp/subr.el (letrec): Optimize some non-recursive bindings

* lisp/emacs-lisp/macroexp.el (macroexp--fgrep): Look inside bytecode
objects as well.

* test/lisp/emacs-lisp/cl-macs-tests.el (cl-macs--labels):
* test/lisp/subr-tests.el (subr--tests-letrec): New tests.

diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index d5fda528b4f8560a7abd2c737f98e111f868f176..37844977f8f8236103b3412e7c27ba86fd2a8bd3 100644 (file)
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -499,7 +499,7 @@ test of free variables in the following ways:
       (dolist (binding (macroexp--fgrep bindings (pop sexp)))
         (push binding res)
         (setq bindings (remove binding bindings))))
-    (if (vectorp sexp)
+    (if (or (vectorp sexp) (byte-code-function-p sexp))
         ;; With backquote, code can appear within vectors as well.
         ;; This wouldn't be needed if we `macroexpand-all' before
         ;; calling macroexp--fgrep, OTOH.

diff --git a/lisp/subr.el b/lisp/subr.el
index b92744cdcbe5893f3e50c8ad1c177f120acb5317..bc0c41799044790b3d9e8bda19ae4c9d42c56be8 100644 (file)
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -1874,9 +1874,28 @@ all symbols are bound before any of the VALUEFORMs are evalled."
   ;; As a special-form, we could implement it more efficiently (and cleanly,
   ;; making the vars actually unbound during evaluation of the binders).
   (declare (debug let) (indent 1))
-  `(let ,(mapcar #'car binders)
-     ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
-     ,@body))
+  ;; Use plain `let*' for the non-recursive definitions.
+  ;; This only handles the case where the first few definitions are not
+  ;; recursive.  Nothing as fancy as an SCC analysis.
+  (let ((seqbinds nil))
+    ;; Our args haven't yet been macro-expanded, so `macroexp--fgrep'
+    ;; may fail to see references that will be introduced later by
+    ;; macroexpansion.  We could call `macroexpand-all' to avoid that,
+    ;; but in order to avoid that, we instead check to see if the binders
+    ;; appear in the macroexp environment, since that's how references can be
+    ;; introduced later on.
+    (unless (macroexp--fgrep binders macroexpand-all-environment)
+      (while (and binders
+                  (null (macroexp--fgrep binders (nth 1 (car binders)))))
+        (push (pop binders) seqbinds)))
+    (let ((nbody (if (null binders)
+                     (macroexp-progn body)
+                   `(let ,(mapcar #'car binders)
+                      ,@(mapcar (lambda (binder) `(setq ,@binder)) binders)
+                      ,@body))))
+      (if seqbinds
+          `(let* ,(nreverse seqbinds) ,nbody)
+        nbody))))
 
 (defmacro dlet (binders &rest body)
   "Like `let*' but using dynamic scoping."

diff --git a/test/lisp/emacs-lisp/cl-macs-tests.el b/test/lisp/emacs-lisp/cl-macs-tests.el
index 446983c2e3e107654286e750264610f5dc1f52da..7774ed3145b4e4f951285173cc032dc35dd58a72 100644 (file)
--- a/test/lisp/emacs-lisp/cl-macs-tests.el
+++ b/test/lisp/emacs-lisp/cl-macs-tests.el
@@ -610,4 +610,12 @@ collection clause."
     ;; Just make sure the function can be instrumented.
     (edebug-defun)))
 
+;;; cl-labels
+
+(ert-deftest cl-macs--labels ()
+  ;; Simple recursive function.
+  (cl-labels ((len (xs) (if xs (1+ (len (cdr xs))) 0)))
+    (should (equal (len (make-list 42 t)) 42)))
+  )
+
 ;;; cl-macs-tests.el ends here

diff --git a/test/lisp/subr-tests.el b/test/lisp/subr-tests.el
index 21185303360e351c1eb077c17f7d5e6302af57c6..e0826208b60a51f26b1cec65a3c05fea79cac4b9 100644 (file)
--- a/test/lisp/subr-tests.el
+++ b/test/lisp/subr-tests.el
@@ -433,6 +433,15 @@ See https://debbugs.gnu.org/cgi/bugreport.cgi?bug=19350."
   (should (equal (flatten-tree '(1 ("foo" "bar") 2))
                  '(1 "foo" "bar" 2))))
 
+(ert-deftest subr--tests-letrec ()
+  ;; Test that simple cases of `letrec' get optimized back to `let*'.
+  (should (equal (macroexpand '(letrec ((subr-tests-var1 1)
+                                        (subr-tests-var2 subr-tests-var1))
+                                 (+ subr-tests-var1 subr-tests-var2)))
+                 '(let* ((subr-tests-var1 1)
+                         (subr-tests-var2 subr-tests-var1))
+                    (+ subr-tests-var1 subr-tests-var2)))))
+
 (defvar subr-tests--hook nil)
 
 (ert-deftest subr-tests-add-hook-depth ()