Get rid of cl-lexical-let, keeping only lexical-let for compatibility.

* lisp/emacs-lisp/cl-macs.el: Provide itself.
(cl--labels-convert-cache): New var.
(cl--labels-convert): New function.
(cl-flet, cl-labels): New implementation with new semantics, relying on
lexical-binding.
* lisp/emacs-lisp/cl.el: Mark compatibility aliases as obsolete.
(cl-closure-vars, cl--function-convert-cache)
(cl--function-convert): Move from cl-macs.el.
(lexical-let, lexical-let*, flet, labels): Move from cl-macs.el and
rename by removing the "cl-" prefix.
* lisp/emacs-lisp/macroexp.el (macroexp-unprogn): New function.

5 files changed, 264 insertions, 202 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 07b330a3e6e..3085da7ee79 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,18 @@
+2012-06-08  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        Get rid of cl-lexical-let, keeping only lexical-let for compatibility.
+        * emacs-lisp/cl-macs.el: Provide itself.
+        (cl--labels-convert-cache): New var.
+        (cl--labels-convert): New function.
+        (cl-flet, cl-labels): New implementation with new semantics, relying on
+        lexical-binding.
+        * emacs-lisp/cl.el: Mark compatibility aliases as obsolete.
+        (cl-closure-vars, cl--function-convert-cache)
+        (cl--function-convert): Move from cl-macs.el.
+        (lexical-let, lexical-let*, flet, labels): Move from cl-macs.el and
+        rename by removing the "cl-" prefix.
+        * emacs-lisp/macroexp.el (macroexp-unprogn): New function.
+
 2012-06-07  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * emacs-lisp/cl.el (cl-macroexpand, cl-macro-environment)
diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el
index 2d7c9153318..95716ae2e29 100644
--- a/lisp/emacs-lisp/cl-loaddefs.el
+++ b/lisp/emacs-lisp/cl-loaddefs.el
@@ -258,13 +258,12 @@ Remove from SYMBOL's plist the property PROPNAME and its value.
 ;;;;;;  cl-letf cl-rotatef cl-shiftf cl-remf cl-do-pop cl-psetf cl-setf
 ;;;;;;  cl-get-setf-method cl-defsetf cl-define-setf-expander cl-declare
 ;;;;;;  cl-the cl-locally cl-multiple-value-setq cl-multiple-value-bind
-;;;;;;  cl-lexical-let* cl-lexical-let cl-symbol-macrolet cl-macrolet
-;;;;;;  cl-labels cl-flet cl-progv cl-psetq cl-do-all-symbols cl-do-symbols
-;;;;;;  cl-dotimes cl-dolist cl-do* cl-do cl-loop cl-return-from
-;;;;;;  cl-return cl-block cl-etypecase cl-typecase cl-ecase cl-case
-;;;;;;  cl-load-time-value cl-eval-when cl-destructuring-bind cl-function
-;;;;;;  cl-defmacro cl-defun cl-gentemp cl-gensym) "cl-macs" "cl-macs.el"
-;;;;;;  "c1e8e5391e374630452ab3d78e527086")
+;;;;;;  cl-symbol-macrolet cl-macrolet cl-labels cl-flet cl-progv
+;;;;;;  cl-psetq cl-do-all-symbols cl-do-symbols cl-dotimes cl-dolist
+;;;;;;  cl-do* cl-do cl-loop cl-return-from cl-return cl-block cl-etypecase
+;;;;;;  cl-typecase cl-ecase cl-case cl-load-time-value cl-eval-when
+;;;;;;  cl-destructuring-bind cl-function cl-defmacro cl-defun cl-gentemp
+;;;;;;  cl-gensym) "cl-macs" "cl-macs.el" "4c0f605e3c7454488cc9d498b611f422")
 ;;; Generated autoloads from cl-macs.el
 
 (autoload 'cl-gensym "cl-macs" "\
@@ -485,10 +484,7 @@ a `let' form, except that the list of symbols can be computed at run-time.
 
 (autoload 'cl-flet "cl-macs" "\
 Make temporary function definitions.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell.  The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof).
+Like `cl-labels' but the definitions are not recursive.
 
 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
 
@@ -496,8 +492,7 @@ go back to their previous definitions, or lack thereof).
 
 (autoload 'cl-labels "cl-macs" "\
 Make temporary function bindings.
-This is like `cl-flet', except the bindings are lexical instead of dynamic.
-Unlike `cl-flet', this macro is fully compliant with the Common Lisp standard.
+The bindings can be recursive.  Assumes the use of `lexical-binding'.
 
 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" nil t)
 
@@ -520,26 +515,6 @@ by EXPANSION, and (setq NAME ...) will act like (cl-setf EXPANSION ...).
 
 (put 'cl-symbol-macrolet 'lisp-indent-function '1)
 
-(autoload 'cl-lexical-let "cl-macs" "\
-Like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp.
-
-\(fn BINDINGS BODY)" nil t)
-
-(put 'cl-lexical-let 'lisp-indent-function '1)
-
-(autoload 'cl-lexical-let* "cl-macs" "\
-Like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY, and in
-successive bindings within BINDINGS, will create lexical closures
-as in Common Lisp.  This is similar to the behavior of `let*' in
-Common Lisp.
-
-\(fn BINDINGS BODY)" nil t)
-
-(put 'cl-lexical-let* 'lisp-indent-function '1)
-
 (autoload 'cl-multiple-value-bind "cl-macs" "\
 Collect multiple return values.
 FORM must return a list; the BODY is then executed with the first N elements
diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el
index 91d7c211483..4d8e4f39214 100644
--- a/lisp/emacs-lisp/cl-macs.el
+++ b/lisp/emacs-lisp/cl-macs.el
@@ -1611,63 +1611,70 @@ a `let' form, except that the list of symbols can be computed at run-time."
          (progn (cl-progv-before ,symbols ,values) ,@body)
        (cl-progv-after))))
 
+(defvar cl--labels-convert-cache nil)
+
+(defun cl--labels-convert (f)
+  "Special macro-expander to rename (function F) references in `cl-labels'."
+  (cond
+   ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
+   ;; *after* handling `function', but we want to stop macroexpansion from
+   ;; being applied infinitely, so we use a cache to return the exact `form'
+   ;; being expanded even though we don't receive it.
+   ((eq f (car cl--labels-convert-cache)) (cdr cl--labels-convert-cache))
+   (t
+    (let ((found (assq f macroexpand-all-environment)))
+      (if (and found (ignore-errors
+                       (eq (cadr (cl-caddr found)) 'cl-labels-args)))
+          (cadr (cl-caddr (cl-cadddr found)))
+        (let ((res `(function ,f)))
+          (setq cl--labels-convert-cache (cons f res))
+          res))))))
+
 ;;; This should really have some way to shadow 'byte-compile properties, etc.
 ;;;###autoload
 (defmacro cl-flet (bindings &rest body)
   "Make temporary function definitions.
-This is an analogue of `let' that operates on the function cell of FUNC
-rather than its value cell.  The FORMs are evaluated with the specified
-function definitions in place, then the definitions are undone (the FUNCs
-go back to their previous definitions, or lack thereof).
+Like `cl-labels' but the definitions are not recursive.
 
 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
   (declare (indent 1) (debug ((&rest (cl-defun)) cl-declarations body)))
-  `(cl-letf* ,(mapcar
-            (lambda (x)
-              (if (or (and (fboundp (car x))
-                           (eq (car-safe (symbol-function (car x))) 'macro))
-                      (cdr (assq (car x) macroexpand-all-environment)))
-                  (error "Use `cl-labels', not `cl-flet', to rebind macro names"))
-              (let ((func `(cl-function
-                            (lambda ,(cadr x)
-                              (cl-block ,(car x) ,@(cddr x))))))
-                (when (cl-compiling-file)
-                  ;; Bug#411.  It would be nice to fix this.
-                  (and (get (car x) 'byte-compile)
-                       (error "Byte-compiling a redefinition of `%s' \
-will not work - use `cl-labels' instead" (symbol-name (car x))))
-                  ;; FIXME This affects the rest of the file, when it
-                  ;; should be restricted to the cl-flet body.
-                  (and (boundp 'byte-compile-function-environment)
-                       (push (cons (car x) (eval func))
-                             byte-compile-function-environment)))
-                (list `(symbol-function ',(car x)) func)))
-            bindings)
-     ,@body))
+  (let ((binds ()) (newenv macroexpand-all-environment))
+    (dolist (binding bindings)
+      (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+        (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+        (push (cons (car binding)
+                    `(lambda (&rest cl-labels-args)
+                       (cl-list* 'funcall ',var
+                                 cl-labels-args)))
+              newenv)))
+    `(let ,(nreverse binds)
+       ,@(macroexp-unprogn
+          (macroexpand-all
+           `(progn ,@body)
+           ;; Don't override lexical-let's macro-expander.
+           (if (assq 'function newenv) newenv
+             (cons (cons 'function #'cl--labels-convert) newenv)))))))
 
 ;;;###autoload
 (defmacro cl-labels (bindings &rest body)
   "Make temporary function bindings.
-This is like `cl-flet', except the bindings are lexical instead of dynamic.
-Unlike `cl-flet', this macro is fully compliant with the Common Lisp standard.
+The bindings can be recursive.  Assumes the use of `lexical-binding'.
 
 \(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
   (declare (indent 1) (debug cl-flet))
-  (let ((vars nil) (sets nil) (newenv macroexpand-all-environment))
-    (while bindings
-      ;; Use `cl-gensym' rather than `make-symbol'.  It's important that
-      ;; (not (eq (symbol-name var1) (symbol-name var2))) because these
-      ;; vars get added to the cl-macro-environment.
-      (let ((var (cl-gensym "--cl-var--")))
-        (push var vars)
-        (push `(cl-function (lambda . ,(cdar bindings))) sets)
-        (push var sets)
-        (push (cons (car (pop bindings))
+  (let ((binds ()) (newenv macroexpand-all-environment))
+    (dolist (binding bindings)
+      (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+        (push (list var `(cl-function (lambda . ,(cdr binding)))) binds)
+        (push (cons (car binding)
                     `(lambda (&rest cl-labels-args)
                        (cl-list* 'funcall ',var
                                  cl-labels-args)))
               newenv)))
-    (macroexpand-all `(cl-lexical-let ,vars (setq ,@sets) ,@body) newenv)))
+    (macroexpand-all `(letrec ,(nreverse binds) ,@body)
+                     ;; Don't override lexical-let's macro-expander.
+                     (if (assq 'function newenv) newenv
+                       (cons (cons 'function #'cl--labels-convert) newenv)))))
 
 ;; The following ought to have a better definition for use with newer
 ;; byte compilers.
@@ -1750,119 +1757,6 @@ by EXPANSION, and (setq NAME ...) will act like (cl-setf EXPANSION ...).
                                    macroexpand-all-environment)))
         (fset 'macroexpand previous-macroexpand))))))
 
-(defvar cl-closure-vars nil)
-(defvar cl--function-convert-cache nil)
-
-(defun cl--function-convert (f)
-  "Special macro-expander for special cases of (function F).
-The two cases that are handled are:
-- closure-conversion of lambda expressions for `cl-lexical-let'.
-- renaming of F when it's a function defined via `cl-labels'."
-  (cond
-   ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
-   ;; *after* handling `function', but we want to stop macroexpansion from
-   ;; being applied infinitely, so we use a cache to return the exact `form'
-   ;; being expanded even though we don't receive it.
-   ((eq f (car cl--function-convert-cache)) (cdr cl--function-convert-cache))
-   ((eq (car-safe f) 'lambda)
-    (let ((body (mapcar (lambda (f)
-                          (macroexpand-all f macroexpand-all-environment))
-                        (cddr f))))
-      (if (and cl-closure-vars
-               (cl--expr-contains-any body cl-closure-vars))
-          (let* ((new (mapcar 'cl-gensym cl-closure-vars))
-                 (sub (cl-pairlis cl-closure-vars new)) (decls nil))
-            (while (or (stringp (car body))
-                       (eq (car-safe (car body)) 'interactive))
-              (push (list 'quote (pop body)) decls))
-            (put (car (last cl-closure-vars)) 'used t)
-            `(list 'lambda '(&rest --cl-rest--)
-                   ,@(cl-sublis sub (nreverse decls))
-                   (list 'apply
-                         (list 'quote
-                               #'(lambda ,(append new (cadr f))
-                                   ,@(cl-sublis sub body)))
-                         ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
-                                          cl-closure-vars)
-                                  '((quote --cl-rest--))))))
-        (let* ((newf `(lambda ,(cadr f) ,@body))
-               (res `(function ,newf)))
-          (setq cl--function-convert-cache (cons newf res))
-          res))))
-   (t
-    (let ((found (assq f macroexpand-all-environment)))
-      (if (and found (ignore-errors
-                       (eq (cadr (cl-caddr found)) 'cl-labels-args)))
-          (cadr (cl-caddr (cl-cadddr found)))
-        (let ((res `(function ,f)))
-          (setq cl--function-convert-cache (cons f res))
-          res))))))
-
-;;;###autoload
-(defmacro cl-lexical-let (bindings &rest body)
-  "Like `let', but lexically scoped.
-The main visible difference is that lambdas inside BODY will create
-lexical closures as in Common Lisp.
-\n(fn BINDINGS BODY)"
-  (declare (indent 1) (debug let))
-  (let* ((cl-closure-vars cl-closure-vars)
-         (vars (mapcar (function
-                        (lambda (x)
-                          (or (consp x) (setq x (list x)))
-                          (push (make-symbol (format "--cl-%s--" (car x)))
-                                cl-closure-vars)
-                          (set (car cl-closure-vars) [bad-lexical-ref])
-                          (list (car x) (cadr x) (car cl-closure-vars))))
-                       bindings))
-         (ebody
-          (macroexpand-all
-           `(cl-symbol-macrolet
-                ,(mapcar (lambda (x)
-                           `(,(car x) (symbol-value ,(cl-caddr x))))
-                         vars)
-              ,@body)
-           (cons (cons 'function #'cl--function-convert)
-                 macroexpand-all-environment))))
-    (if (not (get (car (last cl-closure-vars)) 'used))
-        ;; Turn (let ((foo (cl-gensym)))
-        ;;        (set foo <val>) ...(symbol-value foo)...)
-        ;; into (let ((foo <val>)) ...(symbol-value 'foo)...).
-        ;; This is good because it's more efficient but it only works with
-        ;; dynamic scoping, since with lexical scoping we'd need
-        ;; (let ((foo <val>)) ...foo...).
-        `(progn
-           ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars)
-           (let ,(mapcar (lambda (x) (list (cl-caddr x) (cadr x))) vars)
-           ,(cl-sublis (mapcar (lambda (x)
-                              (cons (cl-caddr x)
-                                    `',(cl-caddr x)))
-                            vars)
-                    ebody)))
-      `(let ,(mapcar (lambda (x)
-                       (list (cl-caddr x)
-                             `(make-symbol ,(format "--%s--" (car x)))))
-                     vars)
-         (cl-setf ,@(apply #'append
-                        (mapcar (lambda (x)
-                                  (list `(symbol-value ,(cl-caddr x)) (cadr x)))
-                                vars)))
-         ,ebody))))
-
-;;;###autoload
-(defmacro cl-lexical-let* (bindings &rest body)
-  "Like `let*', but lexically scoped.
-The main visible difference is that lambdas inside BODY, and in
-successive bindings within BINDINGS, will create lexical closures
-as in Common Lisp.  This is similar to the behavior of `let*' in
-Common Lisp.
-\n(fn BINDINGS BODY)"
-  (declare (indent 1) (debug let))
-  (if (null bindings) (cons 'progn body)
-    (setq bindings (reverse bindings))
-    (while bindings
-      (setq body (list `(cl-lexical-let (,(pop bindings)) ,@body))))
-    (car body)))
-
 ;;; Multiple values.
 
 ;;;###autoload
@@ -3211,4 +3105,6 @@ surrounded by (cl-block NAME ...).
 ;; generated-autoload-file: "cl-loaddefs.el"
 ;; End:
 
+(provide 'cl-macs)
+
 ;;; cl-macs.el ends here
diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el
index b4be63f2bb1..d162a377f9b 100644
--- a/lisp/emacs-lisp/cl.el
+++ b/lisp/emacs-lisp/cl.el
@@ -28,6 +28,7 @@
 ;;; Code:
 
 (require 'cl-lib)
+(require 'macroexp)
 
 ;; (defun cl--rename ()
 ;;   (let ((vdefs ())
@@ -226,11 +227,8 @@
                locally
                multiple-value-setq
                multiple-value-bind
-               lexical-let*
-               lexical-let
                symbol-macrolet
                macrolet
-               labels
                flet
                progv
                psetq
@@ -330,12 +328,181 @@
       (if (get new prop)
         (put fun prop (get new prop))))))
 
+(defvar cl-closure-vars nil)
+(defvar cl--function-convert-cache nil)
+
+(defun cl--function-convert (f)
+  "Special macro-expander for special cases of (function F).
+The two cases that are handled are:
+- closure-conversion of lambda expressions for `lexical-let'.
+- renaming of F when it's a function defined via `cl-labels' or `labels'."
+  (require 'cl-macs)
+  (cond
+   ;; ¡¡Big Ugly Hack!! We can't use a compiler-macro because those are checked
+   ;; *after* handling `function', but we want to stop macroexpansion from
+   ;; being applied infinitely, so we use a cache to return the exact `form'
+   ;; being expanded even though we don't receive it.
+   ((eq f (car cl--function-convert-cache)) (cdr cl--function-convert-cache))
+   ((eq (car-safe f) 'lambda)
+    (let ((body (mapcar (lambda (f)
+                          (macroexpand-all f macroexpand-all-environment))
+                        (cddr f))))
+      (if (and cl-closure-vars
+               (cl--expr-contains-any body cl-closure-vars))
+          (let* ((new (mapcar 'cl-gensym cl-closure-vars))
+                 (sub (cl-pairlis cl-closure-vars new)) (decls nil))
+            (while (or (stringp (car body))
+                       (eq (car-safe (car body)) 'interactive))
+              (push (list 'quote (pop body)) decls))
+            (put (car (last cl-closure-vars)) 'used t)
+            `(list 'lambda '(&rest --cl-rest--)
+                   ,@(cl-sublis sub (nreverse decls))
+                   (list 'apply
+                         (list 'quote
+                               #'(lambda ,(append new (cadr f))
+                                   ,@(cl-sublis sub body)))
+                         ,@(nconc (mapcar (lambda (x) `(list 'quote ,x))
+                                          cl-closure-vars)
+                                  '((quote --cl-rest--))))))
+        (let* ((newf `(lambda ,(cadr f) ,@body))
+               (res `(function ,newf)))
+          (setq cl--function-convert-cache (cons newf res))
+          res))))
+   (t
+    (let ((found (assq f macroexpand-all-environment)))
+      (if (and found (ignore-errors
+                       (eq (cadr (cl-caddr found)) 'cl-labels-args)))
+          (cadr (cl-caddr (cl-cadddr found)))
+        (let ((res `(function ,f)))
+          (setq cl--function-convert-cache (cons f res))
+          res))))))
+
+(defmacro lexical-let (bindings &rest body)
+  "Like `let', but lexically scoped.
+The main visible difference is that lambdas inside BODY will create
+lexical closures as in Common Lisp.
+\n(fn BINDINGS BODY)"
+  (declare (indent 1) (debug let))
+  (let* ((cl-closure-vars cl-closure-vars)
+         (vars (mapcar (function
+                        (lambda (x)
+                          (or (consp x) (setq x (list x)))
+                          (push (make-symbol (format "--cl-%s--" (car x)))
+                                cl-closure-vars)
+                          (set (car cl-closure-vars) [bad-lexical-ref])
+                          (list (car x) (cadr x) (car cl-closure-vars))))
+                       bindings))
+         (ebody
+          (macroexpand-all
+           `(cl-symbol-macrolet
+                ,(mapcar (lambda (x)
+                           `(,(car x) (symbol-value ,(cl-caddr x))))
+                         vars)
+              ,@body)
+           (cons (cons 'function #'cl--function-convert)
+                 macroexpand-all-environment))))
+    (if (not (get (car (last cl-closure-vars)) 'used))
+        ;; Turn (let ((foo (cl-gensym)))
+        ;;        (set foo <val>) ...(symbol-value foo)...)
+        ;; into (let ((foo <val>)) ...(symbol-value 'foo)...).
+        ;; This is good because it's more efficient but it only works with
+        ;; dynamic scoping, since with lexical scoping we'd need
+        ;; (let ((foo <val>)) ...foo...).
+        `(progn
+           ,@(mapcar (lambda (x) `(defvar ,(cl-caddr x))) vars)
+           (let ,(mapcar (lambda (x) (list (cl-caddr x) (cadr x))) vars)
+           ,(cl-sublis (mapcar (lambda (x)
+                              (cons (cl-caddr x)
+                                    `',(cl-caddr x)))
+                            vars)
+                    ebody)))
+      `(let ,(mapcar (lambda (x)
+                       (list (cl-caddr x)
+                             `(make-symbol ,(format "--%s--" (car x)))))
+                     vars)
+         (cl-setf ,@(apply #'append
+                        (mapcar (lambda (x)
+                                  (list `(symbol-value ,(cl-caddr x)) (cadr x)))
+                                vars)))
+         ,ebody))))
+
+(defmacro lexical-let* (bindings &rest body)
+  "Like `let*', but lexically scoped.
+The main visible difference is that lambdas inside BODY, and in
+successive bindings within BINDINGS, will create lexical closures
+as in Common Lisp.  This is similar to the behavior of `let*' in
+Common Lisp.
+\n(fn BINDINGS BODY)"
+  (declare (indent 1) (debug let))
+  (if (null bindings) (cons 'progn body)
+    (setq bindings (reverse bindings))
+    (while bindings
+      (setq body (list `(lexical-let (,(pop bindings)) ,@body))))
+    (car body)))
+
+;; This should really have some way to shadow 'byte-compile properties, etc.
+;;;###autoload
+(defmacro flet (bindings &rest body)
+  "Make temporary function definitions.
+This is an analogue of `let' that operates on the function cell of FUNC
+rather than its value cell.  The FORMs are evaluated with the specified
+function definitions in place, then the definitions are undone (the FUNCs
+go back to their previous definitions, or lack thereof).
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+  (declare (indent 1) (debug cl-flet))
+  `(cl-letf* ,(mapcar
+            (lambda (x)
+              (if (or (and (fboundp (car x))
+                           (eq (car-safe (symbol-function (car x))) 'macro))
+                      (cdr (assq (car x) macroexpand-all-environment)))
+                  (error "Use `labels', not `flet', to rebind macro names"))
+              (let ((func `(cl-function
+                            (lambda ,(cadr x)
+                              (cl-block ,(car x) ,@(cddr x))))))
+                (when (cl-compiling-file)
+                  ;; Bug#411.  It would be nice to fix this.
+                  (and (get (car x) 'byte-compile)
+                       (error "Byte-compiling a redefinition of `%s' \
+will not work - use `labels' instead" (symbol-name (car x))))
+                  ;; FIXME This affects the rest of the file, when it
+                  ;; should be restricted to the flet body.
+                  (and (boundp 'byte-compile-function-environment)
+                       (push (cons (car x) (eval func))
+                             byte-compile-function-environment)))
+                (list `(symbol-function ',(car x)) func)))
+            bindings)
+     ,@body))
+
+(defmacro labels (bindings &rest body)
+  "Make temporary function bindings.
+This is like `flet', except the bindings are lexical instead of dynamic.
+Unlike `flet', this macro is fully compliant with the Common Lisp standard.
+
+\(fn ((FUNC ARGLIST BODY...) ...) FORM...)"
+  (declare (indent 1) (debug cl-flet))
+  (let ((vars nil) (sets nil) (newenv macroexpand-all-environment))
+    (dolist (binding bindings)
+      ;; It's important that (not (eq (symbol-name var1) (symbol-name var2)))
+      ;; because these var's *names* get added to the macro-environment.
+      (let ((var (make-symbol (format "--cl-%s--" (car binding)))))
+        (push var vars)
+        (push `(cl-function (lambda . ,(cdr binding))) sets)
+        (push var sets)
+        (push (cons (car binding)
+                    `(lambda (&rest cl-labels-args)
+                       (cl-list* 'funcall ',var
+                                 cl-labels-args)))
+              newenv)))
+    (macroexpand-all `(lexical-let ,vars (setq ,@sets) ,@body) newenv)))
+
 ;;; Additional compatibility code
 ;; For names that were clean but really aren't needed any more.
 
-(defalias 'cl-macroexpand 'macroexpand)
-(defvaralias 'cl-macro-environment 'macroexpand-all-environment)
-(defalias 'cl-macroexpand-all 'macroexpand-all)
+(define-obsolete-function-alias 'cl-macroexpand 'macroexpand "24.2")
+(define-obsolete-variable-alias 'cl-macro-environment
+  'macroexpand-all-environment "24.2")
+(define-obsolete-function-alias 'cl-macroexpand-all 'macroexpand-all "24.2")
 
 ;;; Hash tables.
 ;; This is just kept for compatibility with code byte-compiled by Emacs-20.
@@ -343,24 +510,29 @@
 ;; No idea if this might still be needed.
 (defun cl-not-hash-table (x &optional y &rest z)
   (signal 'wrong-type-argument (list 'cl-hash-table-p (or y x))))
+(make-obsolete 'cl-not-hash-table nil "24.2")
 
 (defvar cl-builtin-gethash (symbol-function 'gethash))
+(make-obsolete-variable 'cl-builtin-gethash nil "24.2")
 (defvar cl-builtin-remhash (symbol-function 'remhash))
+(make-obsolete-variable 'cl-builtin-remhash nil "24.2")
 (defvar cl-builtin-clrhash (symbol-function 'clrhash))
+(make-obsolete-variable 'cl-builtin-clrhash nil "24.2")
 (defvar cl-builtin-maphash (symbol-function 'maphash))
 
-(defalias 'cl-map-keymap 'map-keymap)
-(defalias 'cl-copy-tree 'copy-tree)
-(defalias 'cl-gethash 'gethash)
-(defalias 'cl-puthash 'puthash)
-(defalias 'cl-remhash 'remhash)
-(defalias 'cl-clrhash 'clrhash)
-(defalias 'cl-maphash 'maphash)
-(defalias 'cl-make-hash-table 'make-hash-table)
-(defalias 'cl-hash-table-p 'hash-table-p)
-(defalias 'cl-hash-table-count 'hash-table-count)
+(make-obsolete-variable 'cl-builtin-maphash nil "24.2")
+(define-obsolete-function-alias 'cl-map-keymap 'map-keymap "24.2")
+(define-obsolete-function-alias 'cl-copy-tree 'copy-tree "24.2")
+(define-obsolete-function-alias 'cl-gethash 'gethash "24.2")
+(define-obsolete-function-alias 'cl-puthash 'puthash "24.2")
+(define-obsolete-function-alias 'cl-remhash 'remhash "24.2")
+(define-obsolete-function-alias 'cl-clrhash 'clrhash "24.2")
+(define-obsolete-function-alias 'cl-maphash 'maphash "24.2")
+(define-obsolete-function-alias 'cl-make-hash-table 'make-hash-table "24.2")
+(define-obsolete-function-alias 'cl-hash-table-p 'hash-table-p "24.2")
+(define-obsolete-function-alias 'cl-hash-table-count 'hash-table-count "24.2")
 
-;; FIXME: More candidates: define-modify-macro, define-setf-expander, lexical-let.
+;; FIXME: More candidates: define-modify-macro, define-setf-expander.
 
 (provide 'cl)
 ;;; cl.el ends here
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index 115af33fb6c..ca6a04d605b 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -231,6 +231,10 @@ definitions to shadow the loaded ones for use in file byte-compilation."
   "Return an expression equivalent to `(progn ,@EXPS)."
   (if (cdr exps) `(progn ,@exps) (car exps)))
 
+(defun macroexp-unprogn (exp)
+  "Turn EXP into a list of expressions to execute in sequence."
+  (if (eq (car-safe exp) 'progn) (cdr exp) (list exp)))
+
 (defun macroexp-let* (bindings exp)
   "Return an expression equivalent to `(let* ,bindings ,exp)."
   (cond