X-Git-Url: https://code.delx.au/gnu-emacs/blobdiff_plain/3e21b6a72b87787e2327513a44623b250054f77d..7cef3569a3d872ea5be07a529b68910bf1d8b790:/lisp/emacs-lisp/cconv.el

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 66e5051c2f..5a1d626584 100644
--- a/lisp/emacs-lisp/cconv.el
+++ b/lisp/emacs-lisp/cconv.el
@@ -1,6 +1,6 @@
-;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t -*-
+;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t; coding: utf-8 -*-
 
-;; Copyright (C) 2011  Free Software Foundation, Inc.
+;; Copyright (C) 2011-2012  Free Software Foundation, Inc.
 
 ;; Author: Igor Kuzmin <kzuminig@iro.umontreal.ca>
 ;; Maintainer: FSF
@@ -26,40 +26,35 @@
 
 ;; This takes a piece of Elisp code, and eliminates all free variables from
 ;; lambda expressions.  The user entry points are cconv-closure-convert and
-;; cconv-closure-convert-toplevel(for toplevel forms).
+;; cconv-closure-convert-toplevel (for toplevel forms).
 ;; All macros should be expanded beforehand.
 ;;
 ;; Here is a brief explanation how this code works.
-;; Firstly, we analyse the tree by calling cconv-analyse-form.
+;; Firstly, we analyze the tree by calling cconv-analyse-form.
 ;; This function finds all mutated variables, all functions that are suitable
 ;; for lambda lifting and all variables captured by closure. It passes the tree
 ;; once, returning a list of three lists.
 ;;
-;; Then we calculate the intersection of first and third lists returned by
+;; Then we calculate the intersection of the first and third lists returned by
 ;; cconv-analyse form to find all mutated variables that are captured by
 ;; closure.
 
 ;; Armed with this data, we call cconv-closure-convert-rec, that rewrites the
-;; tree recursivly, lifting lambdas where possible, building closures where it
+;; tree recursively, lifting lambdas where possible, building closures where it
 ;; is needed and eliminating mutable variables used in closure.
 ;;
 ;; We do following replacements :
 ;; (lambda (v1 ...) ... fv1 fv2 ...) => (lambda (v1 ... fv1 fv2 ) ... fv1 fv2 .)
 ;; if the function is suitable for lambda lifting (if all calls are known)
 ;;
-;; (lambda (v1 ...) ... fv ...)  =>
-;; (curry (lambda (env v1 ...) ... env ...) env)
-;; if the function has only 1 free variable
-;;
-;; and finally
-;; (lambda (v1 ...) ... fv1 fv2 ...)  =>
-;; (curry (lambda (env v1 ..) .. (aref env 0) (aref env 1) ..) (vector fv1 fv2))
-;; if the function has 2 or more free variables.
+;; (lambda (v0 ...) ... fv0 .. fv1 ...)  =>
+;; (internal-make-closure (v0 ...) (fv1 ...)
+;;   ... (internal-get-closed-var 0) ...  (internal-get-closed-var 1) ...)
 ;;
 ;; If the function has no free variables, we don't do anything.
 ;;
 ;; If a variable is mutated (updated by setq), and it is used in a closure
-;; we wrap it's definition with list: (list val) and we also replace
+;; we wrap its definition with list: (list val) and we also replace
 ;; var => (car var) wherever this variable is used, and also
 ;; (setq var value) => (setcar var value) where it is updated.
 ;;
@@ -70,128 +65,69 @@
 ;;
 ;;; Code:
 
-;;; TODO:
-;; - Change new byte-code representation, so it directly gives the
-;;   number of mandatory and optional arguments as well as whether or
-;;   not there's a &rest arg.
-;; - Use abstract `make-closure' and `closure-ref' expressions, which bytecomp
-;;   should turn into building corresponding byte-code function.
-;; - don't use `curry', instead build a new compiled-byte-code object
-;;   (merge the closure env into the static constants pool).
-;; - warn about unused lexical vars.
-;; - clean up cconv-closure-convert-rec, especially the `let' binding part.
+;; TODO: (not just for cconv but also for the lexbind changes in general)
+;; - let (e)debug find the value of lexical variables from the stack.
+;; - make eval-region do the eval-sexp-add-defvars dance.
+;; - byte-optimize-form should be applied before cconv.
+;;   OTOH, the warnings emitted by cconv-analyze need to come before optimize
+;;   since afterwards they can because obnoxious (warnings about an "unused
+;;   variable" should not be emitted when the variable use has simply been
+;;   optimized away).
+;; - let macros specify that some let-bindings come from the same source,
+;;   so the unused warning takes all uses into account.
+;; - let interactive specs return a function to build the args (to stash into
+;;   command-history).
+;; - canonize code in macro-expand so we don't have to handle (let (var) body)
+;;   and other oddities.
 ;; - new byte codes for unwind-protect, catch, and condition-case so that
 ;;   closures aren't needed at all.
-
-(eval-when-compile (require 'cl))
-
-(defconst cconv-liftwhen 3
+;; - inline source code of different binding mode by first compiling it.
+;; - a reference to a var that is known statically to always hold a constant
+;;   should be turned into a byte-constant rather than a byte-stack-ref.
+;;   Hmm... right, that's called constant propagation and could be done here,
+;;   but when that constant is a function, we have to be careful to make sure
+;;   the bytecomp only compiles it once.
+;; - Since we know here when a variable is not mutated, we could pass that
+;;   info to the byte-compiler, e.g. by using a new `immutable-let'.
+;; - add tail-calls to bytecode.c and the byte compiler.
+;; - call known non-escaping functions with `goto' rather than `call'.
+;; - optimize mapcar to a while loop.
+
+;; (defmacro dlet (binders &rest body)
+;;   ;; Works in both lexical and non-lexical mode.
+;;   `(progn
+;;      ,@(mapcar (lambda (binder)
+;;                  `(defvar ,(if (consp binder) (car binder) binder)))
+;;                binders)
+;;      (let ,binders ,@body)))
+
+;; (defmacro llet (binders &rest body)
+;;   ;; Only works in lexical-binding mode.
+;;   `(funcall
+;;     (lambda ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder))
+;;                 binders)
+;;       ,@body)
+;;     ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder)))
+;;               binders)))
+
+(eval-when-compile (require 'cl-lib))
+
+(defconst cconv-liftwhen 6
   "Try to do lambda lifting if the number of arguments + free variables
 is less than this number.")
-(defvar cconv-mutated nil
-  "List of mutated variables in current form")
-(defvar cconv-captured nil
-  "List of closure captured variables in current form")
-(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.
-Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).")
-
-(defun cconv-freevars (form &optional fvrs)
-  "Find all free variables of given form.
-Arguments:
--- FORM is a piece of Elisp code after macroexpansion.
--- FVRS(optional) is a list of variables already found.  Used for recursive tree
-traversal
-
-Returns a list of free variables."
-  ;; If a leaf in the tree is a symbol, but it is not a global variable, not a
-  ;; keyword, not 'nil or 't we consider this leaf as a variable.
-  ;; Free variables are the variables that are not declared above in this tree.
-  ;; For example free variables of (lambda (a1 a2 ..) body-forms) are
-  ;; free variables of body-forms excluding a1, a2 ..
-  ;; Free variables of (let ((v1 ..) (v2) ..)) body-forms) are
-  ;; free variables of body-forms excluding v1, v2 ...
-  ;; and so on.
-
-  ;; A list of free variables already found(FVRS) is passed in parameter
-  ;; to try to use cons or push where possible, and to minimize the usage
-  ;; of append.
-
-  ;; This function can return duplicates (because we use 'append instead
-  ;; of union of two sets - for performance reasons).
-  (pcase form
-    (`(let ,varsvalues . ,body-forms)   ; let special form
-     (let ((fvrs-1 '()))
-       (dolist (exp body-forms)
-         (setq fvrs-1 (cconv-freevars exp fvrs-1)))
-       (dolist (elm varsvalues)
-         (setq fvrs-1 (delq (if (consp elm) (car elm) elm) fvrs-1)))
-       (setq fvrs (nconc fvrs-1 fvrs))
-       (dolist (exp varsvalues)
-         (when (consp exp) (setq fvrs (cconv-freevars (cadr exp) fvrs))))
-       fvrs))
-
-    (`(let* ,varsvalues . ,body-forms)  ; let* special form
-     (let ((vrs '())
-           (fvrs-1 '()))
-       (dolist (exp varsvalues)
-         (if (consp exp)
-             (progn
-               (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1))
-               (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1)))
-               (push (car exp) vrs))
-           (progn
-             (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1)))
-             (push exp vrs))))
-       (dolist (exp body-forms)
-         (setq fvrs-1 (cconv-freevars exp fvrs-1)))
-       (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1)))
-       (append fvrs fvrs-1)))
-
-    (`((lambda . ,_) . ,_)             ; first element is lambda expression
-     (dolist (exp `((function ,(car form)) . ,(cdr form)))
-       (setq fvrs (cconv-freevars exp fvrs))) fvrs)
+;; List of all the variables that are both captured by a closure
+;; and mutated.  Each entry in the list takes the form
+;; (BINDER . PARENTFORM) where BINDER is the (VAR VAL) that introduces the
+;; variable (or is just (VAR) for variables not introduced by let).
+(defvar cconv-captured+mutated)
 
-    (`(cond . ,cond-forms)              ; cond special form
-     (dolist (exp1 cond-forms)
-       (dolist (exp2 exp1)
-         (setq fvrs (cconv-freevars exp2 fvrs)))) fvrs)
+;; List of candidates for lambda lifting.
+;; Each candidate has the form (BINDER . PARENTFORM).  A candidate
+;; is a variable that is only passed to `funcall' or `apply'.
+(defvar cconv-lambda-candidates)
 
-    (`(quote . ,_) fvrs)                ; quote form
-
-    (`(function . ((lambda ,vars . ,body-forms)))
-     (let ((functionform (cadr form)) (fvrs-1 '()))
-       (dolist (exp body-forms)
-         (setq fvrs-1 (cconv-freevars exp fvrs-1)))
-       (dolist (elm vars) (setq fvrs-1 (delq elm fvrs-1)))
-       (append fvrs fvrs-1)))           ; function form
-
-    (`(function . ,_) fvrs)             ; same as quote
-					;condition-case
-    (`(condition-case ,var ,protected-form . ,conditions-bodies)
-     (let ((fvrs-1 '()))
-       (dolist (exp conditions-bodies)
-         (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1)))
-       (setq fvrs-1 (delq var fvrs-1))
-       (setq fvrs-1 (cconv-freevars protected-form fvrs-1))
-       (append fvrs fvrs-1)))
-
-    (`(,(and sym (or `defun `defconst `defvar)) . ,_)
-     ;; We call cconv-freevars only for functions(lambdas)
-     ;; defun, defconst, defvar are not allowed to be inside
-     ;; a function (lambda).
-     ;; FIXME: should be a byte-compile-report-error!
-     (error "Invalid form: %s inside a function" sym))
-
-    (`(,_ . ,body-forms)    ; First element is (like) a function.
-     (dolist (exp body-forms)
-       (setq fvrs (cconv-freevars exp fvrs))) fvrs)
-
-    (_ (if (byte-compile-not-lexical-var-p form)
-           fvrs
-         (cons form fvrs)))))
+;; Alist associating to each function body the list of its free variables.
+(defvar cconv-freevars-alist)
 
 ;;;###autoload
 (defun cconv-closure-convert (form)
@@ -201,35 +137,15 @@ Returns a list of free variables."
 
 Returns a form where all lambdas don't have any free variables."
   ;; (message "Entering cconv-closure-convert...")
-  (let ((cconv-mutated '())
+  (let ((cconv-freevars-alist '())
 	(cconv-lambda-candidates '())
-	(cconv-captured '())
 	(cconv-captured+mutated '()))
-    ;; Analyse form - fill these variables with new information.
-    (cconv-analyse-form form '() 0)
-    ;; Calculate an intersection of cconv-mutated and cconv-captured.
-    (dolist (mvr cconv-mutated)
-      (when (memq mvr cconv-captured)   ;
-        (push mvr cconv-captured+mutated)))
-    (cconv-closure-convert-rec
-     form                               ; the tree
-     '()                                ;
-     '()                                ; fvrs initially empty
-     '()                                ; envs initially empty
-     '()
-     )))
-
-(defun cconv--lookup-let (table var binder form)
-  (let ((res nil))
-    (dolist (elem table)
-      (when (and (eq (nth 2 elem) binder)
-                 (eq (nth 3 elem) form))
-        (assert (eq (car elem) var))
-        (setq res elem)))
-    res))
+    ;; Analyze form - fill these variables with new information.
+    (cconv-analyse-form form '())
+    (setq cconv-freevars-alist (nreverse cconv-freevars-alist))
+    (cconv-convert form nil nil))) ; Env initially empty.
 
 (defconst cconv--dummy-var (make-symbol "ignored"))
-(defconst cconv--env-var (make-symbol "env"))
 
 (defun cconv--set-diff (s1 s2)
   "Return elements of set S1 that are not in set S2."
@@ -257,7 +173,7 @@ Returns a form where all lambdas don't have any free variables."
   ;; Here we assume that X appears at most once in M.
   (let* ((b (assq x m))
          (res (if b (remq b m) m)))
-    (assert (null (assq x res))) ;; Check the assumption was warranted.
+    (cl-assert (null (assq x res))) ;; Check the assumption was warranted.
     res))
 
 (defun cconv--map-diff-set (m s)
@@ -268,20 +184,79 @@ Returns a form where all lambdas don't have any free variables."
       (unless (memq (car b) s) (push b res)))
     (nreverse res)))
 
-(defun cconv-closure-convert-rec (form emvrs fvrs envs lmenvs)
+(defun cconv--convert-function (args body env parentform)
+  (cl-assert (equal body (caar cconv-freevars-alist)))
+  (let* ((fvs (cdr (pop cconv-freevars-alist)))
+         (body-new '())
+         (letbind '())
+         (envector ())
+         (i 0)
+         (new-env ()))
+    ;; Build the "formal and actual envs" for the closure-converted function.
+    (dolist (fv fvs)
+      (let ((exp (or (cdr (assq fv env)) fv)))
+        (pcase exp
+          ;; If `fv' is a variable that's wrapped in a cons-cell,
+          ;; we want to put the cons-cell itself in the closure,
+          ;; rather than just a copy of its current content.
+          (`(car ,iexp . ,_)
+           (push iexp envector)
+           (push `(,fv . (car (internal-get-closed-var ,i))) new-env))
+          (_
+           (push exp envector)
+           (push `(,fv . (internal-get-closed-var ,i)) new-env))))
+      (setq i (1+ i)))
+    (setq envector (nreverse envector))
+    (setq new-env (nreverse new-env))
+
+    (dolist (arg args)
+      (if (not (member (cons (list arg) parentform) cconv-captured+mutated))
+          (if (assq arg new-env) (push `(,arg) new-env))
+        (push `(,arg . (car ,arg)) new-env)
+        (push `(,arg (list ,arg)) letbind)))
+
+    (setq body-new (mapcar (lambda (form)
+                             (cconv-convert form new-env nil))
+                           body))
+
+    (when letbind
+      (let ((special-forms '()))
+        ;; Keep special forms at the beginning of the body.
+        (while (or (stringp (car body-new)) ;docstring.
+                   (memq (car-safe (car body-new)) '(interactive declare)))
+          (push (pop body-new) special-forms))
+        (setq body-new
+              `(,@(nreverse special-forms) (let ,letbind . ,body-new)))))
+
+    (cond
+     ((null envector)                   ;if no freevars - do nothing
+      `(function (lambda ,args . ,body-new)))
+     (t
+      `(internal-make-closure
+        ,args ,envector . ,body-new)))))
+
+(defun cconv-convert (form env extend)
   ;; This function actually rewrites the tree.
-  "Eliminates all free variables of all lambdas in given forms.
-Arguments:
--- FORM is a piece of Elisp code after macroexpansion.
--- LMENVS is a list of environments used for lambda-lifting.  Initially empty.
--- EMVRS is a list that contains mutated variables that are visible
-within current environment.
--- ENVS is an environment(list of free variables) of current closure.
-Initially empty.
--- FVRS is a list of variables to substitute in each context.
-Initially empty.
+  "Return FORM with all its lambdas changed so they are closed.
+ENV is a lexical environment mapping variables to the expression
+used to get its value.  This is used for variables that are copied into
+closures, moved into cons cells, ...
+ENV is a list where each entry takes the shape either:
+ (VAR . (car EXP)): VAR has been moved into the car of a cons-cell, and EXP
+    is an expression that evaluates to this cons-cell.
+ (VAR . (internal-get-closed-var N)): VAR has been copied into the closure
+    environment's Nth slot.
+ (VAR . (apply-partially F ARG1 ARG2 ..)): VAR has been λ-lifted and takes
+    additional arguments ARGs.
+EXTEND is a list of variables which might need to be accessed even from places
+where they are shadowed, because some part of ENV causes them to be used at
+places where they originally did not directly appear."
+  (cl-assert (not (delq nil (mapcar (lambda (mapping)
+                                      (if (eq (cadr mapping) 'apply-partially)
+                                          (cconv--set-diff (cdr (cddr mapping))
+                                                           extend)))
+                                    env))))
 
-Returns a form where all lambdas don't have any free variables."
   ;; What's the difference between fvrs and envs?
   ;; Suppose that we have the code
   ;; (lambda (..) fvr (let ((fvr 1)) (+ fvr 1)))
@@ -294,585 +269,414 @@ Returns a form where all lambdas don't have any free variables."
   ;; so we never touch it(unless we enter to the other closure).
   ;;(if (listp form) (print (car form)) form)
   (pcase form
-    (`(,(and letsym (or `let* `let)) ,binders . ,body-forms)
+    (`(,(and letsym (or `let* `let)) ,binders . ,body)
 
 					; let and let* special forms
-     (let ((body-forms-new '())
-           (binders-new '())
-           ;; next for variables needed for delayed push
-           ;; because we should process <value(s)>
-           ;; before we change any arguments
-           (lmenvs-new '())             ;needed only in case of let
-           (emvrs-new '())              ;needed only in case of let
-           (emvr-push)                  ;needed only in case of let*
-           (lmenv-push))                ;needed only in case of let*
+     (let ((binders-new '())
+           (new-env env)
+           (new-extend extend))
 
        (dolist (binder binders)
          (let* ((value nil)
                 (var (if (not (consp binder))
-                         binder
+                         (prog1 binder (setq binder (list binder)))
                        (setq value (cadr binder))
                        (car binder)))
                 (new-val
                  (cond
                   ;; Check if var is a candidate for lambda lifting.
-                  ((cconv--lookup-let cconv-lambda-candidates var binder form)
-
-                   (let* ((fv (delete-dups (cconv-freevars value '())))
-                          (funargs (cadr (cadr value)))
-                          (funcvars (append fv funargs))
-                          (funcbodies (cddadr value)) ; function bodies
-                          (funcbodies-new '()))
+                  ((and (member (cons binder form) cconv-lambda-candidates)
+                        (progn
+                          (cl-assert (and (eq (car value) 'function)
+                                          (eq (car (cadr value)) 'lambda)))
+                          (cl-assert (equal (cddr (cadr value))
+                                            (caar cconv-freevars-alist)))
+                          ;; Peek at the freevars to decide whether to λ-lift.
+                          (let* ((fvs (cdr (car cconv-freevars-alist)))
+                                 (fun (cadr value))
+                                 (funargs (cadr fun))
+                                 (funcvars (append fvs funargs)))
 					; lambda lifting condition
-                     (if (or (not fv) (< cconv-liftwhen (length funcvars)))
-					; do not lift
-                         (cconv-closure-convert-rec
-                          value emvrs fvrs envs lmenvs)
-					; lift
-                       (progn
-                         (dolist (elm2 funcbodies)
-                           (push        ; convert function bodies
-                            (cconv-closure-convert-rec
-                             elm2 emvrs nil envs lmenvs)
-                            funcbodies-new))
-                         (if (eq letsym 'let*)
-                             (setq lmenv-push (cons var fv))
-                           (push (cons var fv) lmenvs-new))
-					; push lifted function
-
-                         `(function .
-                                    ((lambda ,funcvars .
-                                       ,(reverse funcbodies-new))))))))
+                            (and fvs (>= cconv-liftwhen (length funcvars))))))
+					; Lift.
+                   (let* ((fvs (cdr (pop cconv-freevars-alist)))
+                          (fun (cadr value))
+                          (funargs (cadr fun))
+                          (funcvars (append fvs funargs))
+                          (funcbody (cddr fun))
+                          (funcbody-env ()))
+                     (push `(,var . (apply-partially ,var . ,fvs)) new-env)
+                     (dolist (fv fvs)
+                       (cl-pushnew fv new-extend)
+                       (if (and (eq 'car (car-safe (cdr (assq fv env))))
+                                (not (memq fv funargs)))
+                           (push `(,fv . (car ,fv)) funcbody-env)))
+                     `(function (lambda ,funcvars .
+                                  ,(mapcar (lambda (form)
+                                             (cconv-convert
+                                              form funcbody-env nil))
+                                           funcbody)))))
 
                   ;; Check if it needs to be turned into a "ref-cell".
-                  ((cconv--lookup-let cconv-captured+mutated var binder form)
+                  ((member (cons binder form) cconv-captured+mutated)
                    ;; Declared variable is mutated and captured.
-                   (prog1
-                       `(list ,(cconv-closure-convert-rec
-                                value emvrs
-                                fvrs envs lmenvs))
-                     (if (eq letsym 'let*)
-                         (setq emvr-push var)
-                       (push var emvrs-new))))
+                   (push `(,var . (car ,var)) new-env)
+                   `(list ,(cconv-convert value env extend)))
 
                   ;; Normal default case.
                   (t
-                   (cconv-closure-convert-rec
-                    value emvrs fvrs envs lmenvs)))))
-
-           ;; this piece of code below letbinds free
-           ;; variables  of a lambda lifted function
-           ;; if they are redefined in this let
-           ;; example:
-           ;; (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1))
-           ;; Here we can not pass y as parameter because it is
-           ;; redefined. We add a (closed-y y) declaration.
-           ;; We do that even if the function is not used inside
-           ;; this let(*). The reason why we ignore this case is
-           ;; that we can't "look forward" to see if the function
-           ;; is called there or not. To treat well this case we
-           ;; need to traverse the tree one more time to collect this
-           ;; data, and I think that it's not worth it.
+                   (if (assq var new-env) (push `(,var) new-env))
+                   (cconv-convert value env extend)))))
+
+           ;; The piece of code below letbinds free variables of a λ-lifted
+           ;; function if they are redefined in this let, example:
+           ;;   (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1))
+           ;; Here we can not pass y as parameter because it is redefined.
+           ;; So we add a (closed-y y) declaration.  We do that even if the
+           ;; function is not used inside this let(*).  The reason why we
+           ;; ignore this case is that we can't "look forward" to see if the
+           ;; function is called there or not.  To treat this case better we'd
+           ;; need to traverse the tree one more time to collect this data, and
+           ;; I think that it's not worth it.
+           (when (memq var new-extend)
+             (let ((closedsym
+                    (make-symbol (concat "closed-" (symbol-name var)))))
+               (setq new-env
+                     (mapcar (lambda (mapping)
+                               (if (not (eq (cadr mapping) 'apply-partially))
+                                   mapping
+                                 (cl-assert (eq (car mapping) (nth 2 mapping)))
+                                 `(,(car mapping)
+                                   apply-partially
+                                   ,(car mapping)
+                                   ,@(mapcar (lambda (arg)
+                                               (if (eq var arg)
+                                                   closedsym arg))
+                                             (nthcdr 3 mapping)))))
+                             new-env))
+               (setq new-extend (remq var new-extend))
+               (push closedsym new-extend)
+               (push `(,closedsym ,var) binders-new)))
 
-           (when (eq letsym 'let*)
-             (let ((closedsym '())
-                   (new-lmenv '())
-                   (old-lmenv '()))
-               (dolist (lmenv lmenvs)
-                 (when (memq var (cdr lmenv))
-                   (setq closedsym
-                         (make-symbol
-                          (concat "closed-" (symbol-name var))))
-                   (setq new-lmenv (list (car lmenv)))
-                   (dolist (frv (cdr lmenv)) (if (eq frv var)
-                                                 (push closedsym new-lmenv)
-                                               (push frv new-lmenv)))
-                   (setq new-lmenv (reverse new-lmenv))
-                   (setq old-lmenv lmenv)))
-               (when new-lmenv
-                 (setq lmenvs (remq old-lmenv lmenvs))
-                 (push new-lmenv lmenvs)
-                 (push `(,closedsym ,var) binders-new))))
            ;; We push the element after redefined free variables are
            ;; processed.  This is important to avoid the bug when free
            ;; variable and the function have the same name.
            (push (list var new-val) binders-new)
 
-           (when (eq letsym 'let*)      ; update fvrs
-             (setq fvrs (remq var fvrs))
-             (setq emvrs (remq var emvrs)) ; remove if redefined
-             (when emvr-push
-               (push emvr-push emvrs)
-               (setq emvr-push nil))
-             (setq lmenvs (cconv--map-diff-elem lmenvs var))
-             (when lmenv-push
-               (push lmenv-push lmenvs)
-               (setq lmenv-push nil)))
-           ))                          ; end of dolist over binders
-       (when (eq letsym 'let)
-
-         (let (var fvrs-1 emvrs-1 lmenvs-1)
-           ;; Here we update emvrs, fvrs and lmenvs lists
-           (setq fvrs (cconv--set-diff-map fvrs binders-new))
-           (setq emvrs (cconv--set-diff-map emvrs binders-new))
-           (setq emvrs (append emvrs emvrs-new))
-           (setq lmenvs (cconv--set-diff-map lmenvs binders-new))
-           (setq lmenvs (append lmenvs lmenvs-new)))
-
-         ;; Here we do the same letbinding as for let* above
-         ;; to avoid situation when a free variable of a lambda lifted
-         ;; function got redefined.
-
-         (let ((new-lmenv)
-               (var nil)
-               (closedsym nil)
-               (letbinds '()))
-           (dolist (binder binders)
-             (setq var (if (consp binder) (car binder) binder))
-
-             (let ((lmenvs-1 lmenvs))   ; just to avoid manipulating
-               (dolist (lmenv lmenvs-1) ; the counter inside the loop
-                 (when (memq var (cdr lmenv))
-                   (setq closedsym (make-symbol
-                                    (concat "closed-"
-                                            (symbol-name var))))
-
-                   (setq new-lmenv (list (car lmenv)))
-                   (dolist (frv (cdr lmenv))
-                     (push (if (eq frv var) closedsym frv)
-                           new-lmenv))
-                   (setq new-lmenv (reverse new-lmenv))
-                   (setq lmenvs (remq lmenv lmenvs))
-                   (push new-lmenv lmenvs)
-                   (push `(,closedsym ,var) letbinds)
-                   ))))
-           (setq binders-new (append binders-new letbinds))))
-
-       (dolist (elm body-forms)         ; convert body forms
-         (push (cconv-closure-convert-rec
-                elm emvrs fvrs envs lmenvs)
-               body-forms-new))
-       `(,letsym ,(reverse binders-new) . ,(reverse body-forms-new))))
+           (when (eq letsym 'let*)
+             (setq env new-env)
+             (setq extend new-extend))
+           ))                           ; end of dolist over binders
+
+       `(,letsym ,(nreverse binders-new)
+                 . ,(mapcar (lambda (form)
+                              (cconv-convert
+                               form new-env new-extend))
+                            body))))
 					;end of let let* forms
 
                                   ; first element is lambda expression
-    (`(,(and `(lambda . ,_) fun) . ,other-body-forms)
-
-     (let ((other-body-forms-new '()))
-       (dolist (elm other-body-forms)
-         (push (cconv-closure-convert-rec
-                elm emvrs fvrs envs lmenvs)
-               other-body-forms-new))
-       `(funcall
-         ,(cconv-closure-convert-rec
-           (list 'function fun) emvrs fvrs envs lmenvs)
-         ,@(nreverse other-body-forms-new))))
+    (`(,(and `(lambda . ,_) fun) . ,args)
+     ;; FIXME: it's silly to create a closure just to call it.
+     ;; Running byte-optimize-form earlier will resolve this.
+     `(funcall
+       ,(cconv-convert `(function ,fun) env extend)
+       ,@(mapcar (lambda (form)
+                   (cconv-convert form env extend))
+                 args)))
 
     (`(cond . ,cond-forms)              ; cond special form
-     (let ((cond-forms-new '()))
-       (dolist (elm cond-forms)
-         (push (let ((elm-new '()))
-                 (dolist (elm-2 elm)
-                   (push
-                    (cconv-closure-convert-rec
-                     elm-2 emvrs fvrs envs lmenvs)
-                    elm-new))
-                 (reverse elm-new))
-               cond-forms-new))
-       (cons 'cond
-             (reverse cond-forms-new))))
+     `(cond . ,(mapcar (lambda (branch)
+                         (mapcar (lambda (form)
+                                   (cconv-convert form env extend))
+                                 branch))
+                       cond-forms)))
 
-    (`(quote . ,_) form)
+    (`(function (lambda ,args . ,body) . ,_)
+     (cconv--convert-function args body env form))
 
-    (`(function (lambda ,vars . ,body-forms)) ; function form
-     (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs.
-	    (fv (delete-dups (cconv-freevars form '())))
-            (leave fvrs-new) ; leave=non-nil if we should leave env unchanged.
-            (body-forms-new '())
-            (letbind '())
-            (mv nil)
-            (envector nil))
-       (when fv
-         ;; Here we form our environment vector.
-         ;; If outer closure contains all
-         ;; free variables of this function(and nothing else)
-         ;; then we use the same environment vector as for outer closure,
-         ;; i.e. we leave the environment vector unchanged,
-         ;; otherwise we build a new environment vector.
-         (if (eq (length envs) (length fv))
-             (let ((fv-temp fv))
-               (while (and fv-temp leave)
-                 (when (not (memq (car fv-temp) fvrs-new)) (setq leave nil))
-                 (setq fv-temp (cdr fv-temp))))
-           (setq leave nil))
-
-         (if (not leave)
-             (progn
-               (dolist (elm fv)
-                 (push
-                  (cconv-closure-convert-rec
-                   ;; Remove `elm' from `emvrs' for this call because in case
-                   ;; `elm' is a variable that's wrapped in a cons-cell, we
-                   ;; want to put the cons-cell itself in the closure, rather
-                   ;; than just a copy of its current content.
-                   elm (remq elm emvrs) fvrs envs lmenvs)
-                  envector))         ; Process vars for closure vector.
-               (setq envector (reverse envector))
-               (setq envs fv))
-           (setq envector `(,cconv--env-var))) ; Leave unchanged.
-         (setq fvrs-new fv))                ; Update substitution list.
-
-       (setq emvrs (cconv--set-diff emvrs vars))
-       (setq lmenvs (cconv--map-diff-set lmenvs vars))
-       
-       ;; The difference between envs and fvrs is explained
-       ;; in comment in the beginning of the function.
-       (dolist (elm cconv-captured+mutated) ; Find mutated arguments
-         (setq mv (car elm))                ; used in inner closures.
-         (when (and (memq mv vars) (eq form (caddr elm)))
-           (progn (push mv emvrs)
-                  (push `(,mv (list ,mv)) letbind))))
-       (dolist (elm body-forms)         ; convert function body
-         (push (cconv-closure-convert-rec
-                elm emvrs fvrs-new envs lmenvs)
-               body-forms-new))
-
-       (setq body-forms-new
-             (if letbind `((let ,letbind . ,(reverse body-forms-new)))
-               (reverse body-forms-new)))
-
-       (cond
-					;if no freevars - do nothing
-        ((null envector)
-         `(function (lambda ,vars . ,body-forms-new)))
-                               ; 1 free variable - do not build vector
-        ((null (cdr envector))
-         `(curry
-           (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new))
-           ,(car envector)))
-                                   ; >=2 free variables - build vector
-        (t
-         `(curry
-           (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new))
-           (vector . ,envector))))))
-
-    (`(function . ,_) form)             ; Same as quote.
+    (`(internal-make-closure . ,_)
+     (byte-compile-report-error
+      "Internal error in compiler: cconv called twice?"))
+
+    (`(quote . ,_) form)
+    (`(function . ,_) form)
 
 					;defconst, defvar
-    (`(,(and sym (or `defconst `defvar)) ,definedsymbol . ,body-forms)
-
-     (let ((body-forms-new '()))
-       (dolist (elm body-forms)
-         (push (cconv-closure-convert-rec
-                elm emvrs fvrs envs lmenvs)
-               body-forms-new))
-       (setq body-forms-new (reverse body-forms-new))
-       `(,sym ,definedsymbol . ,body-forms-new)))
-
-					;defun, defmacro
-    (`(,(and sym (or `defun `defmacro))
-       ,func ,vars . ,body-forms)
-     (let ((body-new '())	  ; The whole body.
-           (body-forms-new '())   ; Body w\o docstring and interactive.
-           (letbind '()))
-					; Find mutable arguments.
-       (dolist (elm vars)
-         (let ((lmutated cconv-captured+mutated)
-	       (ismutated nil))
-           (while (and lmutated (not ismutated))
-             (when (and (eq (caar lmutated) elm)
-                        (eq (caddar lmutated) form))
-               (setq ismutated t))
-             (setq lmutated (cdr lmutated)))
-           (when ismutated
-             (push elm letbind)
-             (push elm emvrs))))
-                                            ;Transform body-forms.
-       (when (stringp (car body-forms))     ; Treat docstring well.
-         (push (car body-forms) body-new)
-         (setq body-forms (cdr body-forms)))
-       (when (eq (car-safe (car body-forms)) 'interactive)
-         (push (cconv-closure-convert-rec
-                (car body-forms)
-                emvrs fvrs envs lmenvs)
-               body-new)
-         (setq body-forms (cdr body-forms)))
-
-       (dolist (elm body-forms)
-         (push (cconv-closure-convert-rec
-                elm emvrs fvrs envs lmenvs)
-               body-forms-new))
-       (setq body-forms-new (reverse body-forms-new))
-
-       (if letbind
-					; Letbind mutable arguments.
-           (let ((binders-new '()))
-             (dolist (elm letbind) (push `(,elm (list ,elm))
-                                         binders-new))
-             (push `(let ,(reverse binders-new) .
-                         ,body-forms-new) body-new)
-             (setq body-new (reverse body-new)))
-         (setq body-new (append (reverse body-new) body-forms-new)))
-
-       `(,sym ,func ,vars . ,body-new)))
+    (`(,(and sym (or `defconst `defvar)) ,definedsymbol . ,forms)
+     `(,sym ,definedsymbol
+            . ,(mapcar (lambda (form) (cconv-convert form env extend))
+                       forms)))
 
 					;condition-case
     (`(condition-case ,var ,protected-form . ,handlers)
-     (let ((handlers-new '())
-           (newform (cconv-closure-convert-rec
-                     `(function (lambda () ,protected-form))
-                     emvrs fvrs envs lmenvs)))
-       (setq fvrs (remq var fvrs))
-       (dolist (handler handlers)
-         (push (list (car handler)
-                     (cconv-closure-convert-rec
-                      `(function (lambda (,(or var cconv--dummy-var))
-                                   ,@(cdr handler)))
-                      emvrs fvrs envs lmenvs))
-               handlers-new))
+     (let ((newform (cconv--convert-function
+                     () (list protected-form) env form)))
        `(condition-case :fun-body ,newform
-          ,@(nreverse handlers-new))))
+	  ,@(mapcar (lambda (handler)
+                      (list (car handler)
+                            (cconv--convert-function
+                             (list (or var cconv--dummy-var))
+                             (cdr handler) env form)))
+                    handlers))))
 
     (`(,(and head (or `catch `unwind-protect)) ,form . ,body)
-     `(,head ,(cconv-closure-convert-rec form emvrs fvrs envs lmenvs)
-        :fun-body
-        ,(cconv-closure-convert-rec `(function (lambda () ,@body))
-                                    emvrs fvrs envs lmenvs)))
+     `(,head ,(cconv-convert form env extend)
+        :fun-body ,(cconv--convert-function () body env form)))
 
     (`(track-mouse . ,body)
      `(track-mouse
-        :fun-body
-        ,(cconv-closure-convert-rec `(function (lambda () ,@body))
-                                    emvrs fvrs envs lmenvs)))
+        :fun-body ,(cconv--convert-function () body env form)))
 
     (`(setq . ,forms)                   ; setq special form
-     (let (prognlist sym sym-new value)
+     (let ((prognlist ()))
        (while forms
-         (setq sym (car forms))
-         (setq sym-new (cconv-closure-convert-rec
-                        sym
-                        (remq sym emvrs) fvrs envs lmenvs))
-         (setq value
-               (cconv-closure-convert-rec
-                (cadr forms) emvrs fvrs envs lmenvs))
-         (if (memq sym emvrs)
-             (push `(setcar ,sym-new ,value) prognlist)
-           (if (symbolp sym-new)
-               (push `(setq ,sym-new ,value) prognlist)
-	     (debug)		       ;FIXME: When can this be right?
-             (push `(set ,sym-new ,value) prognlist)))
-         (setq forms (cddr forms)))
+         (let* ((sym (pop forms))
+                (sym-new (or (cdr (assq sym env)) sym))
+                (value (cconv-convert (pop forms) env extend)))
+           (push (pcase sym-new
+                   ((pred symbolp) `(setq ,sym-new ,value))
+                   (`(car ,iexp) `(setcar ,iexp ,value))
+                   ;; This "should never happen", but for variables which are
+                   ;; mutated+captured+unused, we may end up trying to `setq'
+                   ;; on a closed-over variable, so just drop the setq.
+                   (_ ;; (byte-compile-report-error
+                    ;;  (format "Internal error in cconv of (setq %s ..)"
+                    ;;          sym-new))
+                    value))
+                 prognlist)))
        (if (cdr prognlist)
-           `(progn . ,(reverse prognlist))
+           `(progn . ,(nreverse prognlist))
          (car prognlist))))
 
     (`(,(and (or `funcall `apply) callsym) ,fun . ,args)
-                                     ; funcall is not a special form
-                                     ; but we treat it separately
-                                     ; for the needs of lambda lifting
-     (let ((fv (cdr (assq fun lmenvs))))
-       (if fv
-           (let ((args-new '())
-                 (processed-fv '()))
-             ;; All args (free variables and actual arguments)
-             ;; should be processed, because they can be fvrs
-             ;; (free variables of another closure)
-             (dolist (fvr fv)
-               (push (cconv-closure-convert-rec
-                      fvr (remq fvr emvrs)
-                      fvrs envs lmenvs)
-                     processed-fv))
-             (setq processed-fv (reverse processed-fv))
-             (dolist (elm args)
-               (push (cconv-closure-convert-rec
-                      elm emvrs fvrs envs lmenvs)
-                     args-new))
-             (setq args-new (append processed-fv (reverse args-new)))
-             (setq fun (cconv-closure-convert-rec
-                        fun emvrs fvrs envs lmenvs))
-             `(,callsym ,fun . ,args-new))
-         (let ((cdr-new '()))
-           (dolist (elm (cdr form))
-             (push (cconv-closure-convert-rec
-                    elm emvrs fvrs envs lmenvs)
-                   cdr-new))
-           `(,callsym . ,(reverse cdr-new))))))
-
-    (`(,func . ,body-forms)    ; first element is function or whatever
-                               ; function-like forms are:
-                               ; or, and, if, progn, prog1, prog2,
-                               ; while, until
-     (let ((body-forms-new '()))
-       (dolist (elm body-forms)
-         (push (cconv-closure-convert-rec
-                elm emvrs fvrs envs lmenvs)
-               body-forms-new))
-       (setq body-forms-new (reverse body-forms-new))
-       `(,func . ,body-forms-new)))
-
-    (_
-     (let ((free (memq form fvrs)))
-       (if free                         ;form is a free variable
-           (let* ((numero (- (length fvrs) (length free)))
-                  (var (if (null (cdr envs))
-                           cconv--env-var
-                         ;; Replace form => (aref env #)
-                         `(aref ,cconv--env-var ,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
-     ((byte-compile-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.
--- 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."
+     ;; These are not special forms but we treat them separately for the needs
+     ;; of lambda lifting.
+     (let ((mapping (cdr (assq fun env))))
+       (pcase mapping
+         (`(apply-partially ,_ . ,(and fvs `(,_ . ,_)))
+          (cl-assert (eq (cadr mapping) fun))
+          `(,callsym ,fun
+                     ,@(mapcar (lambda (fv)
+                                 (let ((exp (or (cdr (assq fv env)) fv)))
+                                   (pcase exp
+                                     (`(car ,iexp . ,_) iexp)
+                                     (_ exp))))
+                               fvs)
+                     ,@(mapcar (lambda (arg)
+                                 (cconv-convert arg env extend))
+                               args)))
+         (_ `(,callsym ,@(mapcar (lambda (arg)
+                                   (cconv-convert arg env extend))
+                                 (cons fun args)))))))
+
+    (`(interactive . ,forms)
+     `(interactive . ,(mapcar (lambda (form)
+                                (cconv-convert form nil nil))
+                              forms)))
+
+    (`(declare . ,_) form)              ;The args don't contain code.
+
+    (`(,func . ,forms)
+     ;; First element is function or whatever function-like forms are: or, and,
+     ;; if, progn, prog1, prog2, while, until
+     `(,func . ,(mapcar (lambda (form)
+                          (cconv-convert form env extend))
+                        forms)))
+
+    (_ (or (cdr (assq form env)) form))))
+
+(unless (fboundp 'byte-compile-not-lexical-var-p)
+  ;; Only used to test the code in non-lexbind Emacs.
+  (defalias 'byte-compile-not-lexical-var-p 'boundp))
+
+(defun cconv--analyse-use (vardata form varkind)
+  "Analyze the use of a variable.
+VARDATA should be (BINDER READ MUTATED CAPTURED CALLED).
+VARKIND is the name of the kind of variable.
+FORM is the parent form that binds this var."
+  ;; use = `(,binder ,read ,mutated ,captured ,called)
+  (pcase vardata
+    (`(,_ nil nil nil nil) nil)
+    (`((,(and (pred (lambda (var) (eq ?_ (aref (symbol-name var) 0)))) var) . ,_)
+       ,_ ,_ ,_ ,_)
+     (byte-compile-log-warning
+      (format "%s `%S' not left unused" varkind var))))
+  (pcase vardata
+    (`((,var . ,_) nil ,_ ,_ nil)
+     ;; FIXME: This gives warnings in the wrong order, with imprecise line
+     ;; numbers and without function name info.
+     (unless (or ;; Uninterned symbols typically come from macro-expansion, so
+              ;; it is often non-trivial for the programmer to avoid such
+              ;; unused vars.
+              (not (intern-soft var))
+              (eq ?_ (aref (symbol-name var) 0))
+	      ;; As a special exception, ignore "ignore".
+	      (eq var 'ignored))
+       (byte-compile-log-warning (format "Unused lexical %s `%S'"
+                                         varkind var))))
+    ;; If it's unused, there's no point converting it into a cons-cell, even if
+    ;; it's captured and mutated.
+    (`(,binder ,_ t t ,_)
+     (push (cons binder form) cconv-captured+mutated))
+    (`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t)
+     (push (cons binder form) cconv-lambda-candidates))))
+
+(defun cconv--analyse-function (args body env parentform)
+  (let* ((newvars nil)
+         (freevars (list body))
+         ;; We analyze the body within a new environment where all uses are
+         ;; nil, so we can distinguish uses within that function from uses
+         ;; outside of it.
+         (envcopy
+          (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env))
+         (newenv envcopy))
+    ;; Push it before recursing, so cconv-freevars-alist contains entries in
+    ;; the order they'll be used by closure-convert-rec.
+    (push freevars cconv-freevars-alist)
+    (dolist (arg args)
+      (cond
+       ((byte-compile-not-lexical-var-p arg)
+        (byte-compile-log-warning
+         (format "Argument %S is not a lexical variable" arg)))
+       ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ...
+       (t (let ((varstruct (list arg nil nil nil nil)))
+            (push (cons (list arg) (cdr varstruct)) newvars)
+            (push varstruct newenv)))))
+    (dolist (form body)                   ;Analyze body forms.
+      (cconv-analyse-form form newenv))
+    ;; Summarize resulting data about arguments.
+    (dolist (vardata newvars)
+      (cconv--analyse-use vardata parentform "argument"))
+    ;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
+    ;; and compute free variables.
+    (while env
+      (cl-assert (and envcopy (eq (caar env) (caar envcopy))))
+      (let ((free nil)
+            (x (cdr (car env)))
+            (y (cdr (car envcopy))))
+        (while x
+          (when (car y) (setcar x t) (setq free t))
+          (setq x (cdr x) y (cdr y)))
+        (when free
+          (push (caar env) (cdr freevars))
+          (setf (nth 3 (car env)) t))
+        (setq env (cdr env) envcopy (cdr envcopy))))))
+
+(defun cconv-analyse-form (form env)
+  "Find mutated variables and variables captured by closure.
+Analyze lambdas if they are suitable for lambda lifting.
+- FORM is a piece of Elisp code after macroexpansion.
+- ENV is an alist mapping each enclosing lexical variable to its info.
+   I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)).
+This function does not return anything but instead fills the
+`cconv-captured+mutated' and `cconv-lambda-candidates' variables
+and updates the data stored in ENV."
   (pcase form
 					; let special form
     (`(,(and (or `let* `let) letsym) ,binders . ,body-forms)
 
      (let ((orig-env env)
+           (newvars nil)
            (var nil)
            (value nil))
        (dolist (binder binders)
          (if (not (consp binder))
              (progn
                (setq var binder)      ; treat the form (let (x) ...) well
+               (setq binder (list binder))
                (setq value nil))
            (setq var (car binder))
            (setq value (cadr binder))
 
-           (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)
-                               inclosure))
+           (cconv-analyse-form value (if (eq letsym 'let*) env orig-env)))
 
          (unless (byte-compile-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)
-     (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))
+           (let ((varstruct (list var nil nil nil nil)))
+             (push (cons binder (cdr varstruct)) newvars)
+             (push varstruct env))))
+
+       (dolist (form body-forms)          ; Analyze body forms.
+         (cconv-analyse-form form env))
+
+       (dolist (vardata newvars)
+         (cconv--analyse-use vardata form "variable"))))
 
     (`(function (lambda ,vrs . ,body-forms))
-     (cconv-analyse-function vrs body-forms env form (1+ inclosure)))
-     
+     (cconv--analyse-function vrs body-forms env form))
+
     (`(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) env))) ; v = non nil if visible
-         (when v
-           (push v cconv-mutated)
-           ;; Delete from candidate list for lambda lifting.
-           (setq cconv-lambda-candidates (delq v cconv-lambda-candidates))
-           (unless (eq inclosure (cadr v)) ;Bound in a different closure level.
-             (push v cconv-captured))))
-       (cconv-analyse-form (cadr forms) env inclosure)
+         (when v (setf (nth 2 v) t)))
+       (cconv-analyse-form (cadr forms) env)
        (setq forms (cddr forms))))
 
-    (`((lambda . ,_) . ,_)             ; first element is lambda expression
+    (`((lambda . ,_) . ,_)             ; First element is lambda expression.
+     (byte-compile-log-warning
+      "Use of deprecated ((lambda ...) ...) form" t :warning)
      (dolist (exp `((function ,(car form)) . ,(cdr form)))
-       (cconv-analyse-form exp env inclosure)))
+       (cconv-analyse-form exp env)))
 
     (`(cond . ,cond-forms)              ; cond special form
      (dolist (forms cond-forms)
-       (dolist (form forms)
-         (cconv-analyse-form form env inclosure))))
+       (dolist (form forms) (cconv-analyse-form form env))))
 
     (`(quote . ,_) nil)                 ; quote form
     (`(function . ,_) nil)              ; same as quote
 
     (`(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)
+     ;; form and handlers in closures (for handlers, it's understandable
+     ;; but not for the protected form).
+     (cconv--analyse-function () (list protected-form) env form)
      (dolist (handler handlers)
-       (dolist (form (cdr handler))
-         (cconv-analyse-form form env inclosure))))
+       (cconv--analyse-function (if var (list var)) (cdr handler) env form)))
 
     ;; 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)))
+     (cconv-analyse-form form env)
+     (cconv--analyse-function () body env form))
 
-    ;; FIXME: The bytecode for save-window-excursion and the lack of
-    ;; bytecode for track-mouse forces us to wrap the body.
+    ;; FIXME: The lack of bytecode for track-mouse forces us to wrap the body.
+    ;; `track-mouse' really should be made into a macro.
     (`(track-mouse . ,body)
-     (setq inclosure (1+ inclosure))
-     (dolist (form body)
-       (cconv-analyse-form form env inclosure)))
+     (cconv--analyse-function () body env form))
 
     (`(,(or `defconst `defvar) ,var ,value . ,_)
      (push var byte-compile-bound-variables)
-     (cconv-analyse-form value env inclosure))
+     (cconv-analyse-form value env))
 
     (`(,(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 (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)))
+     (let ((fdata (and (symbolp fun) (assq fun env))))
+       (if fdata
+           (setf (nth 4 fdata) t)
+         (cconv-analyse-form fun env)))
+     (dolist (form args) (cconv-analyse-form form env)))
+
+    (`(interactive . ,forms)
+     ;; These appear within the function body but they don't have access
+     ;; to the function's arguments.
+     ;; We could extend this to allow interactive specs to refer to
+     ;; variables in the function's enclosing environment, but it doesn't
+     ;; seem worth the trouble.
+     (dolist (form forms) (cconv-analyse-form form nil)))
+
+    (`(declare . ,_) nil)               ;The args don't contain code.
 
     (`(,_ . ,body-forms)    ; First element is a function or whatever.
-     (dolist (form body-forms)
-       (cconv-analyse-form form env inclosure)))
+     (dolist (form body-forms) (cconv-analyse-form form env)))
 
     ((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)))))))
+         (setf (nth 1 dv) t))))))
 
 (provide 'cconv)
 ;;; cconv.el ends here