5 files changed, 214 insertions, 205 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 7c920b2eadc..6a47a2626a5 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,25 @@
+2011-02-11  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+        * emacs-lisp/bytecomp.el (byte-compile-lambda): Fix `fun' that was not
+        renamed to `bytecomp-fun'.
+
+        * emacs-lisp/byte-lexbind.el (byte-compile-lforminfo-analyze):
+        Understand the :fun-body case for catch, save-window-excursion, and
+        condition-case.
+        (byte-compile-maybe-push-heap-environment): No need when nclosures is
+        zero and byte-compile-current-num-closures is -1.
+
+        * emacs-lisp/cconv.el (cconv-not-lexical-var-p): New function.
+        (cconv-freevars): Use it.
+        (cconv-closure-convert-rec): Avoid `position'.
+        (cconv-analyse-function): New function.
+        (cconv-analyse-form): Use it.  `inclosure' can't be nil any more.
+        Check lexical vars at let-binding time rather than when referenced.
+        For defuns to be in an empty environment and lambdas to take lexical args.
+        Pay attention to the need to build closures in catch, unwind-protect,
+        save-window-excursion, condition-case, and track-mouse.
+        Fix defconst/defvar handling.
+
 2011-02-10  Stefan Monnier  <monnier@iro.umontreal.ca>
 
         * emacs-lisp/cconv.el (cconv-mutated, cconv-captured)
diff --git a/lisp/emacs-lisp/byte-lexbind.el b/lisp/emacs-lisp/byte-lexbind.el
index df463c17549..313c4b6ad0f 100644
--- a/lisp/emacs-lisp/byte-lexbind.el
+++ b/lisp/emacs-lisp/byte-lexbind.el
@@ -1,6 +1,6 @@
 ;;; byte-lexbind.el --- Lexical binding support for byte-compiler
 ;;
-;; Copyright (C) 2001, 2002, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2001, 2002, 2010, 2011 Free Software Foundation, Inc.
 ;;
 ;; Author: Miles Bader <miles@gnu.org>
 ;; Keywords: lisp, compiler, lexical binding
@@ -202,24 +202,25 @@ LFORMINFO."
                        (byte-compile-lvarinfo-note-set vinfo)
                        (byte-compile-lforminfo-note-closure lforminfo vinfo
                                                             closure-flag)))))))
-            ((eq fun 'catch)
+            ((and (eq fun 'catch) (not (eq :fun-body (nth 2 form))))
              ;; tag
              (byte-compile-lforminfo-analyze lforminfo (cadr form)
-                                             ignore closure-flag)
+                                             ignore closure-flag)
              ;; `catch' uses a closure for the body
              (byte-compile-lforminfo-analyze-forms
               lforminfo form 2
               ignore
               (or closure-flag
-                  (and (not byte-compile-use-downward-closures)
-                       (byte-compile-lforminfo-make-closure-flag)))))
+                  (and (not byte-compile-use-downward-closures)
+                       (byte-compile-lforminfo-make-closure-flag)))))
             ((eq fun 'cond)
              (byte-compile-lforminfo-analyze-clauses lforminfo (cdr form) 0
                                                      ignore closure-flag))
             ((eq fun 'condition-case)
              ;; `condition-case' separates its body/handlers into
              ;; separate closures.
-             (unless (or closure-flag byte-compile-use-downward-closures)
+             (unless (or (eq (nth 1 form) :fun-body)
+                         closure-flag byte-compile-use-downward-closures)
                ;; condition case is implemented by calling a function
                (setq closure-flag (byte-compile-lforminfo-make-closure-flag)))
              ;; value form
@@ -281,7 +282,8 @@ LFORMINFO."
             ((eq fun 'quote)
              ;; do nothing
              )
-            ((eq fun 'save-window-excursion)
+            ((and (eq fun 'save-window-excursion)
+                  (not (eq :fun-body (nth 1 form))))
              ;; `save-window-excursion' currently uses a funny implementation
              ;; that requires its body forms be put into a closure (it should
              ;; be fixed to work more like `save-excursion' etc., do).
@@ -579,6 +581,7 @@ proper scope)."
   (let ((nclosures
          (and lforminfo (byte-compile-lforminfo-num-closures lforminfo))))
     (if (or (null lforminfo)
+            (zerop nclosures)
             (= nclosures byte-compile-current-num-closures))
         ;; No need to push a heap environment.
         nil
@@ -692,5 +695,4 @@ binding slots have been popped."
 
 (provide 'byte-lexbind)
 
-;;; arch-tag: b8f1dff6-9edb-4430-a96f-323d42a681a9
 ;;; byte-lexbind.el ends here
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index e14ecc608c7..f37d7489e9a 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -2745,7 +2745,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
             ;; containing the args and any closed-over variables.
             (and lexical-binding
                  (byte-compile-make-lambda-lexenv
-                  fun
+                  bytecomp-fun
                   byte-compile-lexical-environment))) 
            (is-closure
             ;; This is true if we should be making a closure instead of
@@ -2804,7 +2804,7 @@ If FORM is a lambda or a macro, byte-compile it as a function."
   (let ((code (byte-compile-lambda form add-lambda)))
     (if (byte-compile-closure-code-p code)
         (byte-compile-make-closure code)
-      ;; A simple lambda is just a constant
+      ;; A simple lambda is just a constant.
       (byte-compile-constant code))))
 
 (defun byte-compile-constants-vector ()
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 60bc906b60c..af42a2864c9 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -1,4 +1,4 @@
-;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t -*-
+;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: nil -*-
 
 ;; Copyright (C) 2011  Free Software Foundation, Inc.
 
@@ -82,8 +82,19 @@ is less than this number.")
 (defvar cconv-captured+mutated nil
   "An intersection between cconv-mutated and cconv-captured lists.")
 (defvar cconv-lambda-candidates nil
-  "List of candidates for lambda lifting")
-
+  "List of candidates for lambda lifting.
+Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).")
+
+(defun cconv-not-lexical-var-p (var)
+  (or (not (symbolp var))               ; form is not a list
+      (special-variable-p var)
+      ;; byte-compile-bound-variables normally holds both the
+      ;; dynamic and lexical vars, but the bytecomp.el should
+      ;; only call us at the top-level so there shouldn't be
+      ;; any lexical vars in it here.
+      (memq var byte-compile-bound-variables)
+      (memq var '(nil t))
+      (keywordp var)))
 
 (defun cconv-freevars (form &optional fvrs)
   "Find all free variables of given form.
@@ -166,24 +177,17 @@ Returns a list of free variables."
        (append fvrs fvrs-1)))
 
     (`(,(and sym (or `defun `defconst `defvar)) . ,_)
-     ;; we call cconv-freevars only for functions(lambdas)
+     ;; We call cconv-freevars only for functions(lambdas)
      ;; defun, defconst, defvar are not allowed to be inside
-     ;; a function(lambda)
+     ;; a function (lambda).
+     ;; FIXME: should be a byte-compile-report-error!
      (error "Invalid form: %s inside a function" sym))
 
-    (`(,_ . ,body-forms)     ; first element is a function or whatever
+    (`(,_ . ,body-forms)    ; First element is (like) a function.
      (dolist (exp body-forms)
        (setq fvrs (cconv-freevars exp fvrs))) fvrs)
 
-    (_ (if (or (not (symbolp form))     ; form is not a list
-               (special-variable-p form)
-               ;; byte-compile-bound-variables normally holds both the
-               ;; dynamic and lexical vars, but the bytecomp.el should
-               ;; only call us at the top-level so there shouldn't be
-               ;; any lexical vars in it here.
-               (memq form byte-compile-bound-variables)
-               (memq form '(nil t))
-               (keywordp form))
+    (_ (if (cconv-not-lexical-var-p form)
            fvrs
          (cons form fvrs)))))
 
@@ -200,12 +204,13 @@ Returns a list of free variables."
 -- TOPLEVEL(optional) is a boolean variable, true if we are at the root of AST
 
 Returns a form where all lambdas don't have any free variables."
+  (message "Entering cconv-closure-convert...")
   (let ((cconv-mutated '())
         (cconv-lambda-candidates '())
         (cconv-captured '())
         (cconv-captured+mutated '()))
     ;; Analyse form - fill these variables with new information
-    (cconv-analyse-form form '() nil)
+    (cconv-analyse-form form '() 0)
     ;; Calculate an intersection of cconv-mutated and cconv-captured
     (dolist (mvr cconv-mutated)
       (when (memq mvr cconv-captured)   ;
@@ -271,7 +276,7 @@ Returns a form where all lambdas don't have any free variables."
 
        (dolist (elm varsvalues)       ;begin of dolist over varsvalues
          (let (var value elm-new iscandidate ismutated)
-           (if (listp elm)    ; (let (v1) ...) => (let ((v1 nil)) ...)
+           (if (consp elm)    ; (let (v1) ...) => (let ((v1 nil)) ...)
                (progn
                  (setq var (car elm))
                  (setq value (cadr elm)))
@@ -430,9 +435,7 @@ Returns a form where all lambdas don't have any free variables."
                (letbinds '())
                (fvrs-new))              ; list of (closed-var var)
            (dolist (elm varsvalues)
-             (if (listp elm)
-                 (setq var (car elm))
-               (setq var elm))
+             (setq var (if (consp elm) (car elm) elm))
 
              (let ((lmenvs-1 lmenvs))   ; just to avoid manipulating
                (dolist (lmenv lmenvs-1) ; the counter inside the loop
@@ -490,7 +493,7 @@ Returns a form where all lambdas don't have any free variables."
     (`(quote . ,_) form)                ; quote form
 
     (`(function . ((lambda ,vars . ,body-forms))) ; function form
-     (let (fvrs-new)           ; we remove vars from fvrs
+     (let (fvrs-new)      ; we remove vars from fvrs
        (dolist (elm fvrs) ;i use such a tricky way to avoid side effects
          (when (not (memq elm vars))
            (push elm fvrs-new)))
@@ -577,7 +580,7 @@ Returns a form where all lambdas don't have any free variables."
     (`(,(and sym (or `defun `defmacro))
        ,func ,vars . ,body-forms)
      (if defs-are-legal
-         (let ((body-new '())            ; the whole body
+         (let ((body-new '())       ; the whole body
                (body-forms-new '()) ; body w\o docstring and interactive
                (letbind '()))
                                         ; find mutable arguments
@@ -592,12 +595,11 @@ Returns a form where all lambdas don't have any free variables."
                (when ismutated
                  (push elm letbind)
                  (push elm emvrs))))
-                                                 ;transform body-forms
+                                            ;transform body-forms
            (when (stringp (car body-forms)) ; treat docstring well
              (push (car body-forms) body-new)
              (setq body-forms (cdr body-forms)))
-           (when (and (listp (car body-forms)) ; treat (interactive) well
-                      (eq (caar body-forms) 'interactive))
+           (when (eq (car-safe (car body-forms)) 'interactive)
              (push
               (cconv-closure-convert-rec
                (car body-forms)
@@ -707,201 +709,171 @@ Returns a form where all lambdas don't have any free variables."
        `(,func . ,body-forms-new)))
 
     (_
-     (if (memq form fvrs)               ;form is a free variable
-         (let* ((numero (position form envs))
-                (var '()))
-           (assert numero)
-           (if (null (cdr envs))
-               (setq var 'env)
+     (let ((free (memq form fvrs)))
+       (if free                         ;form is a free variable
+           (let* ((numero (- (length fvrs) (length free)))
+                  (var '()))
+             (assert numero)
+             (if (null (cdr envs))
+                 (setq var 'env)
                                         ;replace form =>
                                         ;(aref env #)
-             (setq var `(aref env ,numero)))
-           (if (memq form emvrs) ; form => (car (aref env #)) if mutable
-               `(car ,var)
-             var))
-       (if (memq form emvrs)           ; if form is a mutable variable
-           `(car ,form)                ; replace form => (car form)
-         form)))))
-
-(defun cconv-analyse-form (form vars inclosure)
-
+               (setq var `(aref env ,numero)))
+             (if (memq form emvrs) ; form => (car (aref env #)) if mutable
+                 `(car ,var)
+               var))
+         (if (memq form emvrs)         ; if form is a mutable variable
+             `(car ,form)              ; replace form => (car form)
+           form))))))
+
+(defun cconv-analyse-function (args body env parentform inclosure)
+  (dolist (arg args)
+    (cond
+     ((cconv-not-lexical-var-p arg)
+      (byte-compile-report-error
+       (format "Argument %S is not a lexical variable" arg)))
+     ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
+     (t (push (list arg inclosure parentform) env)))) ;Push vrs to vars.
+  (dolist (form body)                   ;Analyse body forms.
+    (cconv-analyse-form form env inclosure)))
+
+(defun cconv-analyse-form (form env inclosure)
   "Find mutated variables and variables captured by closure.  Analyse
 lambdas if they are suitable for lambda lifting.
 -- FORM is a piece of Elisp code after macroexpansion.
--- MLCVRS is a structure that contains captured and mutated variables.
- (first MLCVRS) is a list of mutated variables, (second MLCVRS) is a
-list of candidates for lambda lifting and (third MLCVRS) is a list of
-variables captured by closure. It should be (nil nil nil) initially.
--- VARS is a list of local variables visible in current environment
- (initially empty).
--- INCLOSURE is a boolean variable, true if we are in closure.
-Initially false"
+-- ENV is a list of variables visible in current lexical environment.
+  Each entry has the form (VAR INCLOSURE BINDER PARENTFORM)
+  for let-bound vars and (VAR INCLOSURE PARENTFORM) for function arguments.
+-- INCLOSURE is the nesting level within lambdas."
   (pcase form
                                         ; let special form
-    (`(,(and (or `let* `let) letsym) ,varsvalues . ,body-forms)
-
-     (when (eq letsym 'let)
-       (dolist (elm varsvalues)         ; analyse values
-         (when (listp elm)
-           (cconv-analyse-form (cadr elm) vars inclosure))))
+    (`(,(and (or `let* `let) letsym) ,binders . ,body-forms)
 
-     (let ((v nil)
+     (let ((orig-env env)
            (var nil)
-           (value nil)
-           (varstruct nil))
-       (dolist (elm varsvalues)
-         (if (listp elm)
+           (value nil))
+       (dolist (binder binders)
+         (if (not (consp binder))
              (progn
-               (setq var (car elm))
-               (setq value (cadr elm)))
-           (progn
-             (setq var elm)        ; treat the form (let (x) ...) well
-             (setq value nil)))
-
-         (when (eq letsym 'let*)        ; analyse value
-           (cconv-analyse-form value vars inclosure))
-
-         (let (vars-new)                ; remove the old var
-           (dolist (vr vars)
-             (when (not (eq (car vr) var))
-               (push vr vars-new)))
-           (setq vars vars-new))
-
-         (setq varstruct (list var inclosure elm form))
-         (push varstruct vars)          ; push a new one
-
-         (when (and (listp value)
-                    (eq (car value) 'function)
-                    (eq (caadr value) 'lambda))
-                                        ; if var is a function
-                                        ; push it to lambda list
-           (push varstruct cconv-lambda-candidates))))
-
-     (dolist (elm body-forms)           ; analyse body forms
-       (cconv-analyse-form elm vars inclosure))
-     nil)
+               (setq var binder)      ; treat the form (let (x) ...) well
+               (setq value nil))
+           (setq var (car binder))
+           (setq value (cadr binder))
+
+           (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)
+                               inclosure))
+
+         (unless (cconv-not-lexical-var-p var)
+           (let ((varstruct (list var inclosure binder form)))
+             (push varstruct env)       ; Push a new one.
+
+             (pcase value
+               (`(function (lambda . ,_))
+                ;; If var is a function push it to lambda list.
+                (push varstruct cconv-lambda-candidates)))))))
+
+     (dolist (form body-forms)          ; Analyse body forms.
+       (cconv-analyse-form form env inclosure)))
+
                                         ; defun special form
     (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms)
-     (let ((v nil))
-       (dolist (vr vrs)
-         (push (list vr form) vars)))   ;push vrs to vars
-     (dolist (elm body-forms)           ; analyse body forms
-       (cconv-analyse-form elm vars inclosure))
-     nil)
-
-    (`(function . ((lambda ,vrs . ,body-forms)))
-     (if inclosure                      ;we are in closure
-         (setq inclosure (+ inclosure 1))
-       (setq inclosure 1))
-     (let (vars-new)                 ; update vars
-       (dolist (vr vars)             ; we do that in such a tricky way
-         (when (not (memq (car vr) vrs)) ; to avoid side effects
-           (push vr vars-new)))
-       (dolist (vr vrs)
-         (push (list vr inclosure form) vars-new))
-       (setq vars vars-new))
-
-     (dolist (elm body-forms)
-       (cconv-analyse-form elm vars inclosure))
-     nil)
-
-    (`(setq . ,forms)           ; setq
-                                ; if a local variable (member of vars)
-                                ; is modified by setq
-                                ; then it is a mutated variable
+     (when env
+       (byte-compile-log-warning
+        (format "Function %S will ignore its context %S"
+                func (mapcar #'car env))
+        t :warning))
+     (cconv-analyse-function vrs body-forms nil form 0))
+
+    (`(function (lambda ,vrs . ,body-forms))
+     (cconv-analyse-function vrs body-forms env form (1+ inclosure)))
+     
+    (`(setq . ,forms)
+     ;; If a local variable (member of env) is modified by setq then
+     ;; it is a mutated variable.
      (while forms
-       (let ((v (assq (car forms) vars))) ; v = non nil if visible
+       (let ((v (assq (car forms) env))) ; v = non nil if visible
          (when v
            (push v cconv-mutated)
-           ;; delete from candidate list for lambda lifting
+           ;; Delete from candidate list for lambda lifting.
            (setq cconv-lambda-candidates (delq v cconv-lambda-candidates))
-           (when inclosure
-             ;; test if v is declared as argument for lambda
-             (let* ((thirdv (third v))
-                    (isarg (if (listp thirdv)
-                               (eq (car thirdv) 'function) nil)))
-               (if isarg
-                   (when (> inclosure (cadr v)) ; when we are in closure
-                     (push v cconv-captured)) ; push it to captured vars
-                 ;; FIXME more detailed comments needed
-                 (push v cconv-captured))))))
-       (cconv-analyse-form (cadr forms) vars inclosure)
-       (setq forms (cddr forms)))
-     nil)
-
-    (`((lambda . ,_) . ,_)        ; first element is lambda expression
+           (unless (eq inclosure (cadr v)) ;Bound in a different closure level.
+             (push v cconv-captured))))
+       (cconv-analyse-form (cadr forms) env inclosure)
+       (setq forms (cddr forms))))
+
+    (`((lambda . ,_) . ,_)             ; first element is lambda expression
      (dolist (exp `((function ,(car form)) . ,(cdr form)))
-       (cconv-analyse-form exp vars inclosure))
-     nil)
+       (cconv-analyse-form exp env inclosure)))
 
     (`(cond . ,cond-forms)              ; cond special form
-     (dolist (exp1 cond-forms)
-       (dolist (exp2 exp1)
-         (cconv-analyse-form exp2 vars inclosure)))
-     nil)
+     (dolist (forms cond-forms)
+       (dolist (form forms)
+         (cconv-analyse-form form env inclosure))))
 
     (`(quote . ,_) nil)                 ; quote form
-
     (`(function . ,_) nil)              ; same as quote
 
-    (`(condition-case ,var ,protected-form . ,conditions-bodies)
-                                        ;condition-case
-     (cconv-analyse-form protected-form vars inclosure)
-     (dolist (exp conditions-bodies)
-       (cconv-analyse-form (cadr exp) vars inclosure))
-     nil)
-
-    (`(,(or `defconst `defvar) ,value)
-     (cconv-analyse-form value vars inclosure))
+    (`(condition-case ,var ,protected-form . ,handlers)
+     ;; FIXME: The bytecode for condition-case forces us to wrap the
+     ;; form and handlers in closures (for handlers, it's probably
+     ;; unavoidable, but not for the protected form).
+     (setq inclosure (1+ inclosure))
+     (cconv-analyse-form protected-form env inclosure)
+     (push (list var inclosure form) env)
+     (dolist (handler handlers)
+       (dolist (form (cdr handler))
+         (cconv-analyse-form form env inclosure))))
+
+    ;; FIXME: The bytecode for catch forces us to wrap the body.
+    (`(,(or `catch `unwind-protect) ,form . ,body)
+     (cconv-analyse-form form env inclosure)
+     (setq inclosure (1+ inclosure))
+     (dolist (form body)
+       (cconv-analyse-form form env inclosure)))
+
+    ;; FIXME: The bytecode for save-window-excursion and the lack of
+    ;; bytecode for track-mouse forces us to wrap the body.
+    (`(,(or `save-window-excursion `track-mouse) . ,body)
+     (setq inclosure (1+ inclosure))
+     (dolist (form body)
+       (cconv-analyse-form form env inclosure)))
+
+    (`(,(or `defconst `defvar) ,var ,value . ,_)
+     (push var byte-compile-bound-variables)
+     (cconv-analyse-form value env inclosure))
 
     (`(,(or `funcall `apply) ,fun . ,args)
-     ;; Here  we ignore fun because
-     ;; funcall and apply are the only two
-     ;; functions where we can pass a candidate
-     ;; for lambda lifting as argument.
-     ;; So, if we see fun elsewhere, we'll
-     ;; delete it from lambda candidate list.
-
-     ;; If this funcall and the definition of fun
-     ;; are in different closures - we delete fun from
-     ;; canidate list, because it is too complicated
-     ;; to manage free variables in this case.
-     (let ((lv (assq fun cconv-lambda-candidates)))
-       (when lv
-         (when (not (eq (cadr lv) inclosure))
-           (setq cconv-lambda-candidates
-                 (delq lv cconv-lambda-candidates)))))
-
-     (dolist (elm args)
-       (cconv-analyse-form elm vars inclosure))
-     nil)
-
-    (`(,_ . ,body-forms)     ; first element is a function or whatever
-     (dolist (exp body-forms)
-       (cconv-analyse-form exp vars inclosure))
-     nil)
-
-    (_
-     (when (and (symbolp form)
-                (not (memq form '(nil t)))
-                (not (keywordp form))
-                (not (special-variable-p form)))
-       (let ((dv (assq form vars)))     ; dv = declared and visible
-         (when dv
-           (when inclosure
-             ;; test if v is declared as argument of lambda
-             (let* ((thirddv (third dv))
-                    (isarg (if (listp thirddv)
-                               (eq (car thirddv) 'function) nil)))
-               (if isarg
-                   ;; FIXME add detailed comments
-                   (when (> inclosure (cadr dv)) ; capturing condition
-                     (push dv cconv-captured))
-                 (push dv cconv-captured))))
-                                              ; delete lambda
-           (setq cconv-lambda-candidates      ; if it is found here
-                 (delq dv cconv-lambda-candidates)))))
-     nil)))
+     ;; Here we ignore fun because funcall and apply are the only two
+     ;; functions where we can pass a candidate for lambda lifting as
+     ;; argument.  So, if we see fun elsewhere, we'll delete it from
+     ;; lambda candidate list.
+     (if (symbolp fun)
+         (let ((lv (assq fun cconv-lambda-candidates)))
+           (when lv
+             (unless (eq (cadr lv) inclosure)
+               (push lv cconv-captured)
+               ;; If this funcall and the definition of fun are in
+               ;; different closures - we delete fun from candidate
+               ;; list, because it is too complicated to manage free
+               ;; variables in this case.
+               (setq cconv-lambda-candidates
+                     (delq lv cconv-lambda-candidates)))))
+       (cconv-analyse-form fun env inclosure))
+     (dolist (form args)
+       (cconv-analyse-form form env inclosure)))
+
+    (`(,_ . ,body-forms)    ; First element is a function or whatever.
+     (dolist (form body-forms)
+       (cconv-analyse-form form env inclosure)))
+
+    ((pred symbolp)
+     (let ((dv (assq form env)))        ; dv = declared and visible
+       (when dv
+         (unless (eq inclosure (cadr dv)) ; capturing condition
+           (push dv cconv-captured))
+         ;; Delete lambda if it is found here, since it escapes.
+         (setq cconv-lambda-candidates
+               (delq dv cconv-lambda-candidates)))))))
 
 (provide 'cconv)
 ;;; cconv.el ends here
diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el
index af8047256e2..bccc60a24e0 100644
--- a/lisp/emacs-lisp/macroexp.el
+++ b/lisp/emacs-lisp/macroexp.el
@@ -29,6 +29,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+
 ;; Bound by the top-level `macroexpand-all', and modified to include any
 ;; macros defined by `defmacro'.
 (defvar macroexpand-all-environment nil)
@@ -164,6 +166,17 @@ Assumes the caller has bound `macroexpand-all-environment'."
                    (cons (macroexpand-all-1
                           (list 'function f))
                          (macroexpand-all-forms args)))))
+      ;; Macro expand compiler macros.
+      ;; FIXME: Don't depend on CL.
+      (`(,(and (pred symbolp) fun
+               (guard (and (eq (get fun 'byte-compile)
+                               'cl-byte-compile-compiler-macro)
+                           (functionp 'compiler-macroexpand))))
+         . ,_)
+       (let ((newform (compiler-macroexpand form)))
+         (if (eq form newform)
+             (macroexpand-all-forms form 1)
+           (macroexpand-all-1 newform))))
       (`(,_ . ,_)
        ;; For every other list, we just expand each argument (for
        ;; setq/setq-default this works alright because the variable names