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

diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el
index 0e4b5d3169..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,21 +26,21 @@
 
 ;; 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 :
@@ -65,21 +65,54 @@
 ;;
 ;;; Code:
 
-;;; TODO:
-;; - pay attention to `interactive': its arg is run in an empty env.
+;; 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.
-;; - 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.
-;; - warn about unused lexical vars.
-;; - clean up cconv-closure-convert-rec, especially the `let' binding part.
 ;; - 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.")
 ;; List of all the variables that are both captured by a closure
@@ -107,16 +140,10 @@ Returns a form where all lambdas don't have any free variables."
   (let ((cconv-freevars-alist '())
 	(cconv-lambda-candidates '())
 	(cconv-captured+mutated '()))
-    ;; Analyse form - fill these variables with new information.
+    ;; Analyze form - fill these variables with new information.
     (cconv-analyse-form form '())
     (setq cconv-freevars-alist (nreverse cconv-freevars-alist))
-    (cconv-closure-convert-rec
-     form                               ; the tree
-     '()                                ;
-     '()                                ; fvrs initially empty
-     '()                                ; envs initially empty
-     '()
-     )))
+    (cconv-convert form nil nil))) ; Env initially empty.
 
 (defconst cconv--dummy-var (make-symbol "ignored"))
 
@@ -146,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)
@@ -157,71 +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-function (fvrs vars emvrs envs lmenvs body-forms
-                                            parentform)
-  (assert (equal body-forms (caar cconv-freevars-alist)))
-  (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs.
-         (fv (cdr (pop cconv-freevars-alist)))
-         (body-forms-new '())
+(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 nil))
-    (when fv
-      ;; Here we form our environment vector.
-
-      (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 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 (var vars)
-      (when (member (cons (list var) parentform) cconv-captured+mutated)
-        (push var emvrs)
-        (push `(,var (list ,var)) 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)))
+         (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
-					;if no freevars - do nothing
-     ((null envector)
-      `(function (lambda ,vars . ,body-forms-new)))
-                                        ; 1 free variable - do not build vector
+     ((null envector)                   ;if no freevars - do nothing
+      `(function (lambda ,args . ,body-new)))
      (t
       `(internal-make-closure
-        ,vars ,envector . ,body-forms-new)))))
+        ,args ,envector . ,body-new)))))
 
-(defun cconv-closure-convert-rec (form emvrs fvrs envs lmenvs)
+(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)))
@@ -234,18 +269,12 @@ 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)
@@ -256,375 +285,244 @@ Returns a form where all lambdas don't have any free variables."
                 (new-val
                  (cond
                   ;; Check if var is a candidate for lambda lifting.
-                  ((member (cons binder form) cconv-lambda-candidates)
-                   (assert (and (eq (car value) 'function)
-                                (eq (car (cadr value)) 'lambda)))
-                   (assert (equal (cddr (cadr value))
-                                  (caar cconv-freevars-alist)))
-                   (let* ((fv (cdr (pop cconv-freevars-alist)))
-                          (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".
                   ((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)
-
-         ;; 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))))
-
-    (`(quote . ,_) form)
+     `(cond . ,(mapcar (lambda (branch)
+                         (mapcar (lambda (form)
+                                   (cconv-convert form env extend))
+                                 branch))
+                       cond-forms)))
 
-    (`(function (lambda ,vars . ,body-forms)) ; function form
-     (cconv-closure-convert-function
-      fvrs vars emvrs envs lmenvs body-forms form))
+    (`(function (lambda ,args . ,body) . ,_)
+     (cconv--convert-function args body env form))
 
     (`(internal-make-closure . ,_)
-     (error "Internal byte-compiler error: cconv called twice"))
+     (byte-compile-report-error
+      "Internal error in compiler: cconv called twice?"))
 
-    (`(function . ,_) form)             ; Same as quote.
+    (`(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)
-
-     ;; The freevar data was pushed onto cconv-freevars-alist
-     ;; but we don't need it.
-     (assert (equal body-forms (caar cconv-freevars-alist)))
-     (assert (null (cdar cconv-freevars-alist)))
-     (setq cconv-freevars-alist (cdr cconv-freevars-alist))
-
-     (let ((body-new '())	  ; The whole body.
-           (body-forms-new '())   ; Body w\o docstring and interactive.
-           (letbind '()))
-					; Find mutable arguments.
-       (dolist (elm vars)
-         (when (member (cons (list elm) form) cconv-captured+mutated)
-           (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 ((newform (cconv-closure-convert-rec
-                     `(function (lambda () ,protected-form))
-                     emvrs fvrs envs lmenvs)))
-       (setq fvrs (remq var fvrs))
+     (let ((newform (cconv--convert-function
+                     () (list protected-form) env form)))
        `(condition-case :fun-body ,newform
 	  ,@(mapcar (lambda (handler)
                       (list (car handler)
-                            (cconv-closure-convert-rec
-                             (let ((arg (or var cconv--dummy-var)))
-                               `(function (lambda (,arg) ,@(cdr handler))))
-                             emvrs fvrs envs lmenvs)))
+                            (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))
-         (cond
-          ((memq sym emvrs) (push `(setcar ,sym-new ,value) prognlist))
-          ((symbolp sym-new) (push `(setq ,sym-new ,value) prognlist))
-          ;; 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.
-          (t (push 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)))
-                  ;; Replace form => (aref env #)
-                  (var `(internal-get-closed-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))))))
+     ;; 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)
+(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
-    (`(,binder nil ,_ ,_ nil)
-     ;; FIXME: Don't warn about unused fun-args.
-     ;; FIXME: Don't warn about uninterned vars or _ vars.
-     ;; FIXME: This gives warnings in the wrong order and with wrong line
-     ;; number and without function name info.
-     (byte-compile-log-warning (format "Unused variable %S" (car binder))))
+    (`(,_ 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 captures and mutated.
+    ;; it's captured and mutated.
     (`(,binder ,_ t t ,_)
      (push (cons binder form) cconv-captured+mutated))
     (`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t)
-     ;; This is very rare in typical Elisp code.  It's probably not really
-     ;; worth the trouble to try and use lambda-lifting in Elisp, but
-     ;; since we coded it up, we might as well use it.
-     (push (cons binder form) cconv-lambda-candidates))
-    (`(,_ ,_ ,_ ,_ ,_) nil)
-    (dontcare)))
-
-(defun cconv-analyse-function (args body env parentform)
+     (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
@@ -639,21 +537,21 @@ Returns a form where all lambdas don't have any free variables."
     (dolist (arg args)
       (cond
        ((byte-compile-not-lexical-var-p arg)
-        (byte-compile-report-error
+        (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)                   ;Analyse body forms.
+    (dolist (form body)                   ;Analyze body forms.
       (cconv-analyse-form form newenv))
     ;; Summarize resulting data about arguments.
     (dolist (vardata newvars)
-      (cconv-analyse-use vardata parentform))
+      (cconv--analyse-use vardata parentform "argument"))
     ;; Transfer uses collected in `envcopy' (via `newenv') back to `env';
     ;; and compute free variables.
     (while env
-      (assert (and envcopy (eq (caar env) (caar envcopy))))
+      (cl-assert (and envcopy (eq (caar env) (caar envcopy))))
       (let ((free nil)
             (x (cdr (car env)))
             (y (cdr (car envcopy))))
@@ -667,9 +565,9 @@ Returns a form where all lambdas don't have any free variables."
 
 (defun cconv-analyse-form (form env)
   "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 an alist mapping each enclosing lexical variable to its info.
+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
@@ -698,24 +596,15 @@ and updates the data stored in ENV."
              (push (cons binder (cdr varstruct)) newvars)
              (push varstruct env))))
 
-       (dolist (form body-forms)          ; Analyse body forms.
+       (dolist (form body-forms)          ; Analyze body forms.
          (cconv-analyse-form form env))
 
        (dolist (vardata newvars)
-         (cconv-analyse-use vardata form))))
-
-					; 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))
+         (cconv--analyse-use vardata form "variable"))))
 
     (`(function (lambda ,vrs . ,body-forms))
-     (cconv-analyse-function vrs body-forms env form))
-     
+     (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.
@@ -725,35 +614,36 @@ and updates the data stored in ENV."
        (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)))
 
     (`(cond . ,cond-forms)              ; cond special form
      (dolist (forms cond-forms)
-       (dolist (form forms)
-         (cconv-analyse-form form env))))
+       (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).
-     (cconv-analyse-function () (list protected-form) env form)
+     ;; 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)
-       (cconv-analyse-function (if var (list var)) (cdr handler) env form)))
+       (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)
-     (cconv-analyse-function () body env form))
+     (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)
-     (cconv-analyse-function () body env form))
+     (cconv--analyse-function () body env form))
 
     (`(,(or `defconst `defvar) ,var ,value . ,_)
      (push var byte-compile-bound-variables)
@@ -768,12 +658,20 @@ and updates the data stored in ENV."
        (if fdata
            (setf (nth 4 fdata) t)
          (cconv-analyse-form fun env)))
-     (dolist (form args)
-       (cconv-analyse-form form 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)))
+     (dolist (form body-forms) (cconv-analyse-form form env)))
 
     ((pred symbolp)
      (let ((dv (assq form env)))        ; dv = declared and visible