New branch for lexbind, losing all history.

This initial patch is based on 2002-06-27T22:39:10Z!storm@cua.dk of the original
lexbind branch.

30 files changed, 3032 insertions, 416 deletions

diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi
index 0f746187212..46d242fcfba 100644
--- a/doc/lispref/elisp.texi
+++ b/doc/lispref/elisp.texi
@@ -248,7 +248,7 @@ Programming Types
 * Macro Type::          A method of expanding an expression into another
                           expression, more fundamental but less pretty.
 * Primitive Function Type::     A function written in C, callable from Lisp.
-* Byte-Code Type::      A function written in Lisp, then compiled.
+* Funvec Type::         A vector type callable as a function.
 * Autoload Type::       A type used for automatically loading seldom-used
                           functions.
 
@@ -463,10 +463,11 @@ Functions
 * Inline Functions::	    Defining functions that the compiler
                               will open code.
 * Declaring Functions::	    Telling the compiler that a function is defined.
+* Function Currying::       Making wrapper functions that pre-specify
+                              some arguments.
 * Function Safety::         Determining whether a function is safe to call.
 * Related Topics::          Cross-references to specific Lisp primitives
-                              that have a special bearing on how
-                              functions work.
+                              that have a special bearing on how functions work.
 
 Lambda Expressions
 
diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi
index 37e8726592a..7e8ac09b44e 100644
--- a/doc/lispref/functions.texi
+++ b/doc/lispref/functions.texi
@@ -22,7 +22,9 @@ define them.
 * Function Cells::        Accessing or setting the function definition
                             of a symbol.
 * Obsolete Functions::    Declaring functions obsolete.
-* Inline Functions::	  Defining functions that the compiler will open code.
+* Inline Functions::      Defining functions that the compiler will open code.
+* Function Currying::     Making wrapper functions that pre-specify
+                            some arguments.
 * Declaring Functions::   Telling the compiler that a function is defined.
 * Function Safety::       Determining whether a function is safe to call.
 * Related Topics::        Cross-references to specific Lisp primitives
@@ -111,7 +113,25 @@ editors; for Lisp programs, the distinction is normally unimportant.
 
 @item byte-code function
 A @dfn{byte-code function} is a function that has been compiled by the
-byte compiler.  @xref{Byte-Code Type}.
+byte compiler.  A byte-code function is actually a special case of a
+@dfn{funvec} object (see below).
+
+@item function vector
+A @dfn{function vector}, or @dfn{funvec} is a vector-like object whose
+purpose is to define special kinds of functions.  @xref{Funvec Type}.
+
+The exact meaning of the vector elements is determined by the type of
+funvec: the most common use is byte-code functions, which have a
+list---the argument list---as the first element.  Further types of
+funvec object are:
+
+@table @code
+@item curry
+A curried function.  Remaining arguments in the funvec are function to
+call, and arguments to prepend to user arguments at the time of the
+call; @xref{Function Currying}.
+@end table
+
 @end table
 
 @defun functionp object
@@ -152,6 +172,11 @@ function.  For example:
 @end example
 @end defun
 
+@defun funvecp object
+@code{funvecp} returns @code{t} if @var{object} is a function vector
+object (including byte-code objects), and @code{nil} otherwise.
+@end defun
+
 @defun subr-arity subr
 This function provides information about the argument list of a
 primitive, @var{subr}.  The returned value is a pair
@@ -1277,6 +1302,49 @@ do for macros.  (@xref{Argument Evaluation}.)
 Inline functions can be used and open-coded later on in the same file,
 following the definition, just like macros.
 
+@node Function Currying
+@section Function Currying
+@cindex function currying
+@cindex currying
+@cindex partial-application
+
+Function currying is a way to make a new function that calls an
+existing function with a partially pre-determined argument list.
+
+@defun curry function &rest args
+Return a function-like object that will append any arguments it is
+called with to @var{args}, and call @var{function} with the resulting
+list of arguments.
+
+For example, @code{(curry 'concat "The ")} returns a function that
+concatenates @code{"The "} and its arguments.  Calling this function
+on @code{"end"} returns @code{"The end"}:
+
+@example
+(funcall (curry 'concat "The ") "end")
+     @result{} "The end"
+@end example
+
+The @dfn{curried function} is useful as an argument to @code{mapcar}:
+
+@example
+(mapcar (curry 'concat "The ") '("big" "red" "balloon"))
+     @result{} ("The big" "The red" "The balloon")
+@end example
+@end defun
+
+Function currying may be implemented in any Lisp by constructing a
+@code{lambda} expression, for instance:
+
+@example
+(defun curry (function &rest args)
+  `(lambda (&rest call-args)
+      (apply #',function ,@@args call-args)))
+@end example
+
+However in Emacs Lisp, a special curried function object is used for
+efficiency.  @xref{Funvec Type}.
+
 @node Declaring Functions
 @section Telling the Compiler that a Function is Defined
 @cindex function declaration
diff --git a/doc/lispref/objects.texi b/doc/lispref/objects.texi
index 5c3ac13cdaf..1a72fdf671c 100644
--- a/doc/lispref/objects.texi
+++ b/doc/lispref/objects.texi
@@ -157,7 +157,7 @@ latter are unique to Emacs Lisp.
 * Macro Type::          A method of expanding an expression into another
                           expression, more fundamental but less pretty.
 * Primitive Function Type::     A function written in C, callable from Lisp.
-* Byte-Code Type::      A function written in Lisp, then compiled.
+* Funvec Type::         A vector type callable as a function.
 * Autoload Type::       A type used for automatically loading seldom-used
                         functions.
 @end menu
@@ -1315,18 +1315,55 @@ with the name of the subroutine.
 @end group
 @end example
 
-@node Byte-Code Type
-@subsection Byte-Code Function Type
+@node Funvec Type
+@subsection ``Function Vector' Type
+@cindex function vector
+@cindex funvec
 
-The byte compiler produces @dfn{byte-code function objects}.
-Internally, a byte-code function object is much like a vector; however,
-the evaluator handles this data type specially when it appears as a
-function to be called.  @xref{Byte Compilation}, for information about
-the byte compiler.
+A @dfn{function vector}, or @dfn{funvec} is a vector-like object whose
+purpose is to define special kinds of functions.  You can examine or
+modify the contents of a funvec like a normal vector, using the
+@code{aref} and @code{aset} functions.
 
-The printed representation and read syntax for a byte-code function
-object is like that for a vector, with an additional @samp{#} before the
-opening @samp{[}.
+The behavior of a funvec when called is dependent on the kind of
+funvec it is, and that is determined by its first element (a
+zero-length funvec will signal an error if called):
+
+@table @asis
+@item A list
+A funvec with a list as its first element is a byte-compiled function,
+produced by the byte compiler; such funvecs are known as
+@dfn{byte-code function objects}.  @xref{Byte Compilation}, for
+information about the byte compiler.
+
+@item The symbol @code{curry}
+A funvec with @code{curry} as its first element is a ``curried function''.
+
+The second element in such a funvec is the function which is
+being curried, and the remaining elements are a list of arguments.
+
+Calling such a funvec operates by calling the embedded function with
+an argument list composed of the arguments in the funvec followed by
+the arguments the funvec was called with.  @xref{Function Currying}.
+@end table
+
+The printed representation and read syntax for a funvec object is like
+that for a vector, with an additional @samp{#} before the opening
+@samp{[}.
+
+@defun funvecp object
+@code{funvecp} returns @code{t} if @var{object} is a function vector
+object (including byte-code objects), and @code{nil} otherwise.
+@end defun
+
+@defun funvec kind &rest params
+@code{funvec} returns a new function vector containing @var{kind} and
+@var{params}.  @var{kind} determines the type of funvec; it should be
+one of the choices listed in the table above.
+
+Typically you should use the @code{make-byte-code} function to create
+byte-code objects, though they are a type of funvec.
+@end defun
 
 @node Autoload Type
 @subsection Autoload Type
@@ -1773,7 +1810,7 @@ with references to further information.
 @xref{Buffer Basics, bufferp}.
 
 @item byte-code-function-p
-@xref{Byte-Code Type, byte-code-function-p}.
+@xref{Funvec Type, byte-code-function-p}.
 
 @item case-table-p
 @xref{Case Tables, case-table-p}.
diff --git a/doc/lispref/vol1.texi b/doc/lispref/vol1.texi
index a0590c3d282..052d83eacd7 100644
--- a/doc/lispref/vol1.texi
+++ b/doc/lispref/vol1.texi
@@ -268,7 +268,7 @@ Programming Types
 * Macro Type::          A method of expanding an expression into another
                           expression, more fundamental but less pretty.
 * Primitive Function Type::     A function written in C, callable from Lisp.
-* Byte-Code Type::      A function written in Lisp, then compiled.
+* Funvec Type::         A vector type callable as a function.
 * Autoload Type::       A type used for automatically loading seldom-used
                           functions.
 
diff --git a/doc/lispref/vol2.texi b/doc/lispref/vol2.texi
index ad4c74611a8..d6358f3ecfc 100644
--- a/doc/lispref/vol2.texi
+++ b/doc/lispref/vol2.texi
@@ -267,7 +267,7 @@ Programming Types
 * Macro Type::          A method of expanding an expression into another
                           expression, more fundamental but less pretty.
 * Primitive Function Type::     A function written in C, callable from Lisp.
-* Byte-Code Type::      A function written in Lisp, then compiled.
+* Funvec Type::         A vector type callable as a function.
 * Autoload Type::       A type used for automatically loading seldom-used
                           functions.
 
diff --git a/etc/NEWS.lexbind b/etc/NEWS.lexbind
new file mode 100644
index 00000000000..372ee6827cf
--- /dev/null
+++ b/etc/NEWS.lexbind
@@ -0,0 +1,55 @@
+GNU Emacs NEWS -- history of user-visible changes.
+
+Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
+          Free Software Foundation, Inc.
+See the end of the file for license conditions.
+
+Please send Emacs bug reports to bug-gnu-emacs@gnu.org.
+If possible, use M-x report-emacs-bug.
+
+This file is about changes in the Emacs "lexbind" branch.
+
+
+* Lisp changes in Emacs 23.1
+
+** New `function vector' type, including function currying
+The `function vector', or `funvec' type extends the old
+byte-compiled-function vector type to have other uses as well, and
+includes existing byte-compiled functions as a special case.  The kind
+of funvec is determined by the first element: a list is a byte-compiled
+function, and a non-nil atom is one of the new extended uses, currently
+`curry' for curried functions.  See the node `Funvec Type' in the Emacs
+Lisp Reference Manual for more information.
+
+*** New function curry allows constructing `curried functions'
+(see the node `Function Currying' in the Emacs Lisp Reference Manual).
+
+*** New functions funvec and funvecp allow primitive access to funvecs
+
+
+
+----------------------------------------------------------------------
+This file is part of GNU Emacs.
+
+GNU Emacs is free software; you can redistribute it and/or modify
+it under the terms of the GNU General Public License as published by
+the Free Software Foundation; either version 2, or (at your option)
+any later version.
+
+GNU Emacs is distributed in the hope that it will be useful,
+but WITHOUT ANY WARRANTY; without even the implied warranty of
+MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+GNU General Public License for more details.
+
+You should have received a copy of the GNU General Public License
+along with GNU Emacs; see the file COPYING.  If not, write to the
+Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+Boston, MA 02110-1301, USA.
+
+
+Local variables:
+mode: outline
+paragraph-separate: "[ 	]*$"
+end:
+
+arch-tag: d5ab31ab-2041-4b15-a1a9-e7c42693060c
diff --git a/lisp/ChangeLog.funvec b/lisp/ChangeLog.funvec
new file mode 100644
index 00000000000..0a31b9a590f
--- /dev/null
+++ b/lisp/ChangeLog.funvec
@@ -0,0 +1,10 @@
+2004-05-20  Miles Bader  <miles@gnu.org>
+
+	* subr.el (functionp): Use `funvecp' instead of
+	`byte-compiled-function-p'.
+	* help-fns.el (describe-function-1): Describe curried functions
+	and other funvecs as such.
+	(help-highlight-arguments): Only format things that look like a
+	function.
+
+;; arch-tag: 87f75aac-de53-40d7-96c7-3befaa771cb1
diff --git a/lisp/ChangeLog.lexbind b/lisp/ChangeLog.lexbind
new file mode 100644
index 00000000000..ca491f961d7
--- /dev/null
+++ b/lisp/ChangeLog.lexbind
@@ -0,0 +1,256 @@
+2006-12-04  Miles Bader  <miles@gnu.org>
+
+	* Makefile.in (COMPILE_FIRST_STACK_DEPTH): New variable.
+	(compile, compile-always): Use it.
+
+2005-10-24  Miles Bader  <miles@gnu.org>
+
+	* subr.el (functionp): Re-remove.
+
+	* emacs-lisp/bytecomp.el (byte-compile-closure): Add optional
+	ADD-LAMBDA argument, which we just pass to `byte-compile-lambda'.
+	(byte-compile-defun): Use ADD-LAMBDA arg to `byte-compile-closure'
+	instead of adding lambda ourselves.
+	
+2004-08-09  Miles Bader  <miles@gnu.org>
+
+	Changes from merging the funvec patch:
+
+	* emacs-lisp/bytecomp.el (byte-compile-make-closure): Use `curry'
+	instead of `vector' to create compiled closures.
+
+	Merge funvec patch.
+
+2004-04-29  Miles Bader  <miles@gnu.org>
+
+	* emacs-lisp/bytecomp.el (byte-compile-top-level): Add new entries
+	to `byte-compile-lexical-environment' at the start, not end.
+	(byte-compile-delay-out): Correctly default STACK-ADJUST to zero.
+
+	* emacs-lisp/byte-opt.el (byte-opt-update-stack-params): Don't
+	crash on no-op lapcode entries (car is nil).
+
+	* emacs-lisp/byte-lexbind.el (byte-compile-make-lambda-lexenv):
+	Push a lexvar onto lexenv, not a vinfo!
+
+2004-04-11  Miles Bader  <miles@gnu.org>
+
+	* emacs-lisp/bytecomp.el (byte-compile-top-level): Correctly
+	analyze lexically-bound arguments.
+
+	* emacs-lisp/byte-lexbind.el (byte-compile-lforminfo-analyze):
+	Use `append' instead of `nconc'.
+
+	* emacs-lisp/byte-lexbind.el (byte-compile-make-lvarinfo): Don't
+	use backquote to make a mutable data-structure.
+	(byte-compile-lvarinfo-num-refs, byte-compile-lvarinfo-num-sets):
+	Renamed to use `num-' instead of `num'.
+	(byte-compile-make-lambda-lexenv): Adjusted accordingly.
+
+2004-04-10  Miles Bader  <miles@gnu.org>
+
+	* emacs-lisp/byte-lexbind.el (byte-compile-compute-lforminfo):
+	Look at variable's global specialp state too.
+
+2004-04-09  Miles Bader  <miles@gnu.org>
+
+	* emacs-lisp/byte-opt.el (byte-optimize-lapcode): Default
+	initial-stack-depth to 0.
+	(byte-optimize-lapcode): Discard the right number of values in
+	the stack-set+discard-->discard optimization.
+
+2004-04-02  Miles Bader  <miles@gnu.org>
+
+	* emacs-lisp/lisp-mode.el (eval-last-sexp-1): Setup the lexical
+	environment if lexical-binding is enabled.
+
+2003-10-14  Miles Bader  <miles@gnu.org>
+
+	* emacs-lisp/macroexp.el (macroexpand-all-1): Special-case
+	`backquote-list*' to avoid stack overflows.
+
+2003-04-04  Miles Bader  <miles@gnu.org>
+
+	* help-fns.el (help-function-arglist): Handle interpreted closures.
+
+2002-11-20  Miles Bader  <miles@gnu.org>
+
+	* emacs-lisp/bytecomp.el (byte-compile-stack-adjustment):
+	Correctly handle discardN* operators.
+	* emacs-lisp/byte-opt.el (byte-optimize-lapcode): Fix stack-depth
+	tracking errors.
+
+2002-08-26  Miles Bader  <miles@gnu.org>
+
+	* international/mule.el (make-char): Macroexpand call to
+	charset-id constructed by `byte-compile' hook.
+
+	* emacs-lisp/macroexp.el (macroexpand-all-1): Expand defconst value.
+
+	* emacs-lisp/byte-opt.el (byte-opt-update-stack-params): New macro.
+	(byte-optimize-lapcode): Keep track of stack-depth in final pass too.
+	Add more optimizations for lexical binding.
+	(byte-compile-inline-expand): Macroexpand result of inlining.
+
+	* emacs-lisp/bytecomp.el (byte-compile-lambda): Update call to
+	byte-compile-closure-initial-lexenv-p.
+	(byte-discardN-preserve-tos): Alias to byte-discardN.
+	(byte-compile-push-binding-init): Don't push unused variables on
+	init-lexenv.
+	(byte-compile-push-binding-init): Don't use LFORMINFO if it's nil.
+	(byte-compile-lambda): Don't look at lexical environment unless
+	we're using lexical binding.
+	(byte-compile-defmacro): Correctly generate macros.
+
+	* emacs-lisp/byte-lexbind.el (byte-compile-unbind): Optimize the
+	dynamic-bindings-only case.
+	(byte-compile-bind): Don't special-case unused lexical variables.
+
+	* emacs-lisp/disass.el (disassemble-1): Print arg for discardN ops.
+
+2002-08-19  Miles Bader  <miles@gnu.org>
+
+	* emacs-lisp/byte-opt.el (byte-decompile-bytecode-1): Handle
+	`byte-discardN-preserve-tos' pseudo-op.
+	(byte-compile-side-effect-and-error-free-ops): Add `byte-stack-ref'.
+	(byte-compile-side-effect-free-ops): Add `byte-vec-ref'.
+	(byte-optimize-lapcode): Add some cases for stack-set/ref ops.
+	Add tracking of stack-depth.  Unfinished code to collapse
+	lexical-unbinding sequences.
+
+	* emacs-lisp/bytecomp.el (byte-compile-lapcode): Handle
+	`byte-discardN-preserve-tos' pseudo-op.
+	(byte-compile-top-level): If there are lexical args, output a TAG
+	op to record the initial stack-depth for the optimizer.
+
+2002-08-17  Miles Bader  <miles@gnu.org>
+
+	* emacs-lisp/bytecomp.el (byte-discardN): Add byte-defop.
+	(byte-compile-lapcode): Include byte-discardN.
+	(byte-compile-lambda): Fixup closure detection.
+	(byte-compile-top-level): Handle arguments for a lexical lambda.
+	(byte-compile-lexical-variable-ref, byte-compile-variable-ref)
+	(byte-compile-variable-set): Use byte-compile-stack-set/ref.
+	(byte-compile-discard): Add new parameters NUM and PRESERVE-TOS.
+	(byte-compile-stack-ref, byte-compile-stack-set): New functions.
+	(byte-compile-push-binding-init): Get the variable list properly
+	from LFORMINFO.
+
+	* emacs-lisp/byte-lexbind.el (byte-compile-lforminfo-analyze):
+	Ignore setq'd variables we're not interested in.
+	(byte-compile-make-lambda-lexenv): Add assertion that closed-over
+	variables be heap allocated.
+	(byte-compile-closure-initial-lexenv-p): Renamed from
+	byte-compile-closure-lexenv-p.
+	(byte-compile-non-stack-bindings-p): Get the variable list
+	properly from LFORMINFO.
+	(byte-compile-maybe-push-heap-environment): Handle the
+	no-closed-over-variables case correctly.
+	(byte-compile-bind): Use byte-compile-stack-set/ref.
+	Don't bother modifying INIT-LEXENV as no one will see the changes.
+	(byte-compile-unbind): Call `byte-compile-discard' to handle
+	unbinding lexical bindings.
+
+	* emacs-lisp/disass.el (disassemble-internal): Handle closures.
+	(disassemble-1): Handle new bytecodes.
+	* emacs-lisp/byte-opt.el (disassemble-offset): Handle new bytecodes.
+
+2002-06-16  Miles Bader  <miles@gnu.org>
+
+	* emacs-lisp/macroexp.el (macroexp-accumulate): New macro.
+	(macroexpand-all-forms, macroexpand-all-clauses): Use it.
+	* Makefile.in (compile): Undo previous change.
+
+2002-06-14  Miles Bader  <miles@gnu.org>
+
+	* Makefile.in (COMPILE_FIRST): Add `emacs-lisp/macroexp.el'.
+	(compile): Add a special case that compiles `emacs-lisp/macroexp.el'
+	with an increased max-lisp-eval-depth.
+
+	* emacs-lisp/bytecomp.el: Provide `bytecomp-preload', at the
+	beginning of the file.  Require `byte-lexbind' at compile time.
+	Add a few doc string.
+	(byte-compile-push-bytecodes)
+	(byte-compile-push-bytecode-const2): New macros.
+	(byte-compile-lapcode): Use them.  Do general code cleanup.
+	(byte-compile-initial-macro-environment): Expand macros in
+	byte-compile-eval before passing to byte-compile-top-level.
+	(byte-compile): Use the `byte-compile-initial-macro-environment'.
+
+	* emacs-lisp/byte-lexbind.el: Require `bytecomp-preload' instead of
+	`bytecomp'.
+	(byte-compile-bind): Use `byte-compile-dynamic-variable-bind' to bind
+	dynamic variables.
+	(byte-compile-maybe-push-heap-environment): Fix function name typo.
+
+2002-06-13  Miles Bader  <miles@gnu.org>
+
+	Byte compiler lexical binding support (not finished yet):
+	* emacs-lisp/bytecomp.el: Require `macroexp'.
+	(byte-compile-lexical-environment) 
+	(byte-compile-current-heap-environment) 
+	(byte-compile-current-num-closures): New variables.
+	(0, 178, 179, 180, 181): New byte-opcodes.
+	(byte-compile-lapcode): Handle stack-ref/set opcodes.  Signal an
+	error if a delay-output placeholder is not filled in yet.
+	(byte-compile-file-form, byte-compile): Expand all macros with
+	`macroexpand-all'.
+	(byte-compile-file-form-defsubst, byte-compile-form): Don't expand
+	macros here.
+	(byte-compile-make-lambda-lexenv): Autoload.
+	(byte-compile-lambda): Initial code for handling lexically-bound
+	arguments and closures; doesn't work yet.
+	(byte-compile-closure-code-p, byte-compile-make-closure) 
+	(byte-compile-closure): New functions.
+	(byte-compile-check-variable, byte-compile-dynamic-variable-op) 
+	(byte-compile-dynamic-variable-bind) 
+	(byte-compile-lexical-variable-ref, byte-compile-variable-set): 
+	New functions.
+	(byte-compile-variable-ref): Remove second argument.  Now only
+	handles real variable references (not setting or binding).
+	(byte-compile-push-unknown-constant) 
+	(byte-compile-resolve-unknown-constant): New functions.
+	(byte-compile-funarg, byte-compile-funarg-2): Functions removed.
+	(byte-compile-function-form): Use either `byte-compile-constant'
+	or `byte-compile-closure'.
+	(byte-compile-setq): Use `byte-compile-variable-set' instead of
+	`byte-compile-variable-ref'.
+	(apply, mapcar, mapatoms, mapconcat, mapc, sort):
+	`byte-defop-compiler-1's removed.
+	(byte-compile-while): Make sure lexically-bound variables inside
+	the loop don't get stored in an environment outside the loop.
+	(byte-compile-compute-lforminfo): Autoload.
+	(byte-compile-push-binding-init): New function.
+	(byte-compile-let, byte-compile-let*): Handle lexical binding.
+	(byte-compile-defun): Use `byte-compile-closure' to do the work.
+	(byte-compile-defmacro): Use `byte-compile-make-closure'.
+	(byte-compile-defvar): Expand the generated call to `push' since
+	we're past macroexpansion already.
+	(byte-compile-stack-adjustment): New function.
+	(byte-compile-out): Make second arg optional.  Rewrite for clarity.
+	(byte-compile-delay-out, byte-compile-delayed-out): New functions.
+
+	* emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Don't
+	expand macros here.
+
+	* emacs-lisp/macroexp.el (macroexpand-all-1): Expand defmacro forms.
+
+	* emacs-lisp/byte-lexbind.el (byte-compile-make-lvarinfo) 
+	(byte-compile-lforminfo-add-var) 
+	(byte-compile-lforminfo-note-closure) 
+	(byte-compile-compute-lforminfo) 
+	(byte-compile-lforminfo-from-lambda) 
+	(byte-compile-lforminfo-analyze) 
+	(byte-compile-heapenv-add-accessible-env) 
+	(byte-compile-heapenv-ensure-access) 
+	(byte-compile-rearrange-let-clauses, byte-compile-bind) 
+	(byte-compile-unbind): Fix a bunch of typos.
+
+2002-06-12  Miles Bader  <miles@gnu.org>
+
+	* emacs-lisp/byte-lexbind.el, emacs-lisp/macroexp.el: New files.
+
+	* subr.el (functionp): Function removed (now a subr).
+	* help-fns.el (describe-function-1): Handle interpreted closures.
+
+;; arch-tag: bd1b5b8b-fdb2-425d-9ac2-20689fb0ee70
diff --git a/lisp/Makefile.in b/lisp/Makefile.in
index 4effdddff6a..25f7b89c9db 100644
--- a/lisp/Makefile.in
+++ b/lisp/Makefile.in
@@ -71,6 +71,13 @@ AUTOGENEL = loaddefs.el \
 	cedet/ede/loaddefs.el \
 	cedet/srecode/loaddefs.el
 
+# Value of max-lisp-eval-depth when compiling initially.
+# During bootstrapping the byte-compiler is run interpreted when compiling
+# itself, and uses more stack than usual.
+#
+BIG_STACK_DEPTH = 1000
+BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))"
+
 # Files to compile before others during a bootstrap.  This is done to
 # speed up the bootstrap process.
 
@@ -195,7 +202,7 @@ compile-onefile:
 	@echo Compiling $(THEFILE)
 	@# Use byte-compile-refresh-preloaded to try and work around some of
 	@# the most common bootstrapping problems.
-	@$(emacs) -l bytecomp -f byte-compile-refresh-preloaded $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $(THEFILE)
+	@$(emacs) -l bytecomp.el -f byte-compile-refresh-preloaded $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $(THEFILE)
 
 # Files MUST be compiled one by one. If we compile several files in a
 # row (i.e., in the same instance of Emacs) we can't make sure that
diff --git a/lisp/emacs-lisp/byte-lexbind.el b/lisp/emacs-lisp/byte-lexbind.el
new file mode 100644
index 00000000000..a01829abf50
--- /dev/null
+++ b/lisp/emacs-lisp/byte-lexbind.el
@@ -0,0 +1,696 @@
+;;; byte-lexbind.el --- Lexical binding support for byte-compiler
+;;
+;; Copyright (C) 2001, 2002 Free Software Foundation, Inc.
+;;
+;; Author: Miles Bader <miles@gnu.org>
+;; Keywords: lisp, compiler, lexical binding
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(require 'bytecomp-preload "bytecomp")
+
+;; Downward closures aren't implemented yet, so this should always be nil
+(defconst byte-compile-use-downward-closures nil
+  "If true, use `downward closures', which are closures that don't cons.")
+
+(defconst byte-compile-save-window-excursion-uses-eval t
+  "If true, the bytecode for `save-window-excursion' uses eval.
+This means that the body of the form must be put into a closure.")
+
+(defun byte-compile-arglist-vars (arglist)
+  "Return a list of the variables in the lambda argument list ARGLIST."
+  (remq '&rest (remq '&optional arglist)))
+
+
+;;; Variable extent analysis.
+
+;; A `lforminfo' holds information about lexical bindings in a form, and some
+;; other info for analysis.  It is a cons-cell, where the car is a list of
+;; `lvarinfo' stuctures, which form an alist indexed by variable name, and the
+;; cdr is the number of closures found in the form:
+;;
+;;   LFORMINFO : ((LVARINFO ...) . NUM-CLOSURES)"
+;;
+;; A `lvarinfo' holds information about a single lexical variable.  It is a
+;; list whose car is the variable name (so an lvarinfo is suitable as an alist
+;; entry), and the rest of the of which holds information about the variable:
+;;
+;;   LVARINFO : (VAR NUM-REFS NUM-SETS CLOSED-OVER)
+;;
+;; NUM-REFS is the number of times the variable's value is used
+;; NUM-SETS is the number of times the variable's value is set
+;; CLOSED-OVER is non-nil if the variable is referenced
+;;     anywhere but in its original function-level"
+
+;;; lvarinfo:
+
+;; constructor
+(defsubst byte-compile-make-lvarinfo (var &optional already-set)
+  (list var 0 (if already-set 1 0) 0 nil))
+;; accessors
+(defsubst byte-compile-lvarinfo-var (vinfo) (car vinfo))
+(defsubst byte-compile-lvarinfo-num-refs (vinfo) (cadr vinfo))
+(defsubst byte-compile-lvarinfo-num-sets (vinfo) (nth 3 vinfo))
+(defsubst byte-compile-lvarinfo-closed-over-p (vinfo) (nth 4 vinfo))
+;; setters
+(defsubst byte-compile-lvarinfo-note-ref (vinfo)
+  (setcar (cdr vinfo) (1+ (cadr vinfo))))
+(defsubst byte-compile-lvarinfo-note-set (vinfo)
+  (setcar (cddr vinfo) (1+ (nth 3 vinfo))))
+(defsubst byte-compile-lvarinfo-note-closure (vinfo)
+  (setcar (nthcdr 4 vinfo) t))
+
+;;; lforminfo:
+
+;; constructor
+(defsubst byte-compile-make-lforminfo ()
+  (cons nil 0))
+;; accessors
+(defalias 'byte-compile-lforminfo-vars 'car)
+(defalias 'byte-compile-lforminfo-num-closures 'cdr)
+;; setters
+(defsubst byte-compile-lforminfo-add-var (finfo var &optional already-set)
+  (setcar finfo (cons (byte-compile-make-lvarinfo var already-set)
+		      (car finfo))))
+
+(defun byte-compile-lforminfo-make-closure-flag ()
+  "Return a new `closure-flag'."
+  (cons nil nil))
+
+(defsubst byte-compile-lforminfo-note-closure (lforminfo lvarinfo closure-flag)
+  "If a variable reference or definition is inside a closure, record that fact.
+LFORMINFO describes the form currently being analyzed, and LVARINFO
+describes the variable.  CLOSURE-FLAG is either nil, if currently _not_
+inside a closure, and otherwise a `closure flag' returned by
+`byte-compile-lforminfo-make-closure-flag'."
+  (when closure-flag
+    (byte-compile-lvarinfo-note-closure lvarinfo)
+    (unless (car closure-flag)
+      (setcdr lforminfo (1+ (cdr lforminfo)))
+      (setcar closure-flag t))))
+
+(defun byte-compile-compute-lforminfo (form &optional special)
+  "Return information about variables lexically bound by FORM.
+SPECIAL is a list of variables that are special, and so shouldn't be
+bound lexically (in addition to variable that are considered special
+because they are declared with `defvar', et al).
+
+The result is an `lforminfo' data structure."
+  (and
+   (consp form)
+   (let ((lforminfo (byte-compile-make-lforminfo)))
+     (cond ((eq (car form) 'let)
+	    ;; Find the bound variables
+	    (dolist (clause (cadr form))
+	      (let ((var (if (consp clause) (car clause) clause)))
+		(unless (or (specialp var) (memq var special))
+		  (byte-compile-lforminfo-add-var lforminfo var t))))
+	    ;; Analyze the body
+	    (unless (null (byte-compile-lforminfo-vars lforminfo))
+	      (byte-compile-lforminfo-analyze-forms lforminfo form 2
+						    special nil)))
+	   ((eq (car form) 'let*)
+	    (dolist (clause (cadr form))
+	      (let ((var (if (consp clause) (car clause) clause)))
+		;; Analyze each initializer based on the previously
+		;; bound variables.
+		(when (and (consp clause) lforminfo)
+		  (byte-compile-lforminfo-analyze lforminfo (cadr clause)
+						  special nil))
+		(unless (or (specialp var) (memq var special))
+		  (byte-compile-lforminfo-add-var lforminfo var t))))
+	    ;; Analyze the body
+	    (unless (null (byte-compile-lforminfo-vars lforminfo))
+	      (byte-compile-lforminfo-analyze-forms lforminfo form 2
+						    special nil)))
+	   ((eq (car form) 'condition-case)
+	    ;; `condition-case' currently must dynamically bind the
+	    ;; error variable, so do nothing.
+	    )
+	   ((memq (car form) '(defun defmacro))
+	    (byte-compile-lforminfo-from-lambda lforminfo (cdr form) special))
+	   ((eq (car form) 'lambda)
+	    (byte-compile-lforminfo-from-lambda lforminfo form special))
+	   ((and (consp (car form)) (eq (caar form) 'lambda))
+	    ;; An embedded lambda, which is basically just a `let'
+	    (byte-compile-lforminfo-from-lambda lforminfo (cdr form) special)))
+     (if (byte-compile-lforminfo-vars lforminfo)
+	 lforminfo
+       nil))))
+
+(defun byte-compile-lforminfo-from-lambda (lforminfo lambda special)
+  "Initialize LFORMINFO from the lambda expression LAMBDA.
+SPECIAL is a list of variables to ignore.
+The first element of LAMBDA is ignored; it need not actually be `lambda'."
+  ;; Add the arguments
+  (dolist (arg (byte-compile-arglist-vars (cadr lambda)))
+    (byte-compile-lforminfo-add-var lforminfo arg t))
+  ;; Analyze the body
+  (unless (null (byte-compile-lforminfo-vars lforminfo))
+    (byte-compile-lforminfo-analyze-forms lforminfo lambda 2 special nil)))
+
+(defun byte-compile-lforminfo-analyze (lforminfo form &optional ignore closure-flag)
+  "Update variable information in LFORMINFO by analyzing FORM.
+IGNORE is a list of variables that shouldn't be analyzed (usually because
+they're special, or because some inner binding shadows the version in
+LFORMINFO).  CLOSURE-FLAG should be either nil or a `closure flag' created
+with `byte-compile-lforminfo-make-closure-flag'; the latter indicates that
+FORM is inside a lambda expression that may close over some variable in
+LFORMINFO."
+  (cond ((symbolp form)
+	 ;; variable reference
+	 (unless (member form ignore)
+	   (let ((vinfo (assq form (byte-compile-lforminfo-vars lforminfo))))
+	     (when vinfo
+	       (byte-compile-lvarinfo-note-ref vinfo)
+	       (byte-compile-lforminfo-note-closure lforminfo vinfo
+						    closure-flag)))))
+	;; function call/special form
+	((consp form)
+	 (let ((fun (car form)))
+	   (cond
+	    ((eq fun 'setq)
+	     (pop form)
+	     (while form
+	       (let ((var (pop form)))
+		 (byte-compile-lforminfo-analyze lforminfo (pop form)
+						 ignore closure-flag)
+		 (unless (member var ignore)
+		   (let ((vinfo
+			  (assq var (byte-compile-lforminfo-vars lforminfo))))
+		     (when vinfo
+		       (byte-compile-lvarinfo-note-set vinfo)
+		       (byte-compile-lforminfo-note-closure lforminfo vinfo
+							    closure-flag)))))))
+	    ((eq fun 'catch)
+	     ;; tag
+	     (byte-compile-lforminfo-analyze lforminfo (cadr form)
+					     ignore closure-flag)
+	     ;; `catch' uses a closure for the body
+	     (byte-compile-lforminfo-analyze-forms
+	      lforminfo form 2
+	      ignore
+	      (or closure-flag
+		  (and (not byte-compile-use-downward-closures)
+		       (byte-compile-lforminfo-make-closure-flag)))))
+	    ((eq fun 'cond)
+	     (byte-compile-lforminfo-analyze-clauses lforminfo (cdr form) 0
+						     ignore closure-flag))
+	    ((eq fun 'condition-case)
+	     ;; `condition-case' separates its body/handlers into
+	     ;; separate closures.
+	     (unless (or closure-flag byte-compile-use-downward-closures)
+	       ;; condition case is implemented by calling a function
+	       (setq closure-flag (byte-compile-lforminfo-make-closure-flag)))
+	     ;; value form
+	     (byte-compile-lforminfo-analyze lforminfo (nth 2 form)
+					     ignore closure-flag)
+	     ;; the error variable is always bound dynamically (because
+	     ;; of the implementation)
+	     (when (cadr form)
+	       (push (cadr form) ignore))
+	     ;; handlers
+	     (byte-compile-lforminfo-analyze-clauses lforminfo
+						     (nthcdr 2 form) 1
+						     ignore closure-flag))
+	    ((eq fun '(defvar defconst))
+	     (byte-compile-lforminfo-analyze lforminfo (nth 2 form)
+					     ignore closure-flag))
+	    ((memq fun '(defun defmacro))
+	     (byte-compile-lforminfo-analyze-forms lforminfo form 3
+						   ignore closure-flag))
+	    ((eq fun 'function)
+	     ;; Analyze an embedded lambda expression [note: we only recognize
+	     ;; it within (function ...) as the (lambda ...) for is actually a
+	     ;; macro returning (function (lambda ...))].
+	     (when (and (consp (cadr form)) (eq (car (cadr form)) 'lambda))
+	       ;; shadow bound variables
+	       (setq ignore
+		     (append (byte-compile-arglist-vars (cadr (cadr form)))
+			     ignore))
+	       ;; analyze body of lambda
+	       (byte-compile-lforminfo-analyze-forms
+		lforminfo (cadr form) 2
+		ignore
+		(or closure-flag
+		    (byte-compile-lforminfo-make-closure-flag)))))
+	    ((eq fun 'let)
+	     ;; analyze variable inits
+	     (byte-compile-lforminfo-analyze-clauses lforminfo (cadr form) 1
+						     ignore closure-flag)
+	     ;; shadow bound variables
+	     (dolist (clause (cadr form))
+	       (push (if (symbolp clause) clause (car clause))
+		     ignore))
+	     ;; analyze body
+	     (byte-compile-lforminfo-analyze-forms lforminfo form 2
+						   ignore closure-flag))
+	    ((eq fun 'let*)
+	     (dolist (clause (cadr form))
+	       (if (symbolp clause)
+		   ;; shadow bound (to nil) variable
+		   (push clause ignore)
+		 ;; analyze variable init
+		 (byte-compile-lforminfo-analyze lforminfo (cadr clause)
+						 ignore closure-flag)
+		 ;; shadow bound variable
+		 (push (car clause) ignore)))
+	     ;; analyze body
+	     (byte-compile-lforminfo-analyze-forms lforminfo form 2
+						   ignore closure-flag))
+	    ((eq fun 'quote)
+	     ;; do nothing
+	     )
+	    ((eq fun 'save-window-excursion)
+	     ;; `save-window-excursion' currently uses a funny implementation
+	     ;; that requires its body forms be put into a closure (it should
+	     ;; be fixed to work more like `save-excursion' etc., do).
+	     (byte-compile-lforminfo-analyze-forms
+	      lforminfo form 2
+	      ignore
+	      (or closure-flag
+		  (and byte-compile-save-window-excursion-uses-eval
+		       (not byte-compile-use-downward-closures)
+		       (byte-compile-lforminfo-make-closure-flag)))))
+	    ((and (consp fun) (eq (car fun) 'lambda))
+	     ;; Embedded lambda.  These are inlined by the compiler, so
+	     ;; we don't treat them like a real closure, more like `let'.
+	     ;; analyze inits
+	     (byte-compile-lforminfo-analyze-forms lforminfo form 2
+						   ignore closure-flag)
+	     
+	     ;; shadow bound variables
+	     (setq ignore (nconc (byte-compile-arglist-vars (cadr fun))
+				 ignore))
+	     ;; analyze body
+	     (byte-compile-lforminfo-analyze-forms lforminfo fun 2
+						   ignore closure-flag))
+	    (t
+	     ;; For everything else, we just expand each argument (for
+	     ;; setq/setq-default this works alright because the
+	     ;; variable names are symbols).
+	     (byte-compile-lforminfo-analyze-forms lforminfo form 1
+						   ignore closure-flag)))))))
+
+(defun byte-compile-lforminfo-analyze-forms
+  (lforminfo forms skip ignore closure-flag)
+  "Update variable information in LFORMINFO by analyzing each form in FORMS.
+The first SKIP elements of FORMS are skipped without analysis.  IGNORE
+is a list of variables that shouldn't be analyzed (usually because
+they're special, or because some inner binding shadows the version in
+LFORMINFO).  CLOSURE-FLAG should be either nil or a `closure flag' created with
+`byte-compile-lforminfo-make-closure-flag'; the latter indicates that FORM is
+inside a lambda expression that may close over some variable in LFORMINFO."
+  (when skip
+    (setq forms (nthcdr skip forms)))
+  (while forms
+    (byte-compile-lforminfo-analyze lforminfo (pop forms)
+				    ignore closure-flag)))
+
+(defun byte-compile-lforminfo-analyze-clauses
+  (lforminfo clauses skip ignore closure-flag)
+  "Update variable information in LFORMINFO by analyzing each clause in CLAUSES.
+Each clause is a list of forms; any clause that's not a list is ignored.  The
+first SKIP elements of each clause are skipped without analysis.  IGNORE is a
+list of variables that shouldn't be analyzed (usually because they're special,
+or because some inner binding shadows the version in LFORMINFO).
+CLOSURE-FLAG should be either nil or a `closure flag' created with
+`byte-compile-lforminfo-make-closure-flag'; the latter indicates that FORM is
+inside a lambda expression that may close over some variable in LFORMINFO."
+  (while clauses
+    (let ((clause (pop clauses)))
+      (when (consp clause)
+	(byte-compile-lforminfo-analyze-forms lforminfo clause skip
+					      ignore closure-flag)))))
+
+
+;;; Lexical environments
+
+;; A lexical environment is an alist, where each element is of the form
+;; (VAR . (OFFSET . ENV)) where VAR is either a symbol, for normal
+;; variables, or an `heapenv' descriptor for references to heap environment
+;; vectors.  ENV is either an atom, meaning a `stack allocated' variable
+;; (the particular atom serves to indicate the particular function context
+;; on whose stack it's allocated), or an `heapenv' descriptor (see above),
+;; meaning a variable allocated in a heap environment vector.  For the
+;; later case, an anonymous `variable' holding a pointer to the environment
+;; vector may be located by recursively looking up ENV in the environment
+;; as if it were a variable (so the entry for that `variable' will have a
+;; non-symbol VAR).
+
+;; We call a lexical environment a `lexenv', and an entry in it a `lexvar'.
+
+;; constructor
+(defsubst byte-compile-make-lexvar (name offset &optional env)
+  (cons name (cons offset env)))
+;; accessors
+(defsubst byte-compile-lexvar-name (lexvar) (car lexvar))
+(defsubst byte-compile-lexvar-offset (lexvar) (cadr lexvar))
+(defsubst byte-compile-lexvar-environment (lexvar) (cddr lexvar))
+(defsubst byte-compile-lexvar-variable-p (lexvar) (symbolp (car lexvar)))
+(defsubst byte-compile-lexvar-environment-p (lexvar)
+  (not (symbolp (car lexvar))))
+(defsubst byte-compile-lexvar-on-stack-p (lexvar)
+  (atom (byte-compile-lexvar-environment lexvar)))
+(defsubst byte-compile-lexvar-in-heap-p (lexvar)
+  (not (byte-compile-lexvar-on-stack-p lexvar)))
+
+(defun byte-compile-make-lambda-lexenv (form closed-over-lexenv)
+  "Return a new lexical environment for a lambda expression FORM.
+CLOSED-OVER-LEXENV is the lexical environment in which FORM occurs.
+The returned lexical environment contains two sets of variables:
+  * Variables that were in CLOSED-OVER-LEXENV and used by FORM
+    (all of these will be `heap' variables)
+  * Arguments to FORM (all of these will be `stack' variables)."
+  ;; See if this is a closure or not
+  (let ((closure nil)
+	(lforminfo (byte-compile-make-lforminfo))
+	(args (byte-compile-arglist-vars (cadr form))))
+    ;; Add variables from surrounding lexical environment to analysis set
+    (dolist (lexvar closed-over-lexenv)
+      (when (and (byte-compile-lexvar-in-heap-p lexvar)
+		 (not (memq (car lexvar) args)))
+	;; The variable is located in a heap-allocated environment
+	;; vector, so FORM may use it.  Add it to the set of variables
+	;; that we'll search for in FORM.
+	(byte-compile-lforminfo-add-var lforminfo (car lexvar))))
+    ;; See how FORM uses these potentially closed-over variables.
+    (byte-compile-lforminfo-analyze lforminfo form args)
+    (let ((lexenv nil))
+      (dolist (vinfo (byte-compile-lforminfo-vars lforminfo))
+	(when (> (byte-compile-lvarinfo-num-refs vinfo) 0)
+	  ;; FORM uses VINFO's variable, so it must be a closure.
+	  (setq closure t)
+	  ;; Make sure that the environment in which the variable is
+	  ;; located is accessible (since we only ever pass the
+	  ;; innermost environment to closures, if it's in some other
+	  ;; envionment, there must be path to it from the innermost
+	  ;; one).
+	  (unless (byte-compile-lexvar-in-heap-p vinfo)
+	    ;; To access the variable from FORM, it must be in the heap.
+	    (error
+    "Compiler error: lexical variable `%s' should be heap-allocated but is not"
+	     (car vinfo)))
+	  (let ((closed-over-lexvar (assq (car vinfo) closed-over-lexenv)))
+	    (byte-compile-heapenv-ensure-access
+	     byte-compile-current-heap-environment
+	     (byte-compile-lexvar-environment closed-over-lexvar))
+	    ;; Put this variable in the new lexical environment
+	    (push closed-over-lexvar lexenv))))
+      ;; Fill in the initial stack contents
+      (let ((stackpos 0))
+	(when closure
+	  ;; Add the magic first argument that holds the environment pointer
+	  (push (byte-compile-make-lexvar byte-compile-current-heap-environment
+					  0)
+		lexenv)
+	  (setq stackpos (1+ stackpos)))
+	;; Add entries for each argument
+	(dolist (arg args)
+	  (push (byte-compile-make-lexvar arg stackpos) lexenv)
+	  (setq stackpos (1+ stackpos)))
+	;; Return the new lexical environment
+	lexenv))))
+
+(defun byte-compile-closure-initial-lexenv-p (lexenv)
+  "Return non-nil if LEXENV is the initial lexical environment for a closure.
+This only works correctly when passed a new lexical environment as
+returned by `byte-compile-make-lambda-lexenv' (it works by checking to
+see whether there are any heap-allocated lexical variables in LEXENV)."
+  (let ((closure nil))
+    (while (and lexenv (not closure))
+      (when (byte-compile-lexvar-environment-p (pop lexenv))
+	(setq closure t)))
+    closure))
+
+
+;;; Heap environment vectors
+
+;; A `heap environment vector' is heap-allocated vector used to store
+;; variable that can't be put onto the stack.
+;;
+;; They are represented in the compiler by a list of the form
+;;
+;;    (SIZE SIZE-CONST-ID INIT-POSITION . ENVS)
+;;
+;; SIZE is the current size of the vector (which may be
+;; incremented if another variable or environment-reference is added to
+;; the end).  SIZE-CONST-ID is an `unknown constant id' (as returned by
+;; `byte-compile-push-unknown-constant') representing the constant used
+;; in the vector initialization code, and INIT-POSITION is a position
+;; in the byte-code output (as returned by `byte-compile-delay-out')
+;; at which more initialization code can be added.
+;; ENVS is a list of other environment vectors accessible form this one,
+;; where each element is of the form (ENV . OFFSET).
+
+;; constructor
+(defsubst byte-compile-make-heapenv (size-const-id init-position)
+  (list 0 size-const-id init-position))
+;; accessors
+(defsubst byte-compile-heapenv-size (heapenv) (car heapenv))
+(defsubst byte-compile-heapenv-size-const-id (heapenv) (cadr heapenv))
+(defsubst byte-compile-heapenv-init-position (heapenv) (nth 2 heapenv))
+(defsubst byte-compile-heapenv-accessible-envs (heapenv) (nthcdr 3 heapenv))
+
+(defun byte-compile-heapenv-add-slot (heapenv)
+  "Add a slot to the heap environment HEAPENV and return its offset."
+  (prog1 (car heapenv) (setcar heapenv (1+ (car heapenv)))))
+
+(defun byte-compile-heapenv-add-accessible-env (heapenv env offset)
+  "Add to HEAPENV's list of accessible environments, ENV at OFFSET."
+  (setcdr (nthcdr 2 heapenv)
+	  (cons (cons env offset)
+		(byte-compile-heapenv-accessible-envs heapenv))))
+
+(defun byte-compile-push-heapenv ()
+  "Generate byte-code to push a new heap environment vector.
+Sets `byte-compile-current-heap-environment' to the compiler descriptor
+for the new heap environment.
+Return a `lexvar' descriptor for the new heap environment."
+  (let ((env-stack-pos byte-compile-depth)
+	size-const-id init-position)
+    ;; Generate code to push the vector
+    (byte-compile-push-constant 'make-vector)
+    (setq size-const-id (byte-compile-push-unknown-constant))
+    (byte-compile-push-constant nil)
+    (byte-compile-out 'byte-call 2)
+    (setq init-position (byte-compile-delay-out 3))
+    ;; Now make a heap-environment for the compiler to use
+    (setq byte-compile-current-heap-environment
+	  (byte-compile-make-heapenv size-const-id init-position))
+    (byte-compile-make-lexvar byte-compile-current-heap-environment
+			      env-stack-pos)))
+
+(defun byte-compile-heapenv-ensure-access (heapenv other-heapenv)
+  "Make sure that HEAPENV can be used to access OTHER-HEAPENV.
+If not, then add a new slot to HEAPENV pointing to OTHER-HEAPENV."
+  (unless (memq heapenv (byte-compile-heapenv-accessible-envs heapenv))
+    (let ((offset (byte-compile-heapenv-add-slot heapenv)))
+      (byte-compile-heapenv-add-accessible-env heapenv other-heapenv offset))))
+
+
+;;; Variable binding/unbinding
+
+(defun byte-compile-non-stack-bindings-p (clauses lforminfo)
+  "Return non-nil if any lexical bindings in CLAUSES are not stack-allocated.
+LFORMINFO should be information about lexical variables being bound."
+  (let ((vars (byte-compile-lforminfo-vars lforminfo)))
+    (or (not (= (length clauses) (length vars)))
+	(progn
+	  (while (and vars clauses)
+	    (when (byte-compile-lvarinfo-closed-over-p (pop vars))
+	      (setq clauses nil)))
+	  (not clauses)))))
+
+(defun byte-compile-let-clauses-trivial-init-p (clauses)
+  "Return true if let binding CLAUSES all have a `trivial' init value.
+Trivial means either a constant value, or a simple variable initialization."
+  (or (null clauses)
+      (and (or (atom (car clauses))
+	       (atom (cadr (car clauses)))
+	       (eq (car (cadr (car clauses))) 'quote))
+	   (byte-compile-let-clauses-trivial-init-p (cdr clauses)))))
+
+(defun byte-compile-rearrange-let-clauses (clauses lforminfo)
+  "Return CLAUSES rearranged so non-stack variables come last if possible.
+Care is taken to only do so when it's clear that the meaning is the same.
+LFORMINFO should be information about lexical variables being bound."
+  ;; We currently do a very simple job by only exchanging clauses when
+  ;; one has a constant init, or one has a variable init and the other
+  ;; doesn't have a function call init (because that could change the
+  ;; value of the variable).  This could be more clever and actually
+  ;; attempt to analyze which variables could possible be changed, etc.
+  (let ((unchanged nil)
+	(lex-non-stack nil)
+	(dynamic nil))
+    (while clauses
+      (let* ((clause (pop clauses))
+	     (var (if (consp clause) (car clause) clause))
+	     (init (and (consp clause) (cadr clause)))
+	     (vinfo (assq var (byte-compile-lforminfo-vars lforminfo))))
+	(cond
+	 ((or (and vinfo
+		   (not (byte-compile-lvarinfo-closed-over-p vinfo)))
+	      (not
+	       (or (eq init nil) (eq init t)
+		   (and (atom init) (not (symbolp init)))
+		   (and (consp init) (eq (car init) 'quote))
+		   (byte-compile-let-clauses-trivial-init-p clauses))))
+	  (push clause unchanged))
+	 (vinfo
+	  (push clause lex-non-stack))
+	 (t
+	  (push clause dynamic)))))
+    (nconc (nreverse unchanged) (nreverse lex-non-stack) (nreverse dynamic))))
+
+(defun byte-compile-maybe-push-heap-environment (&optional lforminfo)
+  "Push a new heap environment if necessary.
+LFORMINFO should be information about lexical variables being bound.
+Return a lexical environment containing only the heap vector (or
+nil if nothing was pushed).
+Also, `byte-compile-current-heap-environment' and
+`byte-compile-current-num-closures' are updated to reflect any change (so they
+should probably be bound by the caller to ensure that the new values have the
+proper scope)."
+  ;; We decide whether a new heap environment is required by seeing if
+  ;; the number of closures inside the form described by LFORMINFO is
+  ;; the same as the number inside the binding form that created the
+  ;; currently active heap environment.
+  (let ((nclosures
+	 (and lforminfo (byte-compile-lforminfo-num-closures lforminfo))))
+    (if (or (null lforminfo)
+	    (= nclosures byte-compile-current-num-closures))
+	;; No need to push a heap environment.
+	nil
+      ;; Have to push one.  A heap environment is really just a vector, so
+      ;; we emit bytecodes to create a vector.  However, the size is not
+      ;; fixed yet (the vector can grow if subforms use it to store
+      ;; values, and if `access points' to parent heap environments are
+      ;; added), so we use `byte-compile-push-unknown-constant' to push the
+      ;; vector size.
+      (setq byte-compile-current-num-closures nclosures)
+      (list (byte-compile-push-heapenv)))))
+
+(defun byte-compile-bind (var init-lexenv &optional lforminfo)
+  "Emit byte-codes to bind VAR and update `byte-compile-lexical-environment'.
+INIT-LEXENV should be a lexical-environment alist describing the
+positions of the init value that have been pushed on the stack, and
+LFORMINFO should be information about lexical variables being bound.
+Return non-nil if the TOS value was popped."
+  ;; The presence of lexical bindings mean that we may have to
+  ;; juggle things on the stack, either to move them to TOS for
+  ;; dynamic binding, or to put them in a non-stack environment
+  ;; vector.
+  (let ((vinfo (assq var (byte-compile-lforminfo-vars lforminfo))))
+    (cond ((and (null vinfo) (eq var (caar init-lexenv)))
+	   ;; VAR is dynamic and is on the top of the
+	   ;; stack, so we can just bind it like usual
+	   (byte-compile-dynamic-variable-bind var)
+	   t)
+	  ((null vinfo)
+	   ;; VAR is dynamic, but we have to get its
+	   ;; value out of the middle of the stack
+	   (let ((stack-pos (cdr (assq var init-lexenv))))
+	     (byte-compile-stack-ref stack-pos)
+	     (byte-compile-dynamic-variable-bind var)
+	     ;; Now we have to store nil into its temporary
+	     ;; stack position to avoid problems with GC
+	     (byte-compile-push-constant nil)
+	     (byte-compile-stack-set stack-pos))
+	   nil)
+	  ((byte-compile-lvarinfo-closed-over-p vinfo)
+	   ;; VAR is lexical, but needs to be in a
+	   ;; heap-allocated environment.
+	   (unless byte-compile-current-heap-environment
+	     (error "No current heap-environment to allocate `%s' in!" var))
+	   (let ((init-stack-pos
+		  ;; nil if the init value is on the top of the stack,
+		  ;; otherwise the position of the init value on the stack.
+		  (and (not (eq var (caar init-lexenv)))
+		       (byte-compile-lexvar-offset (assq var init-lexenv))))
+		 (env-vec-pos
+		  ;; Position of VAR in the environment vector
+		  (byte-compile-lexvar-offset
+		   (assq var byte-compile-lexical-environment)))
+		 (env-vec-stack-pos
+		  ;; Position of the the environment vector on the stack
+		  ;; (the heap-environment must _always_ be available on
+		  ;; the stack!)
+		  (byte-compile-lexvar-offset
+		   (assq byte-compile-current-heap-environment
+			 byte-compile-lexical-environment))))
+	     (unless env-vec-stack-pos
+	       (error "Couldn't find location of current heap environment!"))
+	     (when init-stack-pos
+	       ;; VAR is not on the top of the stack, so get it
+	       (byte-compile-stack-ref init-stack-pos))
+	     (byte-compile-stack-ref env-vec-stack-pos)
+	     ;; Store the variable into the vector
+	     (byte-compile-out 'byte-vec-set env-vec-pos)
+	     (when init-stack-pos
+	       ;; Store nil into VAR's temporary stack
+	       ;; position to avoid problems with GC
+	       (byte-compile-push-constant nil)
+	       (byte-compile-stack-set init-stack-pos))
+	     ;; Push a record of VAR's new lexical binding
+	     (push (byte-compile-make-lexvar
+		    var env-vec-pos byte-compile-current-heap-environment)
+		   byte-compile-lexical-environment)
+	     (not init-stack-pos)))
+	  (t
+	   ;; VAR is a simple stack-allocated lexical variable
+	   (push (assq var init-lexenv)
+		 byte-compile-lexical-environment)
+	   nil))))
+
+(defun byte-compile-unbind (clauses init-lexenv
+				    &optional lforminfo preserve-body-value)
+  "Emit byte-codes to unbind the variables bound by CLAUSES.
+CLAUSES is a `let'-style variable binding list.  INIT-LEXENV should be a
+lexical-environment alist describing the positions of the init value that
+have been pushed on the stack, and LFORMINFO should be information about
+the lexical variables that were bound.  If PRESERVE-BODY-VALUE is true,
+then an additional value on the top of the stack, above any lexical binding
+slots, is preserved, so it will be on the top of the stack after all
+binding slots have been popped."
+  ;; Unbind dynamic variables
+  (let ((num-dynamic-bindings 0))
+    (if lforminfo
+	(dolist (clause clauses)
+	  (unless (assq (if (consp clause) (car clause) clause)
+			(byte-compile-lforminfo-vars lforminfo))
+	    (setq num-dynamic-bindings (1+ num-dynamic-bindings))))
+      (setq num-dynamic-bindings (length clauses)))
+    (unless (zerop num-dynamic-bindings)
+      (byte-compile-out 'byte-unbind num-dynamic-bindings)))
+  ;; Pop lexical variables off the stack, possibly preserving the
+  ;; return value of the body.
+  (when init-lexenv
+    ;; INIT-LEXENV contains all init values left on the stack
+    (byte-compile-discard (length init-lexenv) preserve-body-value)))
+
+
+(provide 'byte-lexbind)
+
+;;; arch-tag: b8f1dff6-9edb-4430-a96f-323d42a681a9
+;;; byte-lexbind.el ends here
diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el
index e461010a6ce..4c0094dd78b 100644
--- a/lisp/emacs-lisp/byte-opt.el
+++ b/lisp/emacs-lisp/byte-opt.el
@@ -186,8 +186,8 @@
 (eval-when-compile (require 'cl))
 
 (defun byte-compile-log-lap-1 (format &rest args)
-  (if (aref byte-code-vector 0)
-      (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well"))
+;;   (if (aref byte-code-vector 0)
+;;       (error "The old version of the disassembler is loaded.  Reload new-bytecomp as well"))
   (byte-compile-log-1
    (apply 'format format
      (let (c a)
@@ -281,7 +281,8 @@
 		       (byte-code ,string ,(aref fn 2) ,(aref fn 3)))
 		    (cdr form)))
 	  (if (eq (car-safe fn) 'lambda)
-	      (cons fn (cdr form))
+	      (macroexpand-all (cons fn (cdr form))
+			       byte-compile-macro-environment)
 	    ;; Give up on inlining.
 	    form))))))
 
@@ -1332,14 +1333,15 @@
 	((>= op byte-constant)
 	 (prog1 (- op byte-constant)	;offset in opcode
 	   (setq op byte-constant)))
-	((and (>= op byte-constant2)
-	      (<= op byte-goto-if-not-nil-else-pop))
+	((or (and (>= op byte-constant2)
+		  (<= op byte-goto-if-not-nil-else-pop))
+	     (= op byte-stack-set2))
 	 (setq ptr (1+ ptr))		;offset in next 2 bytes
 	 (+ (aref bytes ptr)
 	    (progn (setq ptr (1+ ptr))
 		   (lsh (aref bytes ptr) 8))))
 	((and (>= op byte-listN)
-	      (<= op byte-insertN))
+	      (<= op byte-discardN))
 	 (setq ptr (1+ ptr))		;offset in next byte
 	 (aref bytes ptr))))
 
@@ -1400,7 +1402,16 @@
 	     (if (= ptr (1- length))
 		 (setq op nil)
 	       (setq offset (or endtag (setq endtag (byte-compile-make-tag)))
-		     op 'byte-goto))))
+		     op 'byte-goto)))
+	    ((eq op 'byte-stack-set2)
+	     (setq op 'byte-stack-set))
+	    ((and (eq op 'byte-discardN) (>= offset #x80))
+	     ;; The top bit of the operand for byte-discardN is a flag,
+	     ;; saying whether the top-of-stack is preserved.  In
+	     ;; lapcode, we represent this by using a different opcode
+	     ;; (with the flag removed from the operand).
+	     (setq op 'byte-discardN-preserve-tos)
+	     (setq offset (- offset #x80))))
       ;; lap = ( [ (pc . (op . arg)) ]* )
       (setq lap (cons (cons optr (cons op (or offset 0)))
 		      lap))
@@ -1456,7 +1467,7 @@
     byte-cdr-safe byte-cons byte-list1 byte-list2 byte-point byte-point-max
     byte-point-min byte-following-char byte-preceding-char
     byte-current-column byte-eolp byte-eobp byte-bolp byte-bobp
-    byte-current-buffer byte-interactive-p))
+    byte-current-buffer byte-interactive-p byte-stack-ref))
 
 (defconst byte-compile-side-effect-free-ops
   (nconc
@@ -1465,7 +1476,7 @@
      byte-eqlsign byte-gtr byte-lss byte-leq byte-geq byte-diff byte-negate
      byte-plus byte-max byte-min byte-mult byte-char-after byte-char-syntax
      byte-buffer-substring byte-string= byte-string< byte-nthcdr byte-elt
-     byte-member byte-assq byte-quo byte-rem)
+     byte-member byte-assq byte-quo byte-rem byte-vec-ref)
    byte-compile-side-effect-and-error-free-ops))
 
 ;; This crock is because of the way DEFVAR_BOOL variables work.
@@ -1498,12 +1509,50 @@
 ;; The variable `byte-boolean-vars' is now primitive and updated
 ;; automatically by DEFVAR_BOOL.
 
+(defmacro byte-opt-update-stack-params (stack-adjust stack-depth lap0 rest lap)
+  "...macro used by byte-optimize-lapcode..."
+  `(progn
+     (byte-compile-log-lap "Before %s  [depth = %s]" ,lap0 ,stack-depth)
+     (cond ((eq (car ,lap0) 'TAG)
+	    ;; A tag can encode the expected stack depth.
+	    (when (cddr ,lap0)
+	      ;; First, check to see if our notion of the current stack
+	      ;; depth agrees with this tag.  We don't check at the
+	      ;; beginning of the function, because the presence of
+	      ;; lexical arguments means the first tag will have a
+	      ;; non-zero offset.
+	      (when (and (not (eq ,rest ,lap)) ; not at first insn
+			 ,stack-depth	; not just after a goto
+			 (not (= (cddr ,lap0) ,stack-depth)))
+		(error "Compiler error: optimizer is confused about %s:
+  %s != %s at lapcode %s" ',stack-depth (cddr ,lap0) ,stack-depth ,lap0))
+	      ;; Now set out current depth from this tag
+	      (setq ,stack-depth (cddr ,lap0)))
+	    (setq ,stack-adjust 0))
+	   ((memq (car ,lap0) '(byte-goto byte-return))
+	    ;; These insns leave us in an unknown state
+	    (setq ,stack-adjust nil))
+	   ((car ,lap0)
+	    ;; Not a no-op, set ,stack-adjust for lap0.  ,stack-adjust will
+	    ;; be added to ,stack-depth at the end of the loop, so any code
+	    ;; that modifies the instruction sequence must adjust this too.
+	    (setq ,stack-adjust
+		  (byte-compile-stack-adjustment (car ,lap0) (cdr ,lap0)))))
+     (byte-compile-log-lap "Before %s  [depth => %s, adj = %s]" ,lap0 ,stack-depth ,stack-adjust)
+     ))
+
 (defun byte-optimize-lapcode (lap &optional for-effect)
   "Simple peephole optimizer.  LAP is both modified and returned.
 If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
   (let (lap0
 	lap1
 	lap2
+	stack-adjust
+	stack-depth
+	(initial-stack-depth
+	 (if (and lap (eq (car (car lap)) 'TAG))
+	     (cdr (cdr (car lap)))
+	   0))
 	(keep-going 'first-time)
 	(add-depth 0)
 	rest tmp tmp2 tmp3
@@ -1514,12 +1563,15 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
       (or (eq keep-going 'first-time)
 	  (byte-compile-log-lap "  ---- next pass"))
       (setq rest lap
+	    stack-depth initial-stack-depth
 	    keep-going nil)
       (while rest
 	(setq lap0 (car rest)
 	      lap1 (nth 1 rest)
 	      lap2 (nth 2 rest))
 
+	(byte-opt-update-stack-params stack-adjust stack-depth lap0 rest lap)
+
 	;; You may notice that sequences like "dup varset discard" are
 	;; optimized but sequences like "dup varset TAG1: discard" are not.
 	;; You may be tempted to change this; resist that temptation.
@@ -1533,22 +1585,22 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	      ((and (eq 'byte-discard (car lap1))
 		    (memq (car lap0) side-effect-free))
 	       (setq keep-going t)
-	       (setq tmp (aref byte-stack+-info (symbol-value (car lap0))))
 	       (setq rest (cdr rest))
-	       (cond ((= tmp 1)
+	       (cond ((= stack-adjust 1)
 		      (byte-compile-log-lap
  		       "  %s discard\t-->\t<deleted>" lap0)
 		      (setq lap (delq lap0 (delq lap1 lap))))
-		     ((= tmp 0)
+		     ((= stack-adjust 0)
 		      (byte-compile-log-lap
 		       "  %s discard\t-->\t<deleted> discard" lap0)
 		      (setq lap (delq lap0 lap)))
-		     ((= tmp -1)
+		     ((= stack-adjust -1)
 		      (byte-compile-log-lap
 		       "  %s discard\t-->\tdiscard discard" lap0)
 		      (setcar lap0 'byte-discard)
 		      (setcdr lap0 0))
-		     ((error "Optimizer error: too much on the stack"))))
+		     ((error "Optimizer error: too much on the stack")))
+	       (setq stack-adjust (1- stack-adjust)))
 	      ;;
 	      ;; goto*-X X:  -->  X:
 	      ;;
@@ -1573,10 +1625,14 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	      ;; const/dup varbind-X varref-X --> const/dup varbind-X const/dup
 	      ;; The latter two can enable other optimizations.
 	      ;;
-	      ((and (eq 'byte-varref (car lap2))
-		    (eq (cdr lap1) (cdr lap2))
-		    (memq (car lap1) '(byte-varset byte-varbind)))
-	       (if (and (setq tmp (memq (car (cdr lap2)) byte-boolean-vars))
+	      ((or (and (eq 'byte-varref (car lap2))
+			(eq (cdr lap1) (cdr lap2))
+			(memq (car lap1) '(byte-varset byte-varbind)))
+		   (and (eq (car lap2) 'byte-stack-ref)
+			(eq (car lap1) 'byte-stack-set)
+			(eq (cdr lap1) (cdr lap2))))
+	       (if (and (eq 'byte-varref (car lap2))
+			(setq tmp (memq (car (cdr lap2)) byte-boolean-vars))
 			(not (eq (car lap0) 'byte-constant)))
 		   nil
 		 (setq keep-going t)
@@ -1608,10 +1664,11 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	      ;;
 	      ((and (eq 'byte-dup (car lap0))
 		    (eq 'byte-discard (car lap2))
-		    (memq (car lap1) '(byte-varset byte-varbind)))
+		    (memq (car lap1) '(byte-varset byte-varbind byte-stack-set byte-vec-set)))
 	       (byte-compile-log-lap "  dup %s discard\t-->\t%s" lap1 lap1)
 	       (setq keep-going t
-		     rest (cdr rest))
+		     rest (cdr rest)
+		     stack-adjust -1)
 	       (setq lap (delq lap0 (delq lap2 lap))))
 	      ;;
 	      ;; not goto-X-if-nil              -->  goto-X-if-non-nil
@@ -1633,7 +1690,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 				'byte-goto-if-not-nil
 				'byte-goto-if-nil))
 	       (setq lap (delq lap0 lap))
-	       (setq keep-going t))
+	       (setq keep-going t
+		     stack-adjust 0))
 	      ;;
 	      ;; goto-X-if-nil     goto-Y X:  -->  goto-Y-if-non-nil X:
 	      ;; goto-X-if-non-nil goto-Y X:  -->  goto-Y-if-nil     X:
@@ -1649,7 +1707,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 		 (byte-compile-log-lap "  %s %s %s:\t-->\t%s %s:"
 				       lap0 lap1 lap2
 				       (cons inverse (cdr lap1)) lap2)
-		 (setq lap (delq lap0 lap))
+		 (setq lap (delq lap0 lap)
+		       stack-adjust 0)
 		 (setcar lap1 inverse)
 		 (setq keep-going t)))
 	      ;;
@@ -1666,15 +1725,14 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 		      (setq rest (cdr rest)
 			    lap (delq lap0 (delq lap1 lap))))
 		     (t
-		      (if (memq (car lap1) byte-goto-always-pop-ops)
-			  (progn
-			    (byte-compile-log-lap "  %s %s\t-->\t%s"
-			     lap0 lap1 (cons 'byte-goto (cdr lap1)))
-			    (setq lap (delq lap0 lap)))
-			(byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1
-			 (cons 'byte-goto (cdr lap1))))
+		      (byte-compile-log-lap "  %s %s\t-->\t%s"
+					    lap0 lap1
+					    (cons 'byte-goto (cdr lap1)))
+		      (when (memq (car lap1) byte-goto-always-pop-ops)
+			(setq lap (delq lap0 lap)))
 		      (setcar lap1 'byte-goto)))
-	       (setq keep-going t))
+	       (setq keep-going t
+		     stack-adjust 0))
 	      ;;
 	      ;; varref-X varref-X  -->  varref-X dup
 	      ;; varref-X [dup ...] varref-X  -->  varref-X [dup ...] dup
@@ -1682,14 +1740,14 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	      ;; because that would inhibit some goto optimizations; we
 	      ;; optimize the const-X case after all other optimizations.
 	      ;;
-	      ((and (eq 'byte-varref (car lap0))
+	      ((and (memq (car lap0) '(byte-varref byte-stack-ref))
 		    (progn
-		      (setq tmp (cdr rest))
+		      (setq tmp (cdr rest) tmp2 0)
 		      (while (eq (car (car tmp)) 'byte-dup)
-			(setq tmp (cdr tmp)))
+			(setq tmp (cdr tmp) tmp2 (1+ tmp2)))
 		      t)
-		    (eq (cdr lap0) (cdr (car tmp)))
-		    (eq 'byte-varref (car (car tmp))))
+		    (eq (car lap0) (car (car tmp)))
+		    (eq (cdr lap0) (cdr (car tmp))))
 	       (if (memq byte-optimize-log '(t byte))
 		   (let ((str ""))
 		     (setq tmp2 (cdr rest))
@@ -1701,7 +1759,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	       (setq keep-going t)
 	       (setcar (car tmp) 'byte-dup)
 	       (setcdr (car tmp) 0)
-	       (setq rest tmp))
+	       (setq rest tmp
+		     stack-adjust (+ 2 tmp2)))
 	      ;;
 	      ;; TAG1: TAG2: --> TAG1: <deleted>
 	      ;; (and other references to TAG2 are replaced with TAG1)
@@ -1768,7 +1827,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	       (byte-compile-log-lap "  %s %s\t-->\t%s %s" lap0 lap1 lap1 lap0)
 	       (setcar rest lap1)
 	       (setcar (cdr rest) lap0)
-	       (setq keep-going t))
+	       (setq keep-going t
+		     stack-adjust 0))
 	      ;;
 	      ;; varbind-X unbind-N         -->  discard unbind-(N-1)
 	      ;; save-excursion unbind-N    -->  unbind-(N-1)
@@ -1794,6 +1854,14 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 		   ""))
 	       (setq keep-going t))
 	      ;;
+	      ;; stack-ref-N  -->  dup    ; where N is TOS
+	      ;;
+	      ((and (eq (car lap0) 'byte-stack-ref)
+		    (= (cdr lap0) (1- stack-depth)))
+	       (setcar lap0 'byte-dup)
+	       (setcdr lap0 nil)
+	       (setq keep-going t))
+	      ;;
 	      ;; goto*-X ... X: goto-Y  --> goto*-Y
 	      ;; goto-X ...  X: return  --> return
 	      ;;
@@ -1870,20 +1938,22 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 					    (cdr tmp))))
 		      (setcdr lap1 (car (cdr tmp)))
 		      (setq lap (delq lap0 lap))))
-	       (setq keep-going t))
+	       (setq keep-going t
+		     stack-adjust 0))
 	      ;;
 	      ;; X: varref-Y    ...     varset-Y goto-X  -->
 	      ;; X: varref-Y Z: ... dup varset-Y goto-Z
 	      ;; (varset-X goto-BACK, BACK: varref-X --> copy the varref down.)
 	      ;; (This is so usual for while loops that it is worth handling).
 	      ;;
-	      ((and (eq (car lap1) 'byte-varset)
+	      ((and (memq (car lap1) '(byte-varset byte-stack-set))
 		    (eq (car lap2) 'byte-goto)
 		    (not (memq (cdr lap2) rest)) ;Backwards jump
 		    (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap)))))
-			'byte-varref)
+			(if (eq (car lap1) 'byte-varset) 'byte-varref 'byte-stack-ref))
 		    (eq (cdr (car tmp)) (cdr lap1))
-		    (not (memq (car (cdr lap1)) byte-boolean-vars)))
+		    (not (and (eq (car lap1) 'byte-varref)
+			      (memq (car (cdr lap1)) byte-boolean-vars))))
 	       ;;(byte-compile-log-lap "  Pulled %s to end of loop" (car tmp))
 	       (let ((newtag (byte-compile-make-tag)))
 		 (byte-compile-log-lap
@@ -1940,10 +2010,15 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 					   byte-goto-if-not-nil
 					   byte-goto byte-goto))))
 	       )
-	       (setq keep-going t))
+	       (setq keep-going t
+		     stack-adjust (and (not (eq (car lap0) 'byte-goto)) -1)))
 	      )
+
+	(setq stack-depth 
+	      (and stack-depth stack-adjust (+ stack-depth stack-adjust)))
 	(setq rest (cdr rest)))
       )
+
     ;; Cleanup stage:
     ;; Rebuild byte-compile-constants / byte-compile-variables.
     ;; Simple optimizations that would inhibit other optimizations if they
@@ -1951,10 +2026,13 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
     ;;  need to do more than once.
     (setq byte-compile-constants nil
 	  byte-compile-variables nil)
-    (setq rest lap)
+    (setq rest lap
+	  stack-depth initial-stack-depth)
+    (byte-compile-log-lap "  ---- final pass")
     (while rest
       (setq lap0 (car rest)
 	    lap1 (nth 1 rest))
+      (byte-opt-update-stack-params stack-adjust stack-depth lap0 rest lap)
       (if (memq (car lap0) byte-constref-ops)
 	  (if (or (eq (car lap0) 'byte-constant)
 		  (eq (car lap0) 'byte-constant2))
@@ -2001,11 +2079,108 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance."
 	     (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1
 				   (cons 'byte-unbind
 					 (+ (cdr lap0) (cdr lap1))))
-	     (setq keep-going t)
 	     (setq lap (delq lap0 lap))
 	     (setcdr lap1 (+ (cdr lap1) (cdr lap0))))
+	    
+	    ;;
+	    ;; stack-set-M [discard/discardN ...]  -->  discardN-preserve-tos
+	    ;; stack-set-M [discard/discardN ...]  -->  discardN
+	    ;;
+	    ((and (eq (car lap0) 'byte-stack-set)
+		  (memq (car lap1) '(byte-discard byte-discardN))
+		  (progn
+		    ;; See if enough discard operations follow to expose or
+		    ;; destroy the value stored by the stack-set.
+		    (setq tmp (cdr rest))
+		    (setq tmp2 (- stack-depth 2 (cdr lap0)))
+		    (setq tmp3 0)
+		    (while (memq (car (car tmp)) '(byte-discard byte-discardN))
+		      (if (eq (car (car tmp)) 'byte-discard)
+			  (setq tmp3 (1+ tmp3))
+			(setq tmp3 (+ tmp3 (cdr (car tmp)))))
+		      (setq tmp (cdr tmp)))
+		    (>= tmp3 tmp2)))
+	     ;; Do the optimization
+	     (setq lap (delq lap0 lap))
+	     (cond ((= tmp2 tmp3)
+		    ;; The value stored is the new TOS, so pop one more value
+		    ;; (to get rid of the old value) using the TOS-preserving
+		    ;; discard operator.
+		    (setcar lap1 'byte-discardN-preserve-tos)
+		    (setcdr lap1 (1+ tmp3)))
+		   (t
+		    ;; Otherwise, the value stored is lost, so just use a
+		    ;; normal discard.
+		    (setcar lap1 'byte-discardN)
+		    (setcdr lap1 tmp3)))
+	     (setcdr (cdr rest) tmp)
+	     (setq stack-adjust 0)
+	     (byte-compile-log-lap "  %s [discard/discardN]...\t-->\t%s"
+				   lap0 lap1))
+
+	    ;;
+	    ;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y  -->
+	    ;; discardN-(X+Y)
+	    ;;
+	    ((and (memq (car lap0)
+			'(byte-discard
+			  byte-discardN
+			  byte-discardN-preserve-tos))
+		  (memq (car lap1) '(byte-discard byte-discardN)))
+	     (setq lap (delq lap0 lap))
+	     (byte-compile-log-lap
+	      "  %s %s\t-->\t(discardN %s)"
+	      lap0 lap1
+	      (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0))
+		 (if (eq (car lap1) 'byte-discard) 1 (cdr lap1))))
+	     (setcdr lap1 (+ (if (eq (car lap0) 'byte-discard) 1 (cdr lap0))
+			     (if (eq (car lap1) 'byte-discard) 1 (cdr lap1))))
+	     (setcar lap1 'byte-discardN)
+	     (setq stack-adjust 0))
+
+	    ;;
+	    ;; discardN-preserve-tos-X discardN-preserve-tos-Y  -->
+	    ;; discardN-preserve-tos-(X+Y)
+	    ;;
+	    ((and (eq (car lap0) 'byte-discardN-preserve-tos)
+		  (eq (car lap1) 'byte-discardN-preserve-tos))
+	     (setq lap (delq lap0 lap))
+	     (setcdr lap1 (+ (cdr lap0) (cdr lap1)))
+	     (setq stack-adjust 0)
+	     (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1 (car rest)))
+
+	    ;;
+	    ;; discardN-preserve-tos return  -->  return
+	    ;; dup return  -->  return
+	    ;; stack-set-N return  -->  return     ; where N is TOS-1
+	    ;;
+	    ((and (eq (car lap1) 'byte-return)
+		  (or (memq (car lap0) '(byte-discardN-preserve-tos byte-dup))
+		      (and (eq (car lap0) 'byte-stack-set)
+			   (= (cdr lap0) (- stack-depth 2)))))
+	     ;; the byte-code interpreter will pop the stack for us, so
+	     ;; we can just leave stuff on it
+	     (setq lap (delq lap0 lap))
+	     (setq stack-adjust 0)
+	     (byte-compile-log-lap "  %s %s\t-->\t%s" lap0 lap1 lap1))
+
+	    ;;
+	    ;; dup stack-set-N return  -->  return     ; where N is TOS
+	    ;;
+	    ((and (eq (car lap0) 'byte-dup)
+		  (eq (car lap1) 'byte-stack-set)
+		  (eq (car (car (cdr (cdr rest)))) 'byte-return)
+		  (= (cdr lap1) (1- stack-depth)))
+	     (setq lap (delq lap0 (delq lap1 lap)))
+	     (setq rest (cdr rest))
+	     (setq stack-adjust 0)
+	     (byte-compile-log-lap "  dup %s return\t-->\treturn" lap1))
 	    )
+
+      (setq stack-depth 
+	    (and stack-depth stack-adjust (+ stack-depth stack-adjust)))
       (setq rest (cdr rest)))
+
     (setq byte-compile-maxdepth (+ byte-compile-maxdepth add-depth)))
   lap)
 
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el
index 217afea9f8a..c80bcd49b82 100644
--- a/lisp/emacs-lisp/bytecomp.el
+++ b/lisp/emacs-lisp/bytecomp.el
@@ -116,12 +116,55 @@
 ;;     Some versions of `file' can be customized to recognize that.
 
 (require 'backquote)
+(require 'macroexp)
 (eval-when-compile (require 'cl))
 
 (or (fboundp 'defsubst)
     ;; This really ought to be loaded already!
     (load "byte-run"))
 
+;; We want to do (require 'byte-lexbind) when compiling, to avoid compilation
+;; errors; however that file also wants to do (require 'bytecomp) for the
+;; same reason.  Since we know it's OK to load byte-lexbind.el second, we
+;; have that file require a feature that's provided before at the beginning
+;; of this file, to avoid an infinite require loop.
+;; `eval-when-compile' is defined in byte-run.el, so it must come after the
+;; preceding load expression.
+(provide 'bytecomp-preload)
+(eval-when-compile (require 'byte-lexbind))
+
+;; The feature of compiling in a specific target Emacs version
+;; has been turned off because compile time options are a bad idea.
+(defmacro byte-compile-single-version () nil)
+(defmacro byte-compile-version-cond (cond) cond)
+
+;; The crud you see scattered through this file of the form
+;;   (or (and (boundp 'epoch::version) epoch::version)
+;;	  (string-lessp emacs-version "19"))
+;; is because the Epoch folks couldn't be bothered to follow the
+;; normal emacs version numbering convention.
+
+;; (if (byte-compile-version-cond
+;;      (or (and (boundp 'epoch::version) epoch::version)
+;; 	 (string-lessp emacs-version "19")))
+;;     (progn
+;;       ;; emacs-18 compatibility.
+;;       (defvar baud-rate (baud-rate))	;Define baud-rate if it's undefined
+;;
+;;       (if (byte-compile-single-version)
+;; 	  (defmacro byte-code-function-p (x) "Emacs 18 doesn't have these." nil)
+;; 	(defun byte-code-function-p (x) "Emacs 18 doesn't have these." nil))
+;;
+;;       (or (and (fboundp 'member)
+;; 	       ;; avoid using someone else's possibly bogus definition of this.
+;; 	       (subrp (symbol-function 'member)))
+;; 	  (defun member (elt list)
+;; 	    "like memq, but uses equal instead of eq.  In v19, this is a subr."
+;; 	    (while (and list (not (equal elt (car list))))
+;; 	      (setq list (cdr list)))
+;; 	    list))))
+
+
 (defgroup bytecomp nil
   "Emacs Lisp byte-compiler."
   :group 'lisp)
@@ -398,7 +441,17 @@ specify different fields to sort on."
   :type '(choice (const name) (const callers) (const calls)
 		 (const calls+callers) (const nil)))
 
-(defvar byte-compile-debug nil)
+;(defvar byte-compile-debug nil)
+(defvar byte-compile-debug t)
+
+;; (defvar byte-compile-overwrite-file t
+;;   "If nil, old .elc files are deleted before the new is saved, and .elc
+;; files will have the same modes as the corresponding .el file.  Otherwise,
+;; existing .elc files will simply be overwritten, and the existing modes
+;; will not be changed.  If this variable is nil, then an .elc file which
+;; is a symbolic link will be turned into a normal file, instead of the file
+;; which the link points to being overwritten.")
+
 (defvar byte-compile-constants nil
   "List of all constants encountered during compilation of this form.")
 (defvar byte-compile-variables nil
@@ -418,11 +471,18 @@ This list lives partly on the stack.")
 ;;     (byte-compiler-options . (lambda (&rest forms)
 ;; 			       (apply 'byte-compiler-options-handler forms)))
     (eval-when-compile . (lambda (&rest body)
-			   (list 'quote
-				 (byte-compile-eval (byte-compile-top-level
-						     (cons 'progn body))))))
+			   (list
+			    'quote
+			    (byte-compile-eval
+			      (byte-compile-top-level
+			       (macroexpand-all
+				(cons 'progn body)
+				byte-compile-initial-macro-environment))))))
     (eval-and-compile . (lambda (&rest body)
-			  (byte-compile-eval-before-compile (cons 'progn body))
+			  (byte-compile-eval-before-compile
+			   (macroexpand-all
+			    (cons 'progn body)
+			    byte-compile-initial-macro-environment))
 			  (cons 'progn body))))
   "The default macro-environment passed to macroexpand by the compiler.
 Placing a macro here will cause a macro to have different semantics when
@@ -453,6 +513,14 @@ defined with incorrect args.")
 Used for warnings about calling a function that is defined during compilation
 but won't necessarily be defined when the compiled file is loaded.")
 
+;; Variables for lexical binding
+(defvar byte-compile-lexical-environment nil
+  "The current lexical environment.")
+(defvar byte-compile-current-heap-environment nil
+  "If non-nil, a descriptor for the current heap-allocated lexical environment.")
+(defvar byte-compile-current-num-closures 0
+  "The number of lexical closures that close over `byte-compile-current-heap-environment'.")
+
 (defvar byte-compile-tag-number 0)
 (defvar byte-compile-output nil
   "Alist describing contents to put in byte code string.
@@ -498,11 +566,10 @@ Each element is (INDEX . VALUE)")
     (put 'byte-stack+-info 'tmp-compile-time-value nil)))
 
 
-;; unused: 0-7
-
 ;; These opcodes are special in that they pack their argument into the
 ;; opcode word.
 ;;
+(byte-defop   0  1 byte-stack-ref "for stack reference")
 (byte-defop   8  1 byte-varref	"for variable reference")
 (byte-defop  16 -1 byte-varset	"for setting a variable")
 (byte-defop  24 -1 byte-varbind	"for binding a variable")
@@ -664,11 +731,28 @@ otherwise pop it")
 (byte-defop 168  0 byte-integerp)
 
 ;; unused: 169-174
+
 (byte-defop 175 nil byte-listN)
 (byte-defop 176 nil byte-concatN)
 (byte-defop 177 nil byte-insertN)
 
-;; unused: 178-191
+(byte-defop 178 -1 byte-stack-set)	; stack offset in following one byte
+(byte-defop 179 -1 byte-stack-set2)	; stack offset in following two bytes
+(byte-defop 180  1 byte-vec-ref)	; vector offset in following one byte
+(byte-defop 181 -1 byte-vec-set)	; vector offset in following one byte
+
+;; if (following one byte & 0x80) == 0
+;;    discard (following one byte & 0x7F) stack entries
+;; else
+;;    discard (following one byte & 0x7F) stack entries _underneath_ the top of stack
+;;    (that is, if the operand = 0x83,  ... X Y Z T  =>  ... T)
+(byte-defop 182 nil byte-discardN)
+;; `byte-discardN-preserve-tos' is a pseudo-op that gets turned into
+;; `byte-discardN' with the high bit in the operand set (by
+;; `byte-compile-lapcode').
+(defconst byte-discardN-preserve-tos byte-discardN)
+
+;; unused: 182-191
 
 (byte-defop 192  1 byte-constant	"for reference to a constant")
 ;; codes 193-255 are consumed by byte-constant.
@@ -715,71 +799,108 @@ otherwise pop it")
 ;; front of the constants-vector than the constant-referencing instructions.
 ;; Also, this lets us notice references to free variables.
 
+(defmacro byte-compile-push-bytecodes (&rest args)
+  "Push BYTE... onto BYTES, and increment PC by the number of bytes pushed.
+ARGS is of the form (BYTE... BYTES PC), where BYTES and PC are variable names.
+BYTES and PC are updated after evaluating all the arguments."
+  (let ((byte-exprs (butlast args 2))
+	(bytes-var (car (last args 2)))
+	(pc-var (car (last args))))
+    `(setq ,bytes-var ,(if (null (cdr byte-exprs))
+			   `(cons ,@byte-exprs ,bytes-var)
+			 `(nconc (list ,@(reverse byte-exprs)) ,bytes-var))
+	   ,pc-var (+ ,(length byte-exprs) ,pc-var))))
+
+(defmacro byte-compile-push-bytecode-const2 (opcode const2 bytes pc)
+  "Push OPCODE and the two-byte constant CONST2 onto BYTES, and add 3 to PC.
+CONST2 may be evaulated multiple times."
+  `(byte-compile-push-bytecodes ,opcode (logand ,const2 255) (lsh ,const2 -8)
+				,bytes ,pc))
+
 (defun byte-compile-lapcode (lap)
   "Turns lapcode into bytecode.  The lapcode is destroyed."
   ;; Lapcode modifications: changes the ID of a tag to be the tag's PC.
   (let ((pc 0)			; Program counter
 	op off			; Operation & offset
+	opcode			; numeric value of OP
 	(bytes '())		; Put the output bytes here
-	(patchlist nil))	; List of tags and goto's to patch
-    (while lap
-      (setq op (car (car lap))
-	    off (cdr (car lap)))
+	(patchlist nil))	; List of gotos to patch
+    (dolist (lap-entry lap)
+      (setq op (car lap-entry)
+	    off (cdr lap-entry))
       (cond ((not (symbolp op))
 	     (error "Non-symbolic opcode `%s'" op))
 	    ((eq op 'TAG)
-	     (setcar off pc)
-	     (setq patchlist (cons off patchlist)))
-	    ((memq op byte-goto-ops)
-	     (setq pc (+ pc 3))
-	     (setq bytes (cons (cons pc (cdr off))
-			       (cons nil
-				     (cons (symbol-value op) bytes))))
-	     (setq patchlist (cons bytes patchlist)))
+	     (setcar off pc))
+	    ((null op)
+	     ;; a no-op added by `byte-compile-delay-out'
+	     (unless (zerop off)
+	       (error
+		"Placeholder added by `byte-compile-delay-out' not filled in.")
+	       ))
 	    (t
-	     (setq bytes
-		   (cond ((cond ((consp off)
-				 ;; Variable or constant reference
-				 (setq off (cdr off))
-				 (eq op 'byte-constant)))
-			  (cond ((< off byte-constant-limit)
-				 (setq pc (1+ pc))
-				 (cons (+ byte-constant off) bytes))
-				(t
-				 (setq pc (+ 3 pc))
-				 (cons (lsh off -8)
-				       (cons (logand off 255)
-					     (cons byte-constant2 bytes))))))
-			 ((<= byte-listN (symbol-value op))
-			  (setq pc (+ 2 pc))
-			  (cons off (cons (symbol-value op) bytes)))
-			 ((< off 6)
-			  (setq pc (1+ pc))
-			  (cons (+ (symbol-value op) off) bytes))
-			 ((< off 256)
-			  (setq pc (+ 2 pc))
-			  (cons off (cons (+ (symbol-value op) 6) bytes)))
-			 (t
-			  (setq pc (+ 3 pc))
-			  (cons (lsh off -8)
-				(cons (logand off 255)
-				      (cons (+ (symbol-value op) 7)
-					    bytes))))))))
-      (setq lap (cdr lap)))
+	     (if (eq op 'byte-discardN-preserve-tos)
+		 ;; byte-discardN-preserve-tos is a psuedo op, which is actually
+		 ;; the same as byte-discardN with a modified argument
+		 (setq opcode byte-discardN)
+	       (setq opcode (symbol-value op)))
+	     (cond ((memq op byte-goto-ops)
+		    ;; goto
+		    (byte-compile-push-bytecodes opcode nil (cdr off) bytes pc)
+		    (push bytes patchlist)) 
+		   ((and (consp off)
+			 ;; Variable or constant reference
+			 (progn (setq off (cdr off))
+				(eq op 'byte-constant)))
+		    ;; constant ref
+		    (if (< off byte-constant-limit)
+			(byte-compile-push-bytecodes (+ byte-constant off)
+						     bytes pc)
+		      (byte-compile-push-bytecode-const2 byte-constant2 off
+							 bytes pc)))
+		   ((and (= opcode byte-stack-set)
+			 (> off 255))
+		    ;; Use the two-byte version of byte-stack-set if the
+		    ;; offset is too large for the normal version.
+		    (byte-compile-push-bytecode-const2 byte-stack-set2 off
+						       bytes pc))
+		   ((and (>= opcode byte-listN)
+			 (< opcode byte-discardN))
+		    ;; These insns all put their operand into one extra byte.
+		    (byte-compile-push-bytecodes opcode off bytes pc))
+		   ((= opcode byte-discardN)
+		    ;; byte-discardN is wierd in that it encodes a flag in the
+		    ;; top bit of its one-byte argument.  If the argument is
+		    ;; too large to fit in 7 bits, the opcode can be repeated.
+		    (let ((flag (if (eq op 'byte-discardN-preserve-tos) #x80 0)))
+		      (while (> off #x7f)
+			(byte-compile-push-bytecodes opcode (logior #x7f flag) bytes pc)
+			(setq off (- off #x7f)))
+		      (byte-compile-push-bytecodes opcode (logior off flag) bytes pc)))
+		   ((null off)
+		    ;; opcode that doesn't use OFF
+		    (byte-compile-push-bytecodes opcode bytes pc))
+		   ;; The following three cases are for the special
+		   ;; insns that encode their operand into 0, 1, or 2
+		   ;; extra bytes depending on its magnitude.
+		   ((< off 6)
+		    (byte-compile-push-bytecodes (+ opcode off) bytes pc))
+		   ((< off 256)
+		    (byte-compile-push-bytecodes (+ opcode 6) off bytes pc))
+		   (t
+		    (byte-compile-push-bytecode-const2 (+ opcode 7) off
+						       bytes pc))))))
     ;;(if (not (= pc (length bytes)))
     ;;    (error "Compiler error: pc mismatch - %s %s" pc (length bytes)))
-    ;; Patch PC into jumps
-    (let (bytes)
-      (while patchlist
-	(setq bytes (car patchlist))
-	(cond ((atom (car bytes)))	; Tag
-	      (t			; Absolute jump
-	       (setq pc (car (cdr (car bytes))))	; Pick PC from tag
-	       (setcar (cdr bytes) (logand pc 255))
-	       (setcar bytes (lsh pc -8))
-               ;; FIXME: Replace this by some workaround.
-               (if (> (car bytes) 255) (error "Bytecode overflow"))))
-	(setq patchlist (cdr patchlist))))
+
+    ;; Patch tag PCs into absolute jumps
+    (dolist (bytes-tail patchlist)
+      (setq pc (caar bytes-tail))	; Pick PC from goto's tag
+      (setcar (cdr bytes-tail) (logand pc 255))
+      (setcar bytes-tail (lsh pc -8))
+      ;; FIXME: Replace this by some workaround.
+      (if (> (car bytes) 255) (error "Bytecode overflow")))
+
     (apply 'unibyte-string (nreverse bytes))))
 
 
@@ -2073,18 +2194,16 @@ list that represents a doc string reference.
 (defun byte-compile-file-form (form)
   (let ((byte-compile-current-form nil)	; close over this for warnings.
 	bytecomp-handler)
-    (cond
-     ((not (consp form))
-      (byte-compile-keep-pending form))
-     ((and (symbolp (car form))
-	   (setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
-      (cond ((setq form (funcall bytecomp-handler form))
-	     (byte-compile-flush-pending)
-	     (byte-compile-output-file-form form))))
-     ((eq form (setq form (macroexpand form byte-compile-macro-environment)))
-      (byte-compile-keep-pending form))
-     (t
-      (byte-compile-file-form form)))))
+    (setq form (macroexpand-all form byte-compile-macro-environment))
+    (cond ((not (consp form))
+	   (byte-compile-keep-pending form))
+	  ((and (symbolp (car form))
+		(setq bytecomp-handler (get (car form) 'byte-hunk-handler)))
+	   (cond ((setq form (funcall bytecomp-handler form))
+		  (byte-compile-flush-pending)
+		  (byte-compile-output-file-form form))))
+	  (t
+	   (byte-compile-keep-pending form)))))
 
 ;; Functions and variables with doc strings must be output separately,
 ;; so make-docfile can recognise them.  Most other things can be output
@@ -2096,8 +2215,7 @@ list that represents a doc string reference.
     (setq byte-compile-current-form (nth 1 form))
     (byte-compile-warn "defsubst `%s' was used before it was defined"
 		       (nth 1 form)))
-  (byte-compile-file-form
-   (macroexpand form byte-compile-macro-environment))
+  (byte-compile-file-form form)
   ;; Return nil so the form is not output twice.
   nil)
 
@@ -2418,6 +2536,12 @@ If FORM is a lambda or a macro, byte-compile it as a function."
       (if macro
 	  (setq fun (cdr fun)))
       (cond ((eq (car-safe fun) 'lambda)
+	     ;; expand macros
+	     (setq fun
+		   (macroexpand-all fun
+				    byte-compile-initial-macro-environment))
+	     ;; get rid of the `function' quote added by the `lambda' macro
+	     (setq fun (cadr fun))
 	     (setq fun (if macro
 			   (cons 'macro (byte-compile-lambda fun))
 			 (byte-compile-lambda fun)))
@@ -2505,6 +2629,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
       (setq list (cdr list)))))
 
 
+(autoload 'byte-compile-make-lambda-lexenv "byte-lexbind")
+
 ;; Byte-compile a lambda-expression and return a valid function.
 ;; The value is usually a compiled function but may be the original
 ;; lambda-expression.
@@ -2561,20 +2687,43 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	     (byte-compile-warn "malformed interactive spec: %s"
 				(prin1-to-string bytecomp-int)))))
     ;; Process the body.
-    (let ((compiled (byte-compile-top-level
-		     (cons 'progn bytecomp-body) nil 'lambda)))
+    (let* ((byte-compile-lexical-environment
+	    ;; If doing lexical binding, push a new lexical environment
+	    ;; containing the args and any closed-over variables.
+	    (and lexical-binding
+		 (byte-compile-make-lambda-lexenv
+		  fun
+		  byte-compile-lexical-environment))) 
+	   (is-closure
+	    ;; This is true if we should be making a closure instead of
+	    ;; a simple lambda (because some variables from the
+	    ;; containing lexical environment are closed over).
+	    (and lexical-binding
+		 (byte-compile-closure-initial-lexenv-p
+		  byte-compile-lexical-environment)))
+	   (byte-compile-current-heap-environment nil)
+	   (byte-compile-current-num-closures 0)
+	   (compiled
+	    (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda)))
       ;; Build the actual byte-coded function.
       (if (eq 'byte-code (car-safe compiled))
-	  (apply 'make-byte-code
-		 (append (list bytecomp-arglist)
-			 ;; byte-string, constants-vector, stack depth
-			 (cdr compiled)
-			 ;; optionally, the doc string.
-			 (if (or bytecomp-doc bytecomp-int)
-			     (list bytecomp-doc))
-			 ;; optionally, the interactive spec.
-			 (if bytecomp-int
-			     (list (nth 1 bytecomp-int)))))
+	  (let ((code
+		 (apply 'make-byte-code
+			(append (list bytecomp-arglist)
+				;; byte-string, constants-vector, stack depth
+				(cdr compiled)
+				;; optionally, the doc string.
+				(if (or bytecomp-doc bytecomp-int
+					lexical-binding)
+				    (list bytecomp-doc))
+				;; optionally, the interactive spec.
+				(if (or bytecomp-int lexical-binding)
+				    (list (nth 1 bytecomp-int)))
+				(if lexical-binding
+				    '(t))))))
+	    (if is-closure
+		(cons 'closure code)
+	      code))
 	(setq compiled
 	      (nconc (if bytecomp-int (list bytecomp-int))
 		     (cond ((eq (car-safe compiled) 'progn) (cdr compiled))
@@ -2585,6 +2734,26 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 				   (bytecomp-body (list nil))))
 		 compiled))))))
 
+(defun byte-compile-closure-code-p (code)
+  (eq (car-safe code) 'closure))
+
+(defun byte-compile-make-closure (code)
+  ;; A real closure requires that the constant be curried with an
+  ;; environment vector to make a closure object.
+  (if for-effect
+      (setq for-effect nil)
+    (byte-compile-push-constant 'curry)
+    (byte-compile-push-constant code)
+    (byte-compile-lexical-variable-ref byte-compile-current-heap-environment)
+    (byte-compile-out 'byte-call 2)))
+
+(defun byte-compile-closure (form &optional add-lambda)
+  (let ((code (byte-compile-lambda form add-lambda)))
+    (if (byte-compile-closure-code-p code)
+	(byte-compile-make-closure code)
+      ;; A simple lambda is just a constant
+      (byte-compile-constant code))))
+
 (defun byte-compile-constants-vector ()
   ;; Builds the constants-vector from the current variables and constants.
   ;;   This modifies the constants from (const . nil) to (const . offset).
@@ -2629,17 +2798,51 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 	(byte-compile-depth 0)
 	(byte-compile-maxdepth 0)
 	(byte-compile-output nil))
-     (if (memq byte-optimize '(t source))
-	 (setq form (byte-optimize-form form for-effect)))
-     (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
-       (setq form (nth 1 form)))
-     (if (and (eq 'byte-code (car-safe form))
-	      (not (memq byte-optimize '(t byte)))
-	      (stringp (nth 1 form)) (vectorp (nth 2 form))
-	      (natnump (nth 3 form)))
-	 form
-       (byte-compile-form form for-effect)
-       (byte-compile-out-toplevel for-effect output-type))))
+    (if (memq byte-optimize '(t source))
+	(setq form (byte-optimize-form form for-effect)))
+    (while (and (eq (car-safe form) 'progn) (null (cdr (cdr form))))
+      (setq form (nth 1 form)))
+    (if (and (eq 'byte-code (car-safe form))
+	     (not (memq byte-optimize '(t byte)))
+	     (stringp (nth 1 form)) (vectorp (nth 2 form))
+	     (natnump (nth 3 form)))
+	form
+      ;; Set up things for a lexically-bound function
+      (when (and lexical-binding (eq output-type 'lambda))
+	;; See how many arguments there are, and set the current stack depth
+	;; accordingly
+	(dolist (var byte-compile-lexical-environment)
+	  (when (byte-compile-lexvar-on-stack-p var)
+	    (setq byte-compile-depth (1+ byte-compile-depth))))
+	;; If there are args, output a tag to record the initial
+	;; stack-depth for the optimizer
+	(when (> byte-compile-depth 0)
+	  (byte-compile-out-tag (byte-compile-make-tag)))
+	;; If this is the top-level of a lexically bound lambda expression,
+	;; perhaps some parameters on stack need to be copied into a heap
+	;; environment, so check for them, and do so if necessary.
+	(let ((lforminfo (byte-compile-make-lforminfo)))
+	  ;; Add any lexical variable that's on the stack to the analysis set.
+	  (dolist (var byte-compile-lexical-environment)
+	    (when (byte-compile-lexvar-on-stack-p var)
+	      (byte-compile-lforminfo-add-var lforminfo (car var) t)))
+	  ;; Analyze the body
+	  (unless (null (byte-compile-lforminfo-vars lforminfo))
+	    (byte-compile-lforminfo-analyze lforminfo form nil nil))
+	  ;; If the analysis revealed some argument need to be in a heap
+	  ;; environment (because they're closed over by an embedded
+	  ;; lambda), put them there.
+	  (setq byte-compile-lexical-environment
+		(nconc (byte-compile-maybe-push-heap-environment lforminfo)
+		       byte-compile-lexical-environment))
+	  (dolist (arginfo (byte-compile-lforminfo-vars lforminfo))
+	    (when (byte-compile-lvarinfo-closed-over-p arginfo)
+	      (byte-compile-bind (car arginfo)
+				 byte-compile-lexical-environment
+				 lforminfo)))))
+      ;; Now compile FORM
+      (byte-compile-form form for-effect)
+      (byte-compile-out-toplevel for-effect output-type))))
 
 (defun byte-compile-out-toplevel (&optional for-effect output-type)
   (if for-effect
@@ -2761,7 +2964,6 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 ;; (Use byte-compile-form-do-effect to reset the for-effect flag too.)
 ;;
 (defun byte-compile-form (form &optional for-effect)
-  (setq form (macroexpand form byte-compile-macro-environment))
   (cond ((not (consp form))
 	 (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form))
 		(when (symbolp form)
@@ -2771,7 +2973,8 @@ If FORM is a lambda or a macro, byte-compile it as a function."
 		(when (symbolp form)
 		  (byte-compile-set-symbol-position form))
 		(setq for-effect nil))
-	       (t (byte-compile-variable-ref 'byte-varref form))))
+	       (t
+		(byte-compile-variable-ref form))))
 	((symbolp (car form))
 	 (let* ((bytecomp-fn (car form))
 		(bytecomp-handler (get bytecomp-fn 'byte-compile)))
@@ -2822,44 +3025,98 @@ That command is designed for interactive use only" bytecomp-fn))
   (mapc 'byte-compile-form (cdr form))	; wasteful, but faster.
   (byte-compile-out 'byte-call (length (cdr form))))
 
-(defun byte-compile-variable-ref (base-op bytecomp-var)
-  (when (symbolp bytecomp-var)
-    (byte-compile-set-symbol-position bytecomp-var))
-  (if (or (not (symbolp bytecomp-var))
-	  (byte-compile-const-symbol-p bytecomp-var
-				       (not (eq base-op 'byte-varref))))
-      (if (byte-compile-warning-enabled-p 'constants)
-	  (byte-compile-warn
-	   (cond ((eq base-op 'byte-varbind) "attempt to let-bind %s `%s'")
-		 ((eq base-op 'byte-varset) "variable assignment to %s `%s'")
-		 (t "variable reference to %s `%s'"))
-	   (if (symbolp bytecomp-var) "constant" "nonvariable")
-	   (prin1-to-string bytecomp-var)))
-    (and (get bytecomp-var 'byte-obsolete-variable)
-	 (not (memq bytecomp-var byte-compile-not-obsolete-vars))
-	 (byte-compile-warn-obsolete bytecomp-var))
-    (if (eq base-op 'byte-varbind)
-	(push bytecomp-var byte-compile-bound-variables)
-      (or (not (byte-compile-warning-enabled-p 'free-vars))
-	  (boundp bytecomp-var)
-	  (memq bytecomp-var byte-compile-bound-variables)
-	  (if (eq base-op 'byte-varset)
-	      (or (memq bytecomp-var byte-compile-free-assignments)
-		  (progn
-		    (byte-compile-warn "assignment to free variable `%s'"
-				       bytecomp-var)
-		    (push bytecomp-var byte-compile-free-assignments)))
-	    (or (memq bytecomp-var byte-compile-free-references)
-		(progn
-		  (byte-compile-warn "reference to free variable `%s'"
-				     bytecomp-var)
-		  (push bytecomp-var byte-compile-free-references)))))))
-  (let ((tmp (assq bytecomp-var byte-compile-variables)))
+(defun byte-compile-check-variable (var &optional binding)
+  "Do various error checks before a use of the variable VAR.
+If BINDING is non-nil, VAR is being bound."
+  (when (symbolp var)
+    (byte-compile-set-symbol-position var))
+  (cond ((or (not (symbolp var)) (byte-compile-const-symbol-p var))
+	 (when (byte-compile-warning-enabled-p 'constants)
+	   (byte-compile-warn (if binding
+				  "attempt to let-bind %s `%s`"
+				"variable reference to %s `%s'")
+			      (if (symbolp var) "constant" "nonvariable")
+			      (prin1-to-string var))))
+	((and (get var 'byte-obsolete-variable)
+	      (not (eq var byte-compile-not-obsolete-var)))
+	 (byte-compile-warn-obsolete var))))
+
+(defsubst byte-compile-dynamic-variable-op (base-op var)
+  (let ((tmp (assq var byte-compile-variables)))
     (unless tmp
-      (setq tmp (list bytecomp-var))
+      (setq tmp (list var))
       (push tmp byte-compile-variables))
     (byte-compile-out base-op tmp)))
 
+(defun byte-compile-dynamic-variable-bind (var)
+  "Generate code to bind the lexical variable VAR to the top-of-stack value."
+  (byte-compile-check-variable var t)
+  (when (byte-compile-warning-enabled-p 'free-vars)
+    (push var byte-compile-bound-variables))
+  (byte-compile-dynamic-variable-op 'byte-varbind var))
+
+;; This is used when it's know that VAR _definitely_ has a lexical
+;; binding, and no error-checking should be done.
+(defun byte-compile-lexical-variable-ref (var)
+  "Generate code to push the value of the lexical variable VAR on the stack."
+  (let ((binding (assq var byte-compile-lexical-environment)))
+    (when (null binding)
+      (error "Lexical binding not found for `%s'" var))
+    (if (byte-compile-lexvar-on-stack-p binding)
+	;; On the stack
+	(byte-compile-stack-ref (byte-compile-lexvar-offset binding))
+      ;; In a heap environment vector; first push the vector on the stack
+      (byte-compile-lexical-variable-ref
+       (byte-compile-lexvar-environment binding))
+      ;; Now get the value from it
+      (byte-compile-out 'byte-vec-ref (byte-compile-lexvar-offset binding)))))
+
+(defun byte-compile-variable-ref (var)
+  "Generate code to push the value of the variable VAR on the stack."
+  (byte-compile-check-variable var)
+  (let ((lex-binding (assq var byte-compile-lexical-environment)))
+    (if lex-binding
+	;; VAR is lexically bound
+	(if (byte-compile-lexvar-on-stack-p lex-binding)
+	    ;; On the stack
+	    (byte-compile-stack-ref (byte-compile-lexvar-offset lex-binding))
+	  ;; In a heap environment vector
+	  (byte-compile-lexical-variable-ref
+	   (byte-compile-lexvar-environment lex-binding))
+	  (byte-compile-out 'byte-vec-ref 
+			    (byte-compile-lexvar-offset lex-binding)))
+      ;; VAR is dynamically bound
+      (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
+		  (boundp var)
+		  (memq var byte-compile-bound-variables)
+		  (memq var byte-compile-free-references))
+	(byte-compile-warn "reference to free variable `%s'" var)
+	(push var byte-compile-free-references))
+      (byte-compile-dynamic-variable-op 'byte-varref var))))
+
+(defun byte-compile-variable-set (var)
+  "Generate code to set the variable VAR from the top-of-stack value."
+  (byte-compile-check-variable var)
+  (let ((lex-binding (assq var byte-compile-lexical-environment)))
+    (if lex-binding
+	;; VAR is lexically bound
+	(if (byte-compile-lexvar-on-stack-p lex-binding)
+	    ;; On the stack
+	    (byte-compile-stack-set (byte-compile-lexvar-offset lex-binding))
+	  ;; In a heap environment vector
+	  (byte-compile-lexical-variable-ref
+	   (byte-compile-lexvar-environment lex-binding))
+	  (byte-compile-out 'byte-vec-set
+			    (byte-compile-lexvar-offset lex-binding)))
+      ;; VAR is dynamically bound
+      (unless (or (not (byte-compile-warning-enabled-p 'free-vars))
+		  (boundp var)
+		  (memq var byte-compile-bound-variables)
+		  (memq var byte-compile-free-assignments))
+	(byte-compile-warn "assignment to free variable `%s'" var)
+	(push var byte-compile-free-assignments))
+      (byte-compile-dynamic-variable-op 'byte-varset var))))
+
 (defmacro byte-compile-get-constant (const)
   `(or (if (stringp ,const)
 	   ;; In a string constant, treat properties as significant.
@@ -2886,6 +3143,25 @@ That command is designed for interactive use only" bytecomp-fn))
   (let ((for-effect nil))
     (inline (byte-compile-constant const))))
 
+(defun byte-compile-push-unknown-constant (&optional id)
+  "Generate code to push a `constant' who's value isn't known yet.
+A tag is returned which may then later be passed to
+`byte-compile-resolve-unknown-constant' to finalize the value.
+The optional argument ID is a tag returned by an earlier call to
+`byte-compile-push-unknown-constant', in which case the same constant is
+pushed again."
+  (unless id
+    (setq id (list (make-symbol "unknown")))
+    (push id byte-compile-constants))
+  (byte-compile-out 'byte-constant id)
+  id)
+
+(defun byte-compile-resolve-unknown-constant (id value)
+  "Give an `unknown constant' a value.
+ID is the tag returned by `byte-compile-push-unknown-constant'.  and VALUE
+is the value it should have."
+  (setcar id value))
+
 
 ;; Compile those primitive ordinary functions
 ;; which have special byte codes just for speed.
@@ -3089,8 +3365,39 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
 (defun byte-compile-noop (form)
   (byte-compile-constant nil))
 
-(defun byte-compile-discard ()
-  (byte-compile-out 'byte-discard 0))
+(defun byte-compile-discard (&optional num preserve-tos)
+  "Output byte codes to discard the NUM entries at the top of the stack (NUM defaults to 1).
+If PRESERVE-TOS is non-nil, preserve the top-of-stack value, as if it were
+popped before discarding the num values, and then pushed back again after
+discarding."
+  (if (and (null num) (not preserve-tos))
+      ;; common case
+      (byte-compile-out 'byte-discard)
+    ;; general case
+    (unless num
+      (setq num 1))
+    (when (and preserve-tos (> num 0))
+      ;; Preserve the top-of-stack value by writing it directly to the stack
+      ;; location which will be at the top-of-stack after popping.
+      (byte-compile-stack-set (1- (- byte-compile-depth num)))
+      ;; Now we actually discard one less value, since we want to keep
+      ;; the eventual TOS
+      (setq num (1- num)))
+    (while (> num 0)
+      (byte-compile-out 'byte-discard)
+      (setq num (1- num)))))
+
+(defun byte-compile-stack-ref (stack-pos)
+  "Output byte codes to push the value at position STACK-POS in the stack, on the top of the stack."
+  (if (= byte-compile-depth (1+ stack-pos))
+      ;; A simple optimization
+      (byte-compile-out 'byte-dup)
+    ;; normal case
+    (byte-compile-out 'byte-stack-ref stack-pos)))
+
+(defun byte-compile-stack-set (stack-pos)
+  "Output byte codes to store the top-of-stack value at position STACK-POS in the stack."
+  (byte-compile-out 'byte-stack-set stack-pos))
 
 
 ;; Compile a function that accepts one or more args and is right-associative.
@@ -3249,40 +3556,14 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
      the syntax (function (lambda (...) ...)) instead.")))))
   (byte-compile-two-args form))
 
-(defun byte-compile-funarg (form)
-  ;; (mapcar '(lambda (x) ..) ..) ==> (mapcar (function (lambda (x) ..)) ..)
-  ;; for cases where it's guaranteed that first arg will be used as a lambda.
-  (byte-compile-normal-call
-   (let ((fn (nth 1 form)))
-     (if (and (eq (car-safe fn) 'quote)
-	      (eq (car-safe (nth 1 fn)) 'lambda))
-	 (cons (car form)
-	       (cons (cons 'function (cdr fn))
-		     (cdr (cdr form))))
-       form))))
-
-(defun byte-compile-funarg-2 (form)
-  ;; (sort ... '(lambda (x) ..)) ==> (sort ... (function (lambda (x) ..)))
-  ;; for cases where it's guaranteed that second arg will be used as a lambda.
-  (byte-compile-normal-call
-   (let ((fn (nth 2 form)))
-     (if (and (eq (car-safe fn) 'quote)
-	      (eq (car-safe (nth 1 fn)) 'lambda))
-	 (cons (car form)
-	       (cons (nth 1 form)
-		     (cons (cons 'function (cdr fn))
-			   (cdr (cdr (cdr form))))))
-       form))))
-
 ;; (function foo) must compile like 'foo, not like (symbol-function 'foo).
 ;; Otherwise it will be incompatible with the interpreter,
 ;; and (funcall (function foo)) will lose with autoloads.
 
 (defun byte-compile-function-form (form)
-  (byte-compile-constant
-   (cond ((symbolp (nth 1 form))
-	  (nth 1 form))
-	 ((byte-compile-lambda (nth 1 form))))))
+  (if (symbolp (nth 1 form))
+      (byte-compile-constant (nth 1 form))
+    (byte-compile-closure (nth 1 form))))
 
 (defun byte-compile-indent-to (form)
   (let ((len (length form)))
@@ -3326,7 +3607,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
 	  (byte-compile-form (car (cdr bytecomp-args)))
 	  (or for-effect (cdr (cdr bytecomp-args))
 	      (byte-compile-out 'byte-dup 0))
-	  (byte-compile-variable-ref 'byte-varset (car bytecomp-args))
+	  (byte-compile-variable-set (car bytecomp-args))
 	  (setq bytecomp-args (cdr (cdr bytecomp-args))))
       ;; (setq), with no arguments.
       (byte-compile-form nil for-effect))
@@ -3392,16 +3673,6 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\""
 (byte-defop-compiler-1 or)
 (byte-defop-compiler-1 while)
 (byte-defop-compiler-1 funcall)
-(byte-defop-compiler-1 apply byte-compile-funarg)
-(byte-defop-compiler-1 mapcar byte-compile-funarg)
-(byte-defop-compiler-1 mapatoms byte-compile-funarg)
-(byte-defop-compiler-1 mapconcat byte-compile-funarg)
-(byte-defop-compiler-1 mapc byte-compile-funarg)
-(byte-defop-compiler-1 maphash byte-compile-funarg)
-(byte-defop-compiler-1 map-char-table byte-compile-funarg)
-(byte-defop-compiler-1 map-char-table byte-compile-funarg-2)
-;; map-charset-chars should be funarg but has optional third arg
-(byte-defop-compiler-1 sort byte-compile-funarg-2)
 (byte-defop-compiler-1 let)
 (byte-defop-compiler-1 let*)
 
@@ -3583,7 +3854,14 @@ that suppresses all warnings during execution of BODY."
 
 (defun byte-compile-while (form)
   (let ((endtag (byte-compile-make-tag))
-	(looptag (byte-compile-make-tag)))
+	(looptag (byte-compile-make-tag))
+	;; Heap environments can't be shared between a loop and its
+	;; enclosing environment (because any lexical variables bound
+	;; inside the loop should have an independent value for each
+	;; iteration).  Setting `byte-compile-current-num-closures' to
+	;; an invalid value causes the code that tries to merge
+	;; environments to not do so.
+	(byte-compile-current-num-closures -1))
     (byte-compile-out-tag looptag)
     (byte-compile-form (car (cdr form)))
     (byte-compile-goto-if nil for-effect endtag)
@@ -3596,34 +3874,116 @@ that suppresses all warnings during execution of BODY."
   (mapc 'byte-compile-form (cdr form))
   (byte-compile-out 'byte-call (length (cdr (cdr form)))))
 
+
+;; let binding
+
+;; All other lexical-binding functions are guarded by a non-nil return
+;; value from `byte-compile-compute-lforminfo', so they needn't be
+;; autoloaded.
+(autoload 'byte-compile-compute-lforminfo "byte-lexbind")
+
+(defun byte-compile-push-binding-init (clause init-lexenv lforminfo)
+  "Emit byte-codes to push the initialization value for CLAUSE on the stack.
+INIT-LEXENV is the lexical environment created for initializations
+already done for this form.
+LFORMINFO should be information about lexical variables being bound.
+Return INIT-LEXENV updated to include the newest initialization, or nil
+if LFORMINFO is nil (meaning all bindings are dynamic)."
+  (let* ((var (if (consp clause) (car clause) clause))
+	 (vinfo
+	  (and lforminfo (assq var (byte-compile-lforminfo-vars lforminfo))))
+	 (unused (and vinfo (zerop (cadr vinfo)))))
+    (unless (and unused (symbolp clause))
+      (when (and lforminfo (not unused))
+	;; We record the stack position even of dynamic bindings and
+	;; variables in non-stack lexical environments; we'll put
+	;; them in the proper place below.
+	(push (byte-compile-make-lexvar var byte-compile-depth) init-lexenv))
+      (if (consp clause)
+	  (byte-compile-form (cadr clause) unused)
+	(byte-compile-push-constant nil))))
+  init-lexenv)
 
 (defun byte-compile-let (form)
-  ;; First compute the binding values in the old scope.
-  (let ((varlist (car (cdr form))))
-    (dolist (var varlist)
-      (if (consp var)
-	  (byte-compile-form (car (cdr var)))
-	(byte-compile-push-constant nil))))
-  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
-	(varlist (reverse (car (cdr form)))))
-    (dolist (var varlist)
-	(byte-compile-variable-ref 'byte-varbind
-				   (if (consp var) (car var) var)))
-    (byte-compile-body-do-effect (cdr (cdr form)))
-    (byte-compile-out 'byte-unbind (length (car (cdr form))))))
+  "Generate code for the `let' form FORM."
+  (let ((clauses (cadr form))
+	(lforminfo (and lexical-binding (byte-compile-compute-lforminfo form)))
+	(init-lexenv nil)
+	;; bind these to restrict the scope of any changes
+	(byte-compile-current-heap-environment
+	 byte-compile-current-heap-environment)
+	(byte-compile-current-num-closures byte-compile-current-num-closures))
+    (when (and lforminfo (byte-compile-non-stack-bindings-p clauses lforminfo))
+      ;; Some of the variables we're binding are lexical variables on
+      ;; the stack, but not all.  As much as we can, rearrange the list
+      ;; so that non-stack lexical variables and dynamically bound
+      ;; variables come last, which allows slightly more optimal
+      ;; byte-code for binding them.
+      (setq clauses (byte-compile-rearrange-let-clauses clauses lforminfo)))
+    ;; If necessary, create a new heap environment to hold some of the
+    ;; variables bound here.
+    (when lforminfo 
+      (setq init-lexenv (byte-compile-maybe-push-heap-environment lforminfo)))
+    ;; First compute the binding values in the old scope.
+    (dolist (clause clauses)
+      (setq init-lexenv
+	    (byte-compile-push-binding-init clause init-lexenv lforminfo)))
+    ;; Now do the bindings, execute the body, and undo the bindings
+    (let ((byte-compile-bound-variables byte-compile-bound-variables)
+	  (byte-compile-lexical-environment byte-compile-lexical-environment)
+	  (preserve-body-value (not for-effect)))
+      (dolist (clause (reverse clauses))
+	(let ((var (if (consp clause) (car clause) clause)))
+	  (cond ((null lforminfo)
+		 ;; If there are no lexical bindings, we can do things simply.
+		 (byte-compile-dynamic-variable-bind var))
+		((byte-compile-bind var init-lexenv lforminfo)
+		 (pop init-lexenv)))))
+      ;; Emit the body
+      (byte-compile-body-do-effect (cdr (cdr form)))
+      ;; Unbind the variables
+      (if lforminfo
+	  ;; Unbind both lexical and dynamic variables
+	 (byte-compile-unbind clauses init-lexenv lforminfo preserve-body-value)
+	;; Unbind dynamic variables
+	(byte-compile-out 'byte-unbind (length clauses))))))
 
 (defun byte-compile-let* (form)
-  (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope
-	(varlist (copy-sequence (car (cdr form)))))
-    (dolist (var varlist)
-      (if (atom var)
-	  (byte-compile-push-constant nil)
-	(byte-compile-form (car (cdr var)))
-	(setq var (car var)))
-      (byte-compile-variable-ref 'byte-varbind var))
+  "Generate code for the `let*' form FORM."
+  (let ((clauses (cadr form))
+	(lforminfo (and lexical-binding (byte-compile-compute-lforminfo form)))
+	(init-lexenv nil)
+	(preserve-body-value (not for-effect))
+	;; bind these to restrict the scope of any changes
+	(byte-compile-bound-variables byte-compile-bound-variables)
+	(byte-compile-lexical-environment byte-compile-lexical-environment)
+	(byte-compile-current-heap-environment
+	 byte-compile-current-heap-environment)
+	(byte-compile-current-num-closures byte-compile-current-num-closures))
+    ;; If necessary, create a new heap environment to hold some of the
+    ;; variables bound here.
+    (when lforminfo 
+      (setq init-lexenv (byte-compile-maybe-push-heap-environment lforminfo)))
+    ;; Bind the variables
+    (dolist (clause clauses)
+      (setq init-lexenv
+	    (byte-compile-push-binding-init clause init-lexenv lforminfo))
+      (let ((var (if (consp clause) (car clause) clause)))
+	(cond ((null lforminfo)
+	       ;; If there are no lexical bindings, we can do things simply.
+	       (byte-compile-dynamic-variable-bind var))
+	      ((byte-compile-bind var init-lexenv lforminfo)
+	       (pop init-lexenv)))))
+    ;; Emit the body
     (byte-compile-body-do-effect (cdr (cdr form)))
-    (byte-compile-out 'byte-unbind (length (car (cdr form))))))
+    ;; Unbind the variables
+    (if lforminfo
+	;; Unbind both lexical and dynamic variables
+	(byte-compile-unbind clauses init-lexenv lforminfo preserve-body-value)
+      ;; Unbind dynamic variables
+      (byte-compile-out 'byte-unbind (length clauses)))))
 
+
 
 (byte-defop-compiler-1 /= byte-compile-negated)
 (byte-defop-compiler-1 atom byte-compile-negated)
@@ -3646,6 +4006,7 @@ that suppresses all warnings during execution of BODY."
 	       "Compiler error: `%s' has no `byte-compile-negated-op' property"
 	       (car form)))
 	  (cdr form))))
+
 
 ;;; other tricky macro-like special-forms
 
@@ -3766,28 +4127,28 @@ that suppresses all warnings during execution of BODY."
       (byte-compile-set-symbol-position (car form))
     (byte-compile-set-symbol-position 'defun)
     (error "defun name must be a symbol, not %s" (car form)))
-  ;; We prefer to generate a defalias form so it will record the function
-  ;; definition just like interpreting a defun.
-  (byte-compile-form
-   (list 'defalias
-	 (list 'quote (nth 1 form))
-	 (byte-compile-byte-code-maker
-	  (byte-compile-lambda (cdr (cdr form)) t)))
-   t)
-  (byte-compile-constant (nth 1 form)))
+  (let ((for-effect nil))
+    (byte-compile-push-constant 'defalias)
+    (byte-compile-push-constant (nth 1 form))
+    (byte-compile-closure (cdr (cdr form)) t))
+  (byte-compile-out 'byte-call 2))
 
 (defun byte-compile-defmacro (form)
   ;; This is not used for file-level defmacros with doc strings.
-  (byte-compile-body-do-effect
-   (let ((decls (byte-compile-defmacro-declaration form))
-         (code (byte-compile-byte-code-maker
-                (byte-compile-lambda (cdr (cdr form)) t))))
-     `((defalias ',(nth 1 form)
-         ,(if (eq (car-safe code) 'make-byte-code)
-              `(cons 'macro ,code)
-            `'(macro . ,(eval code))))
-       ,@decls
-       ',(nth 1 form)))))
+  ;; FIXME handle decls, use defalias?
+  (let ((decls (byte-compile-defmacro-declaration form))
+	(code (byte-compile-lambda (cdr (cdr form)) t))
+	(for-effect nil))
+    (byte-compile-push-constant (nth 1 form))
+    (if (not (byte-compile-closure-code-p code))
+	;; simple lambda
+	(byte-compile-push-constant (cons 'macro code))
+      (byte-compile-push-constant 'macro)
+      (byte-compile-make-closure code)
+      (byte-compile-out 'byte-cons))
+    (byte-compile-out 'byte-fset)
+    (byte-compile-discard))
+  (byte-compile-constant (nth 1 form)))
 
 (defun byte-compile-defvar (form)
   ;; This is not used for file-level defvar/consts with doc strings.
@@ -3813,7 +4174,7 @@ that suppresses all warnings during execution of BODY."
       ;; Put the defined variable in this library's load-history entry
       ;; just as a real defvar would, but only in top-level forms.
       (when (and (cddr form) (null byte-compile-current-form))
-	`(push ',var current-load-list))
+	`(setq current-load-list (cons ',var current-load-list)))
       (when (> (length form) 3)
 	(when (and string (not (stringp string)))
 	    (byte-compile-warn "third arg to `%s %s' is not a string: %s"
@@ -3935,23 +4296,74 @@ that suppresses all warnings during execution of BODY."
   (setq byte-compile-depth (and (not (eq opcode 'byte-goto))
 				(1- byte-compile-depth))))
 
-(defun byte-compile-out (opcode offset)
-  (push (cons opcode offset) byte-compile-output)
-  (cond ((eq opcode 'byte-call)
-	 (setq byte-compile-depth (- byte-compile-depth offset)))
-	((eq opcode 'byte-return)
-	 ;; This is actually an unnecessary case, because there should be
-	 ;; no more opcodes behind byte-return.
-	 (setq byte-compile-depth nil))
-	(t
-	 (setq byte-compile-depth (+ byte-compile-depth
-				     (or (aref byte-stack+-info
-					       (symbol-value opcode))
-					 (- (1- offset))))
-	       byte-compile-maxdepth (max byte-compile-depth
-					  byte-compile-maxdepth))))
-  ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
-  )
+(defun byte-compile-stack-adjustment (op operand)
+  "Return the amount by which an operation adjusts the stack.
+OP and OPERAND are as passed to `byte-compile-out'."
+  (if (memq op '(byte-call byte-discardN byte-discardN-preserve-tos))
+      ;; For calls, OPERAND is the number of args, so we pop OPERAND + 1
+      ;; elements, and the push the result, for a total of -OPERAND.
+      ;; For discardN*, of course, we just pop OPERAND elements.
+      (- operand)
+    (or (aref byte-stack+-info (symbol-value op))
+	;; Ops with a nil entry in `byte-stack+-info' are byte-codes
+	;; that take OPERAND values off the stack and push a result, for
+	;; a total of 1 - OPERAND
+	(- 1 operand))))
+  
+(defun byte-compile-out (op &optional operand)
+  (push (cons op operand) byte-compile-output)
+  (if (eq op 'byte-return)
+      ;; This is actually an unnecessary case, because there should be no
+      ;; more ops behind byte-return.
+      (setq byte-compile-depth nil)
+    (setq byte-compile-depth
+	  (+ byte-compile-depth (byte-compile-stack-adjustment op operand)))
+    (setq byte-compile-maxdepth (max byte-compile-depth byte-compile-maxdepth))
+    ;;(if (< byte-compile-depth 0) (error "Compiler error: stack underflow"))
+    ))
+
+(defun byte-compile-delay-out (&optional stack-used stack-adjust)
+  "Add a placeholder to the output, which can be used to later add byte-codes.
+Return a position tag that can be passed to `byte-compile-delayed-out'
+to add the delayed byte-codes.  STACK-USED is the maximum amount of
+stack-spaced used by the delayed byte-codes (defaulting to 0), and
+STACK-ADJUST is the amount by which the later-added code will adjust the
+stack (defaulting to 0); the byte-codes added later _must_ adjust the
+stack by this amount!  If STACK-ADJUST is 0, then it's not necessary to
+actually add anything later; the effect as if nothing was added at all."
+  ;; We just add a no-op to `byte-compile-output', and return a pointer to
+  ;; the tail of the list; `byte-compile-delayed-out' uses list surgery
+  ;; to add the byte-codes.
+  (when stack-used
+    (setq byte-compile-maxdepth
+	  (max byte-compile-depth (+ byte-compile-depth (or stack-used 0)))))
+  (when stack-adjust
+    (setq byte-compile-depth
+	  (+ byte-compile-depth stack-adjust)))
+  (push (cons nil (or stack-adjust 0)) byte-compile-output))
+
+(defun byte-compile-delayed-out (position op &optional operand)
+  "Add at POSITION the byte-operation OP, with optional numeric arg OPERAND.
+POSITION should a position returned by `byte-compile-delay-out'.
+Return a new position, which can be used to add further operations."
+  (unless (null (caar position))
+    (error "Bad POSITION arg to `byte-compile-delayed-out'"))
+  ;; This is kind of like `byte-compile-out', but we splice into the list
+  ;; where POSITION is.  We don't bother updating `byte-compile-maxdepth'
+  ;; because that was already done by `byte-compile-delay-out', but we do
+  ;; update the relative operand stored in the no-op marker currently at
+  ;; POSITION; since we insert before that marker, this means that if the
+  ;; caller doesn't insert a sequence of byte-codes that matches the expected
+  ;; operand passed to `byte-compile-delay-out', then the nop will still have
+  ;; a non-zero operand when `byte-compile-lapcode' is called, which will
+  ;; cause an error to be signaled.
+
+  ;; Adjust the cumulative stack-adjustment stored in the cdr of the no-op
+  (setcdr (car position)
+	  (- (cdar position) (byte-compile-stack-adjustment op operand)))
+  ;; Add the new operation onto the list tail at POSITION
+  (setcdr position (cons (cons op operand) (cdr position)))
+  position)
 
 
 ;;; call tree stuff
diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el
index 9899e991e3f..18aa5fde0c8 100644
--- a/lisp/emacs-lisp/disass.el
+++ b/lisp/emacs-lisp/disass.el
@@ -73,19 +73,22 @@ redefine OBJECT if it is a symbol."
   (let ((macro 'nil)
 	(name 'nil)
 	(doc 'nil)
+	(lexical-binding nil)
 	args)
     (while (symbolp obj)
       (setq name obj
 	    obj (symbol-function obj)))
     (if (subrp obj)
 	(error "Can't disassemble #<subr %s>" name))
-    (if (and (listp obj) (eq (car obj) 'autoload))
-	(progn
-	  (load (nth 1 obj))
-	  (setq obj (symbol-function name))))
+    (when (and (listp obj) (eq (car obj) 'autoload))
+      (load (nth 1 obj))
+      (setq obj (symbol-function name)))
     (if (eq (car-safe obj) 'macro)	;handle macros
 	(setq macro t
 	      obj (cdr obj)))
+    (when (and (listp obj) (eq (car obj) 'closure))
+      (setq lexical-binding t)
+      (setq obj (cddr obj)))
     (if (and (listp obj) (eq (car obj) 'byte-code))
 	(setq obj (list 'lambda nil obj)))
     (if (and (listp obj) (not (eq (car obj) 'lambda)))
@@ -216,7 +219,9 @@ OBJ should be a call to BYTE-CODE generated by the byte compiler."
 	  (cond ((memq op byte-goto-ops)
 		 (insert (int-to-string (nth 1 arg))))
 		((memq op '(byte-call byte-unbind
-			    byte-listN byte-concatN byte-insertN))
+			    byte-listN byte-concatN byte-insertN
+			    byte-stack-ref byte-stack-set byte-stack-set2
+			    byte-discardN byte-discardN-preserve-tos))
 		 (insert (int-to-string arg)))
 		((memq op '(byte-varref byte-varset byte-varbind))
 		 (prin1 (car arg) (current-buffer)))
diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el
index 02477baf74f..1185f79806f 100644
--- a/lisp/emacs-lisp/lisp-mode.el
+++ b/lisp/emacs-lisp/lisp-mode.el
@@ -701,7 +701,15 @@ If CHAR is not a character, return nil."
 (defun eval-last-sexp-1 (eval-last-sexp-arg-internal)
   "Evaluate sexp before point; print value in minibuffer.
 With argument, print output into current buffer."
-  (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t)))
+  (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))
+	;; preserve the current lexical environment
+	(internal-interpreter-environment internal-interpreter-environment))
+    ;; Setup the lexical environment if lexical-binding is enabled.
+    ;; Note that `internal-interpreter-environment' _can't_ be both
+    ;; assigned and let-bound above -- it's treated specially (and
+    ;; oddly) by the interpreter!
+    (when lexical-binding
+      (setq internal-interpreter-environment '(t)))
     (eval-last-sexp-print-value (eval (preceding-sexp)))))
 
 
diff --git a/lisp/help-fns.el b/lisp/help-fns.el
index 86e9411b140..9a505b214c8 100644
--- a/lisp/help-fns.el
+++ b/lisp/help-fns.el
@@ -100,6 +100,8 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"."
   (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def)))
   ;; If definition is a macro, find the function inside it.
   (if (eq (car-safe def) 'macro) (setq def (cdr def)))
+  ;; and do the same for interpreted closures
+  (if (eq (car-safe def) 'closure) (setq def (cddr def)))
   (cond
    ((byte-code-function-p def) (aref def 0))
    ((eq (car-safe def) 'lambda) (nth 1 def))
@@ -190,7 +192,7 @@ if the variable `help-downcase-arguments' is non-nil."
                  doc t t 1)))))
 
 (defun help-highlight-arguments (usage doc &rest args)
-  (when usage
+  (when (and usage (string-match "^(" usage))
     (with-temp-buffer
       (insert usage)
       (goto-char (point-min))
@@ -347,8 +349,7 @@ suitable file is found, return nil."
          (pt1 (with-current-buffer (help-buffer) (point)))
 	 errtype)
     (setq string
-	  (cond ((or (stringp def)
-		     (vectorp def))
+	  (cond ((or (stringp def) (vectorp def))
 		 "a keyboard macro")
 		((subrp def)
 		 (if (eq 'unevalled (cdr (subr-arity def)))
@@ -356,6 +357,13 @@ suitable file is found, return nil."
 		   (concat beg "built-in function")))
 		((byte-code-function-p def)
 		 (concat beg "compiled Lisp function"))
+		((and (funvecp def) (eq (aref def 0) 'curry))
+		 (if (symbolp (aref def 1))
+		     (format "a curried function calling `%s'" (aref def 1))
+		   "a curried function"))
+		((funvecp def)
+		 (format "a function-vector (funvec) of type `%s'"
+			 (aref def 0)))
 		((symbolp def)
 		 (while (and (fboundp def)
 			     (symbolp (symbol-function def)))
@@ -367,6 +375,8 @@ suitable file is found, return nil."
 		 (concat beg "Lisp function"))
 		((eq (car-safe def) 'macro)
 		 "a Lisp macro")
+		((eq (car-safe def) 'closure)
+		 (concat beg "Lisp closure"))
 		((eq (car-safe def) 'autoload)
 		 (format "%s autoloaded %s"
 			 (if (commandp def) "an interactive" "an")
@@ -494,27 +504,42 @@ suitable file is found, return nil."
 			 ((or (stringp def)
 			      (vectorp def))
 			  (format "\nMacro: %s" (format-kbd-macro def)))
+			 ((and (funvecp def) (eq (aref def 0) 'curry))
+			  ;; Describe a curried-function's function and args
+			  (let ((slot 0))
+			    (mapconcat (lambda (arg)
+					 (setq slot (1+ slot))
+					 (cond
+					  ((= slot 1) "")
+					  ((= slot 2)
+					   (format "  Function: %S" arg))
+					  (t
+					   (format "Argument %d: %S"
+						   (- slot 3) arg))))
+				       def
+				       "\n")))
+			 ((funvecp def) nil)
 			 (t "[Missing arglist.  Please make a bug report.]")))
 		   (high (help-highlight-arguments use doc)))
 	      (let ((fill-begin (point)))
 		(insert (car high) "\n")
-		(fill-region fill-begin (point)))
-	      (setq doc (cdr high))))
-	  (let* ((obsolete (and
-			    ;; function might be a lambda construct.
-			    (symbolp function)
-			    (get function 'byte-obsolete-info)))
-		 (use (car obsolete)))
-	    (when obsolete
-	      (princ "\nThis function is obsolete")
-	      (when (nth 2 obsolete)
-		(insert (format " since %s" (nth 2 obsolete))))
-	      (insert (cond ((stringp use) (concat ";\n" use))
-			    (use (format ";\nuse `%s' instead." use))
-			    (t "."))
-		      "\n"))
-	    (insert "\n"
-		    (or doc "Not documented."))))))))
+		(fill-region fill-begin (point))))
+            (setq doc (cdr high))))
+	(let* ((obsolete (and
+			  ;; function might be a lambda construct.
+			  (symbolp function)
+			  (get function 'byte-obsolete-info)))
+	       (use (car obsolete)))
+	  (when obsolete
+	    (princ "\nThis function is obsolete")
+	    (when (nth 2 obsolete)
+	      (insert (format " since %s" (nth 2 obsolete))))
+	    (insert (cond ((stringp use) (concat ";\n" use))
+			  (use (format ";\nuse `%s' instead." use))
+			  (t "."))
+		    "\n"))
+	  (insert "\n"
+		  (or doc "Not documented.")))))))
 
 
 ;; Variables
diff --git a/lisp/subr.el b/lisp/subr.el
index 16ba45f1c74..61a226c20ff 100644
--- a/lisp/subr.el
+++ b/lisp/subr.el
@@ -427,6 +427,12 @@ Non-strings in LIST are ignored."
     (setq list (cdr list)))
   list)
 
+(defmacro with-lexical-binding (&rest body)
+  "Execute the statements in BODY using lexical binding."
+  `(let ((internal-interpreter-environment internal-interpreter-environment))
+     (setq internal-interpreter-environment '(t))
+     ,@body))
+
 (defun assq-delete-all (key alist)
   "Delete from ALIST all elements whose car is `eq' to KEY.
 Return the modified alist.
diff --git a/src/ChangeLog.funvec b/src/ChangeLog.funvec
new file mode 100644
index 00000000000..098539f1dd9
--- /dev/null
+++ b/src/ChangeLog.funvec
@@ -0,0 +1,37 @@
+2004-05-20  Miles Bader  <miles@gnu.org>
+
+	* lisp.h: Declare make_funvec and Ffunvec.
+	(enum pvec_type): Rename `PVEC_COMPILED' to `PVEC_FUNVEC'.
+	(XSETFUNVEC): Renamed from `XSETCOMPILED'.
+	(FUNVEC_SIZE, FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): New macros.
+	(COMPILEDP): Define in terms of funvec macros.
+	(FUNVECP, GC_FUNVECP): Renamed from `COMPILEDP' & `GC_COMPILEDP'.
+	(FUNCTIONP): Use FUNVECP instead of COMPILEDP.
+	* alloc.c (make_funvec, funvec): New functions.
+	(Fmake_byte_code): Make sure the first element is a list.
+
+	* eval.c (Qcurry): New variable.
+	(funcall_funvec, Fcurry): New functions.
+	(syms_of_eval): Initialize them.
+	(funcall_lambda): Handle non-bytecode funvec objects by calling
+	funcall_funvec.
+	(Ffuncall, Feval): Use FUNVECP insetad of COMPILEDP.
+	* lread.c (read1): Return result of read_vector for `#[' syntax
+	directly; read_vector now does any extra work required.
+	(read_vector): Handle both funvec and byte-code objects, converting the
+	type as necessary.  `bytecodeflag' argument is now called
+	`read_funvec'.
+	* data.c (Ffunvecp): New function.
+	* doc.c (Fdocumentation): Return nil for unknown funvecs.
+	* fns.c (mapcar1, Felt, concat): Allow funvecs.
+
+	* eval.c (Ffunctionp): Use `funvec' operators instead of `compiled'
+	operators.
+	* alloc.c (Fmake_byte_code, Fpurecopy, mark_object): Likewise.
+	* keyboard.c (Fcommand_execute): Likewise.
+	* image.c (parse_image_spec): Likewise.
+	* fns.c (Flength, concat, internal_equal): Likewise.
+	* data.c (Faref, Ftype_of): Likewise.
+	* print.c (print_preprocess, print_object): Likewise.
+
+;; arch-tag: f35a6a00-4a11-4739-a4b6-9cf98296f315
diff --git a/src/ChangeLog.lexbind b/src/ChangeLog.lexbind
new file mode 100644
index 00000000000..c8336d12e9c
--- /dev/null
+++ b/src/ChangeLog.lexbind
@@ -0,0 +1,104 @@
+2008-04-23  Miles Bader  <miles@gnu.org>
+
+	* eval.c (Ffunctionp): Return nil for special forms.
+	(Qunevalled): New variable.
+	(syms_of_eval): Initialize it.
+
+2007-10-18  Miles Bader  <miles@gnu.org>
+
+	* eval.c (FletX): Test the type of VARLIST rather than just !NILP.
+	(Flet): Use XCAR instead of Fcar.
+
+2007-10-16  Miles Bader  <miles@gnu.org>
+
+	* alloc.c (make_funvec, Fpurecopy): Set the pseudo-vector type.
+
+2006-02-10  Miles Bader  <miles@gnu.org>
+
+	* eval.c (Ffunctionp): Supply new 2nd arg to Findirect_function.
+
+2005-03-04  Miles Bader  <miles@gnu.org>
+
+	* eval.c (FletX): Update Vinterpreter_lexical_environment for each
+	variable we bind, instead of all at once like `let'.
+
+2004-08-09  Miles Bader  <miles@gnu.org>
+
+	Changes from merging the funvec patch:
+	
+	* eval.c (Feval, Ffuncall): Don't special-case vectors.
+	(funcall_lambda): Use FUNVEC_SIZE.
+	(Fcurry): Remove function.
+
+	Merge funvec patch.
+
+2004-04-10  Miles Bader  <miles@gnu.org>
+
+	* eval.c (Fspecialp): New function.
+	(syms_of_eval): Initialize it.
+
+2004-04-03  Miles Bader  <miles@gnu.org>
+
+	* eval.c (Feval): If a variable isn't bound lexically, fall back
+	to looking it up dynamically even if it isn't declared special.
+
+2002-08-26  Miles Bader  <miles@gnu.org>
+
+	* bytecode.c (Fbyte_code): Fsub1 can GC, so protect it.
+
+2002-06-12  Miles Bader  <miles@gnu.org>
+
+	Lexical binding changes to the byte-code interpreter:
+
+	* bytecode.c (Bstack_ref, Bstack_set, Bstack_set2, Bvec_ref, Bvec_set)
+	(BdiscardN): New constants. 
+	(exec_byte_code): Renamed from `Fbyte_code'.
+	Implement above new bytecodes.
+	Add ARGS-TEMPLATE, NARGS and ARGS parameters, and optionally use
+	them push initial args on the stack.
+	(Fbyte_code): New function, just call `exec_byte_code'.
+	Add additional optional arguments for `exec_byte_code'.
+	(Qand_optional, Qand_rest): New extern declarations.
+	* eval.c (Fcurry, Ffunctionp): New functions.
+	(syms_of_eval): Initialize them.
+	(funcall_lambda): Call `exec_byte_code' instead of Fbyte_code.
+	If a compiled-function object has a `push-args' slot, call the
+	byte-code interpreter without binding any arguments.
+	(Ffuncall): Add support for curried functions.
+	* lisp.h (Fbyte_code): Declare max-args as MANY.
+	(exec_byte_code): New declaration.
+
+	Lexical binding changes to the lisp interpreter:
+
+	* lisp.h (struct Lisp_Symbol): Add `declared_special' field.
+	(apply_lambda): Add new 3rd arg to decl.
+	* alloc.c (Fmake_symbol): Initialize `declared_special' field.
+	* eval.c (Vinterpreter_lexical_environment): New variable.
+	(syms_of_eval): Initialize it.
+	(Fsetq): Modify SYM's lexical binding if appropriate.
+	(Ffunction): Return a closure if within a lexical environment.
+	(Flet, FletX): Lexically bind non-defvar'd variables if inside a
+	lexical environment.
+	(Feval): Return lexical binding of variables, if they have one.
+	Pass current lexical environment to embedded lambdas.  Handle closures.
+	(Ffuncall): Pass nil lexical environment to lambdas.  Handle closures.
+	(funcall_lambda): Add new LEXENV argument, and lexically bind
+	arguments if it's non-nil.  Bind `interpreter-lexenv' if it changed.
+	(apply_lambda): Add new LEXENV argument and pass it to funcall_lambda.
+	(Fdefvaralias, Fdefvar, Fdefconst): Mark the variable as special.
+	(Qinternal_interpreter_environment, Qclosure): New constants.
+	(syms_of_eval): Initialize them.
+	(Fdefun, Fdefmacro): Use a closure if lexical binding is active.
+	* lread.c (defvar_bool, defvar_lisp_nopro, defvar_per_buffer) 
+	(defvar_kboard, defvar_int): Mark the variable as special.
+	(Vlexical_binding, Qlexical_binding): New variables.
+	(syms_of_lread): Initialize them.
+	(Fload): Bind `lexically-bound' to nil unless specified otherwise
+	in the file header.
+	(lisp_file_lexically_bound_p): New function.
+	(Qinternal_interpreter_environment): New variable.
+	* doc.c (Qclosure): New extern declaration.
+	(Fdocumentation, store_function_docstring): Handle interpreted
+	closures.
+
+;; arch-tag: 7cf884aa-6b48-40cb-bfca-265a1e99b3c5
diff --git a/src/alloc.c b/src/alloc.c
index e0f07cc5f5a..a23c688043c 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3042,6 +3042,39 @@ See also the function `vector'.  */)
 }
 
 
+/* Return a new `function vector' containing KIND as the first element,
+   followed by NUM_NIL_SLOTS nil elements, and further elements copied from
+   the vector PARAMS of length NUM_PARAMS (so the total length of the
+   resulting vector is 1 + NUM_NIL_SLOTS + NUM_PARAMS).
+
+   If NUM_PARAMS is zero, then PARAMS may be NULL.
+
+   A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp.
+   See the function `funvec' for more detail.  */
+
+Lisp_Object
+make_funvec (kind, num_nil_slots, num_params, params)
+     Lisp_Object kind;
+     int num_nil_slots, num_params;
+     Lisp_Object *params;
+{
+  int param_index;
+  Lisp_Object funvec;
+
+  funvec = Fmake_vector (make_number (1 + num_nil_slots + num_params), Qnil);
+
+  ASET (funvec, 0, kind);
+
+  for (param_index = 0; param_index < num_params; param_index++)
+    ASET (funvec, 1 + num_nil_slots + param_index, params[param_index]);
+
+  XSETPVECTYPE (XVECTOR (funvec), PVEC_FUNVEC);
+  XSETFUNVEC (funvec, XVECTOR (funvec));
+
+  return funvec;
+}
+
+
 DEFUN ("vector", Fvector, Svector, 0, MANY, 0,
        doc: /* Return a newly created vector with specified arguments as elements.
 Any number of arguments, even zero arguments, are allowed.
@@ -3063,6 +3096,29 @@ usage: (vector &rest OBJECTS)  */)
 }
 
 
+DEFUN ("funvec", Ffunvec, Sfunvec, 1, MANY, 0,
+       doc: /* Return a newly created `function vector' of type KIND.
+A `function vector', a.k.a. `funvec', is a funcallable vector in Emacs Lisp.
+KIND indicates the kind of funvec, and determines its behavior when called.
+The meaning of the remaining arguments depends on KIND.  Currently
+implemented values of KIND, and their meaning, are:
+
+   A list  -- A byte-compiled function.  See `make-byte-code' for the usual
+              way to create byte-compiled functions.
+
+   `curry' -- A curried function.  Remaining arguments are a function to
+              call, and arguments to prepend to user arguments at the
+              time of the call; see the `curry' function.
+
+usage: (funvec KIND &rest PARAMS)  */)
+     (nargs, args)
+     register int nargs;
+     Lisp_Object *args;
+{
+  return make_funvec (args[0], 0, nargs - 1, args + 1);
+}
+
+
 DEFUN ("make-byte-code", Fmake_byte_code, Smake_byte_code, 4, MANY, 0,
        doc: /* Create a byte-code object with specified arguments as elements.
 The arguments should be the arglist, bytecode-string, constant vector,
@@ -3078,6 +3134,10 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
   register int index;
   register struct Lisp_Vector *p;
 
+  /* Make sure the arg-list is really a list, as that's what's used to
+     distinguish a byte-compiled object from other funvecs.  */
+  CHECK_LIST (args[0]);
+
   XSETFASTINT (len, nargs);
   if (!NILP (Vpurify_flag))
     val = make_pure_vector ((EMACS_INT) nargs);
@@ -3099,8 +3159,8 @@ usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INT
 	args[index] = Fpurecopy (args[index]);
       p->contents[index] = args[index];
     }
-  XSETPVECTYPE (p, PVEC_COMPILED);
-  XSETCOMPILED (val, p);
+  XSETPVECTYPE (p, PVEC_FUNVEC);
+  XSETFUNVEC (val, p);
   return val;
 }
 
@@ -3199,6 +3259,7 @@ Its value and function definition are void, and its property list is nil.  */)
   p->gcmarkbit = 0;
   p->interned = SYMBOL_UNINTERNED;
   p->constant = 0;
+  p->declared_special = 0;
   consing_since_gc += sizeof (struct Lisp_Symbol);
   symbols_consed++;
   return val;
@@ -4907,7 +4968,7 @@ Does not copy symbols.  Copies strings without text properties.  */)
     obj = make_pure_string (SDATA (obj), SCHARS (obj),
 			    SBYTES (obj),
 			    STRING_MULTIBYTE (obj));
-  else if (COMPILEDP (obj) || VECTORP (obj))
+  else if (FUNVECP (obj) || VECTORP (obj))
     {
       register struct Lisp_Vector *vec;
       register int i;
@@ -4919,10 +4980,10 @@ Does not copy symbols.  Copies strings without text properties.  */)
       vec = XVECTOR (make_pure_vector (size));
       for (i = 0; i < size; i++)
 	vec->contents[i] = Fpurecopy (XVECTOR (obj)->contents[i]);
-      if (COMPILEDP (obj))
+      if (FUNVECP (obj))
 	{
-	  XSETPVECTYPE (vec, PVEC_COMPILED);
-	  XSETCOMPILED (obj, vec);
+	  XSETPVECTYPE (vec, PVEC_FUNVEC);
+	  XSETFUNVEC (obj, vec);
 	}
       else
 	XSETVECTOR (obj, vec);
@@ -5512,7 +5573,7 @@ mark_object (arg)
 	}
       else if (SUBRP (obj))
 	break;
-      else if (COMPILEDP (obj))
+      else if (FUNVECP (obj) && FUNVEC_COMPILED_P (obj))
 	/* We could treat this just like a vector, but it is better to
 	   save the COMPILED_CONSTANTS element for last and avoid
 	   recursion there.  */
@@ -6423,6 +6484,7 @@ The time is in seconds as a floating point value.  */);
   defsubr (&Scons);
   defsubr (&Slist);
   defsubr (&Svector);
+  defsubr (&Sfunvec);
   defsubr (&Smake_byte_code);
   defsubr (&Smake_list);
   defsubr (&Smake_vector);
diff --git a/src/buffer.c b/src/buffer.c
index 589266f40e5..e907c295e8d 100644
--- a/src/buffer.c
+++ b/src/buffer.c
@@ -5418,6 +5418,7 @@ defvar_per_buffer (bo_fwd, namestring, address, type, doc)
   bo_fwd->type = Lisp_Fwd_Buffer_Obj;
   bo_fwd->offset = offset;
   bo_fwd->slottype = type;
+  sym->declared_special = 1;
   sym->redirect = SYMBOL_FORWARDED;
   {
     /* I tried to do the job without a cast, but it seems impossible.
diff --git a/src/bytecode.c b/src/bytecode.c
index c53c5acdbb3..fec855c0b83 100644
--- a/src/bytecode.c
+++ b/src/bytecode.c
@@ -87,9 +87,11 @@ int byte_metering_on;
 
 
 Lisp_Object Qbytecode;
+extern Lisp_Object Qand_optional, Qand_rest;
 
 /*  Byte codes: */
 
+#define Bstack_ref 0
 #define Bvarref 010
 #define Bvarset 020
 #define Bvarbind 030
@@ -229,6 +231,13 @@ Lisp_Object Qbytecode;
 #define BconcatN 0260
 #define BinsertN 0261
 
+/* Bstack_ref is code 0.  */
+#define Bstack_set  0262
+#define Bstack_set2 0263
+#define Bvec_ref    0264
+#define Bvec_set    0265
+#define BdiscardN   0266
+
 #define Bconstant 0300
 #define CONSTANTLIM 0100
 
@@ -397,14 +406,41 @@ unmark_byte_stack ()
   } while (0)
 
 
-DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 0,
+DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, MANY, 0,
        doc: /* Function used internally in byte-compiled code.
 The first argument, BYTESTR, is a string of byte code;
 the second, VECTOR, a vector of constants;
 the third, MAXDEPTH, the maximum stack depth used in this function.
-If the third argument is incorrect, Emacs may crash.  */)
-     (bytestr, vector, maxdepth)
-     Lisp_Object bytestr, vector, maxdepth;
+If the third argument is incorrect, Emacs may crash.
+
+If ARGS-TEMPLATE is specified, it is an argument list specification,
+according to which any remaining arguments are pushed on the stack
+before executing BYTESTR.
+
+usage: (byte-code BYTESTR VECTOR MAXDEP &optional ARGS-TEMPLATE &rest ARGS) */)
+     (nargs, args)
+     int nargs;
+     Lisp_Object *args;
+{
+  Lisp_Object args_tmpl = nargs >= 4 ? args[3] : Qnil;
+  int pnargs = nargs >= 4 ? nargs - 4 : 0;
+  Lisp_Object *pargs = nargs >= 4 ? args + 4 : 0;
+  return exec_byte_code (args[0], args[1], args[2], args_tmpl, pnargs, pargs);
+}
+
+/* Execute the byte-code in BYTESTR.  VECTOR is the constant vector, and
+   MAXDEPTH is the maximum stack depth used (if MAXDEPTH is incorrect,
+   emacs may crash!).  If ARGS_TEMPLATE is non-nil, it should be a lisp
+   argument list (including &rest, &optional, etc.), and ARGS, of size
+   NARGS, should be a vector of the actual arguments.  The arguments in
+   ARGS are pushed on the stack according to ARGS_TEMPLATE before
+   executing BYTESTR.  */
+
+Lisp_Object
+exec_byte_code (bytestr, vector, maxdepth, args_template, nargs, args)
+     Lisp_Object bytestr, vector, maxdepth, args_template;
+     int nargs;
+     Lisp_Object *args;
 {
   int count = SPECPDL_INDEX ();
 #ifdef BYTE_CODE_METER
@@ -462,6 +498,37 @@ If the third argument is incorrect, Emacs may crash.  */)
   stacke = stack.bottom - 1 + XFASTINT (maxdepth);
 #endif
 
+  if (! NILP (args_template))
+    /* We should push some arguments on the stack.  */
+    {
+      Lisp_Object at;
+      int pushed = 0, optional = 0;
+
+      for (at = args_template; CONSP (at); at = XCDR (at))
+	if (EQ (XCAR (at), Qand_optional))
+	  optional = 1;
+	else if (EQ (XCAR (at), Qand_rest))
+	  {
+	    PUSH (Flist (nargs, args));
+	    pushed = nargs;
+	    at = Qnil;
+	    break;
+	  }
+	else if (pushed < nargs)
+	  {
+	    PUSH (*args++);
+	    pushed++;
+	  }
+	else if (optional)
+	  PUSH (Qnil);
+	else
+	  break;
+
+      if (pushed != nargs || !NILP (at))
+	Fsignal (Qwrong_number_of_arguments,
+		 Fcons (args_template, Fcons (make_number (nargs), Qnil)));
+    }
+
   while (1)
     {
 #ifdef BYTE_CODE_SAFE
@@ -1641,8 +1708,57 @@ If the third argument is incorrect, Emacs may crash.  */)
 	  break;
 #endif
 
-	case 0:
-	  abort ();
+	  /* Handy byte-codes for lexical binding.  */
+	case Bstack_ref:
+	case Bstack_ref+1:
+	case Bstack_ref+2:
+	case Bstack_ref+3:
+	case Bstack_ref+4:
+	case Bstack_ref+5:
+	  PUSH (stack.bottom[op - Bstack_ref]);
+	  break;
+	case Bstack_ref+6:
+	  PUSH (stack.bottom[FETCH]);
+	  break;
+	case Bstack_ref+7:
+	  PUSH (stack.bottom[FETCH2]);
+	  break;
+	case Bstack_set:
+	  stack.bottom[FETCH] = POP;
+	  break;
+	case Bstack_set2:
+	  stack.bottom[FETCH2] = POP;
+	  break;
+	case Bvec_ref:
+	case Bvec_set:
+	  /* These byte-codes used mostly for variable references to
+	     lexically bound variables that are in an environment vector
+	     instead of on the byte-interpreter stack (generally those
+	     variables which might be shared with a closure).  */
+	  {
+	    int index = FETCH;
+	    Lisp_Object vec = POP;
+
+	    if (! VECTORP (vec))
+	      wrong_type_argument (Qvectorp, vec);
+	    else if (index < 0 || index >= XVECTOR (vec)->size)
+	      args_out_of_range (vec, index);
+
+	    if (op == Bvec_ref)
+	      PUSH (XVECTOR (vec)->contents[index]);
+	    else
+	      XVECTOR (vec)->contents[index] = POP;
+	  }
+	  break;
+	case BdiscardN:
+	  op = FETCH;
+	  if (op & 0x80)
+	    {
+	      op &= 0x7F;
+	      top[-op] = TOP;
+	    }
+	  DISCARD (op);
+	  break;
 
 	case 255:
 	default:
diff --git a/src/data.c b/src/data.c
index 93cc57e9f2c..6a21ad44720 100644
--- a/src/data.c
+++ b/src/data.c
@@ -84,7 +84,7 @@ Lisp_Object Qinteger;
 static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay;
 static Lisp_Object Qfloat, Qwindow_configuration, Qwindow;
 Lisp_Object Qprocess;
-static Lisp_Object Qcompiled_function, Qbuffer, Qframe, Qvector;
+static Lisp_Object Qcompiled_function, Qfunction_vector, Qbuffer, Qframe, Qvector;
 static Lisp_Object Qchar_table, Qbool_vector, Qhash_table;
 static Lisp_Object Qsubrp, Qmany, Qunevalled;
 Lisp_Object Qfont_spec, Qfont_entity, Qfont_object;
@@ -219,8 +219,11 @@ for example, (type-of 1) returns `integer'.  */)
 	return Qwindow;
       if (SUBRP (object))
 	return Qsubr;
-      if (COMPILEDP (object))
-	return Qcompiled_function;
+      if (FUNVECP (object))
+	if (FUNVEC_COMPILED_P (object))
+	  return Qcompiled_function;
+	else
+	  return Qfunction_vector;
       if (BUFFERP (object))
 	return Qbuffer;
       if (CHAR_TABLE_P (object))
@@ -437,6 +440,14 @@ DEFUN ("byte-code-function-p", Fbyte_code_function_p, Sbyte_code_function_p,
   return Qnil;
 }
 
+DEFUN ("funvecp", Ffunvecp, Sfunvecp, 1, 1, 0,
+       doc: /* Return t if OBJECT is a `function vector' object.  */)
+     (object)
+     Lisp_Object object;
+{
+  return FUNVECP (object) ? Qt : Qnil;
+}
+
 DEFUN ("char-or-string-p", Fchar_or_string_p, Schar_or_string_p, 1, 1, 0,
        doc: /* Return t if OBJECT is a character or a string.  */)
      (object)
@@ -2208,15 +2219,15 @@ or a byte-code object.  IDX starts at 0.  */)
     {
       int size = 0;
       if (VECTORP (array))
-	size = XVECTOR (array)->size;
-      else if (COMPILEDP (array))
-	size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK;
+	size = ASIZE (array);
+      else if (FUNVECP (array))
+	size = FUNVEC_SIZE (array);
       else
 	wrong_type_argument (Qarrayp, array);
 
       if (idxval < 0 || idxval >= size)
 	args_out_of_range (array, idx);
-      return XVECTOR (array)->contents[idxval];
+      return AREF (array, idxval);
     }
 }
 
@@ -3326,6 +3337,7 @@ syms_of_data ()
   Qwindow = intern_c_string ("window");
   /* Qsubr = intern_c_string ("subr"); */
   Qcompiled_function = intern_c_string ("compiled-function");
+  Qfunction_vector = intern_c_string ("function-vector");
   Qbuffer = intern_c_string ("buffer");
   Qframe = intern_c_string ("frame");
   Qvector = intern_c_string ("vector");
@@ -3351,6 +3363,7 @@ syms_of_data ()
   staticpro (&Qwindow);
   /* staticpro (&Qsubr); */
   staticpro (&Qcompiled_function);
+  staticpro (&Qfunction_vector);
   staticpro (&Qbuffer);
   staticpro (&Qframe);
   staticpro (&Qvector);
@@ -3387,6 +3400,7 @@ syms_of_data ()
   defsubr (&Smarkerp);
   defsubr (&Ssubrp);
   defsubr (&Sbyte_code_function_p);
+  defsubr (&Sfunvecp);
   defsubr (&Schar_or_string_p);
   defsubr (&Scar);
   defsubr (&Scdr);
diff --git a/src/doc.c b/src/doc.c
index 536d22c57a6..9133c2e6b84 100644
--- a/src/doc.c
+++ b/src/doc.c
@@ -56,7 +56,7 @@ Lisp_Object Qfunction_documentation;
 /* A list of files used to build this Emacs binary.  */
 static Lisp_Object Vbuild_files;
 
-extern Lisp_Object Voverriding_local_map;
+extern Lisp_Object Voverriding_local_map, Qclosure;
 
 extern Lisp_Object Qremap;
 
@@ -385,6 +385,11 @@ string is passed through `substitute-command-keys'.  */)
       else
 	return Qnil;
     }
+  else if (FUNVECP (fun))
+    {
+      /* Unless otherwise handled, funvecs have no documentation.  */
+      return Qnil;
+    }
   else if (STRINGP (fun) || VECTORP (fun))
     {
       return build_string ("Keyboard macro.");
@@ -412,6 +417,8 @@ string is passed through `substitute-command-keys'.  */)
 	  else
 	    return Qnil;
 	}
+      else if (EQ (funcar, Qclosure))
+ 	return Fdocumentation (Fcdr (XCDR (fun)), raw);
       else if (EQ (funcar, Qmacro))
 	return Fdocumentation (Fcdr (fun), raw);
       else
@@ -542,6 +549,8 @@ store_function_docstring (fun, offset)
 	}
       else if (EQ (tem, Qmacro))
 	store_function_docstring (XCDR (fun), offset);
+      else if (EQ (tem, Qclosure))
+	store_function_docstring (Fcdr (XCDR (fun)), offset);
     }
 
   /* Bytecode objects sometimes have slots for it.  */
diff --git a/src/eval.c b/src/eval.c
index 199c4705736..875b4498a61 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -62,6 +62,9 @@ Lisp_Object Qinhibit_quit, Vinhibit_quit, Vquit_flag;
 Lisp_Object Qand_rest, Qand_optional;
 Lisp_Object Qdebug_on_error;
 Lisp_Object Qdeclare;
+Lisp_Object Qcurry, Qunevalled;
+Lisp_Object Qinternal_interpreter_environment, Qclosure;
+
 Lisp_Object Qdebug;
 extern Lisp_Object Qinteractive_form;
 
@@ -78,6 +81,13 @@ Lisp_Object Vrun_hooks;
 
 Lisp_Object Vautoload_queue;
 
+/* When lexical binding is being used, this is non-nil, and contains an
+   alist of lexically-bound variable, or t, indicating an empty
+   environment.  The lisp name of this variable is
+   `internal-interpreter-lexical-environment'.  */
+
+Lisp_Object Vinternal_interpreter_environment;
+
 /* Current number of specbindings allocated in specpdl.  */
 
 int specpdl_size;
@@ -167,10 +177,11 @@ int handling_signal;
 Lisp_Object Vmacro_declaration_function;
 
 extern Lisp_Object Qrisky_local_variable;
-
 extern Lisp_Object Qfunction;
 
-static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object*));
+static Lisp_Object funcall_lambda P_ ((Lisp_Object, int, Lisp_Object *,
+				       Lisp_Object));
+
 static void unwind_to_catch P_ ((struct catchtag *, Lisp_Object)) NO_RETURN;
 
 #if __GNUC__
@@ -504,7 +515,7 @@ usage: (setq [SYM VAL]...)  */)
      Lisp_Object args;
 {
   register Lisp_Object args_left;
-  register Lisp_Object val, sym;
+  register Lisp_Object val, sym, lex_binding;
   struct gcpro gcpro1;
 
   if (NILP (args))
@@ -517,7 +528,15 @@ usage: (setq [SYM VAL]...)  */)
     {
       val = Feval (Fcar (Fcdr (args_left)));
       sym = Fcar (args_left);
-      Fset (sym, val);
+
+      if (!NILP (Vinternal_interpreter_environment)
+	  && SYMBOLP (sym)
+	  && !XSYMBOL (sym)->declared_special
+	  && !NILP (lex_binding = Fassq (sym, Vinternal_interpreter_environment)))
+	XSETCDR (lex_binding, val); /* SYM is lexically bound.  */
+      else
+	Fset (sym, val);	/* SYM is dynamically bound.  */
+
       args_left = Fcdr (Fcdr (args_left));
     }
   while (!NILP(args_left));
@@ -545,9 +564,20 @@ usage: (function ARG)  */)
      (args)
      Lisp_Object args;
 {
+  Lisp_Object quoted = XCAR (args);
+
   if (!NILP (Fcdr (args)))
     xsignal2 (Qwrong_number_of_arguments, Qfunction, Flength (args));
-  return Fcar (args);
+
+  if (!NILP (Vinternal_interpreter_environment)
+      && CONSP (quoted)
+      && EQ (XCAR (quoted), Qlambda))
+    /* This is a lambda expression within a lexical environment;
+       return an interpreted closure instead of a simple lambda.  */
+    return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, quoted));
+  else
+    /* Simply quote the argument.  */
+    return quoted;
 }
 
 
@@ -570,7 +600,7 @@ spec that specifies non-nil unconditionally (such as \"p\"); or (ii)
 use `called-interactively-p'.  */)
      ()
 {
-  return (INTERACTIVE && interactive_p (1)) ? Qt : Qnil;
+  return interactive_p (1) ? Qt : Qnil;
 }
 
 
@@ -666,6 +696,8 @@ usage: (defun NAME ARGLIST [DOCSTRING] BODY...)  */)
   fn_name = Fcar (args);
   CHECK_SYMBOL (fn_name);
   defn = Fcons (Qlambda, Fcdr (args));
+  if (! NILP (Vinternal_interpreter_environment))
+    defn = Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, defn));
   if (!NILP (Vpurify_flag))
     defn = Fpurecopy (defn);
   if (CONSP (XSYMBOL (fn_name)->function)
@@ -738,7 +770,11 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...)  */)
     tail = Fcons (lambda_list, tail);
   else
     tail = Fcons (lambda_list, Fcons (doc, tail));
-  defn = Fcons (Qmacro, Fcons (Qlambda, tail));
+  
+  defn = Fcons (Qlambda, tail);
+  if (! NILP (Vinternal_interpreter_environment))
+    defn = Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, defn));
+  defn = Fcons (Qmacro, defn);
 
   if (!NILP (Vpurify_flag))
     defn = Fpurecopy (defn);
@@ -799,6 +835,7 @@ The return value is BASE-VARIABLE.  */)
 	error ("Don't know how to make a let-bound variable an alias");
   }
 
+  sym->declared_special = 1;
   sym->redirect = SYMBOL_VARALIAS;
   SET_SYMBOL_ALIAS (sym, XSYMBOL (base_variable));
   sym->constant = SYMBOL_CONSTANT_P (base_variable);
@@ -889,6 +926,9 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING)  */)
        It could get in the way of other definitions, and unloading this
        package could try to make the variable unbound.  */
     ;
+    
+  if (SYMBOLP (sym))
+    XSYMBOL (sym)->declared_special = 1;
 
   return sym;
 }
@@ -918,6 +958,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING])  */)
   if (!NILP (Vpurify_flag))
     tem = Fpurecopy (tem);
   Fset_default (sym, tem);
+  XSYMBOL (sym)->declared_special = 1;
   tem = Fcar (Fcdr (Fcdr (args)));
   if (!NILP (tem))
     {
@@ -1006,30 +1047,50 @@ usage: (let* VARLIST BODY...)  */)
      (args)
      Lisp_Object args;
 {
-  Lisp_Object varlist, val, elt;
+  Lisp_Object varlist, var, val, elt, lexenv;
   int count = SPECPDL_INDEX ();
   struct gcpro gcpro1, gcpro2, gcpro3;
 
   GCPRO3 (args, elt, varlist);
 
+  lexenv = Vinternal_interpreter_environment;
+
   varlist = Fcar (args);
-  while (!NILP (varlist))
+  while (CONSP (varlist))
     {
       QUIT;
-      elt = Fcar (varlist);
+
+      elt = XCAR (varlist);
       if (SYMBOLP (elt))
-	specbind (elt, Qnil);
+	{
+	  var = elt;
+	  val = Qnil;
+	}
       else if (! NILP (Fcdr (Fcdr (elt))))
 	signal_error ("`let' bindings can have only one value-form", elt);
       else
 	{
+	  var = Fcar (elt);
 	  val = Feval (Fcar (Fcdr (elt)));
-	  specbind (Fcar (elt), val);
 	}
-      varlist = Fcdr (varlist);
+
+      if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special)
+	/* Lexically bind VAR by adding it to the interpreter's binding
+	   alist.  */
+	{
+	  lexenv = Fcons (Fcons (var, val), lexenv);
+	  specbind (Qinternal_interpreter_environment, lexenv);
+	}
+      else
+	specbind (var, val);
+
+      varlist = XCDR (varlist);
     }
+
   UNGCPRO;
+
   val = Fprogn (Fcdr (args));
+
   return unbind_to (count, val);
 }
 
@@ -1043,7 +1104,7 @@ usage: (let VARLIST BODY...)  */)
      (args)
      Lisp_Object args;
 {
-  Lisp_Object *temps, tem;
+  Lisp_Object *temps, tem, lexenv;
   register Lisp_Object elt, varlist;
   int count = SPECPDL_INDEX ();
   register int argnum;
@@ -1074,18 +1135,31 @@ usage: (let VARLIST BODY...)  */)
     }
   UNGCPRO;
 
+  lexenv = Vinternal_interpreter_environment;
+
   varlist = Fcar (args);
   for (argnum = 0; CONSP (varlist); varlist = XCDR (varlist))
     {
+      Lisp_Object var;
+
       elt = XCAR (varlist);
+      var = SYMBOLP (elt) ? elt : Fcar (elt);
       tem = temps[argnum++];
-      if (SYMBOLP (elt))
-	specbind (elt, tem);
+
+      if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special)
+	/* Lexically bind VAR by adding it to the lexenv alist.  */
+	lexenv = Fcons (Fcons (var, tem), lexenv);
       else
-	specbind (Fcar (elt), tem);
+	/* Dynamically bind VAR.  */
+	specbind (var, tem);
     }
 
+  if (!EQ (lexenv, Vinternal_interpreter_environment))
+    /* Instantiate a new lexical environment.  */
+    specbind (Qinternal_interpreter_environment, lexenv);
+
   elt = Fprogn (Fcdr (args));
+
   return unbind_to (count, elt);
 }
 
@@ -2292,7 +2366,28 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
     abort ();
 
   if (SYMBOLP (form))
-    return Fsymbol_value (form);
+    {
+      /* If there's an active lexical environment, and the variable
+	 isn't declared special, look up its binding in the lexical
+	 environment.  */
+      if (!NILP (Vinternal_interpreter_environment)
+	  && !XSYMBOL (form)->declared_special)
+	{
+	  Lisp_Object lex_binding
+	    = Fassq (form, Vinternal_interpreter_environment);
+
+	  /* If we found a lexical binding for FORM, return the value.
+	     Otherwise, we just drop through and look for a dynamic
+	     binding -- the variable isn't declared special, but there's
+	     not much else we can do, and Fsymbol_value will take care
+	     of signaling an error if there is no binding at all.  */
+	  if (CONSP (lex_binding))
+	    return XCDR (lex_binding);
+	}
+      
+      return Fsymbol_value (form);
+    }
+
   if (!CONSP (form))
     return form;
 
@@ -2452,8 +2547,8 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
 	  abort ();
 	}
     }
-  if (COMPILEDP (fun))
-    val = apply_lambda (fun, original_args, 1);
+  if (FUNVECP (fun))
+    val = apply_lambda (fun, original_args, 1, Qnil);
   else
     {
       if (EQ (fun, Qunbound))
@@ -2471,7 +2566,18 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0,
       if (EQ (funcar, Qmacro))
 	val = Feval (apply1 (Fcdr (fun), original_args));
       else if (EQ (funcar, Qlambda))
-	val = apply_lambda (fun, original_args, 1);
+	val = apply_lambda (fun, original_args, 1,
+			    /* Only pass down the current lexical environment
+			       if FUN is lexically embedded in FORM.  */
+			    (CONSP (original_fun)
+			     ? Vinternal_interpreter_environment
+			     : Qnil));
+      else if (EQ (funcar, Qclosure)
+	       && CONSP (XCDR (fun))
+	       && CONSP (XCDR (XCDR (fun)))
+	       && EQ (XCAR (XCDR (XCDR (fun))), Qlambda))
+	val = apply_lambda (XCDR (XCDR (fun)), original_args, 1,
+			    XCAR (XCDR (fun)));
       else
 	xsignal1 (Qinvalid_function, original_fun);
     }
@@ -2981,6 +3087,40 @@ call7 (fn, arg1, arg2, arg3, arg4, arg5, arg6, arg7)
 
 /* The caller should GCPRO all the elements of ARGS.  */
 
+DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0,
+       doc: /* Return non-nil if OBJECT is a type of object that can be called as a function.  */)
+     (object)
+     Lisp_Object object;
+{
+  if (SYMBOLP (object) && !NILP (Ffboundp (object)))
+    {
+      object = Findirect_function (object, Qnil);
+
+      if (CONSP (object) && EQ (XCAR (object), Qautoload))
+	{
+	  /* Autoloaded symbols are functions, except if they load
+	     macros or keymaps.  */
+	  int i;
+	  for (i = 0; i < 4 && CONSP (object); i++)
+	    object = XCDR (object);
+
+	  return (CONSP (object) && !NILP (XCAR (object))) ? Qnil : Qt;
+	}
+    }
+
+  if (SUBRP (object))
+    return (XSUBR (object)->max_args != Qunevalled) ? Qt : Qnil;
+  else if (FUNVECP (object))
+    return Qt;
+  else if (CONSP (object))
+    {
+      Lisp_Object car = XCAR (object);
+      return (EQ (car, Qlambda) || EQ (car, Qclosure)) ? Qt : Qnil;
+    }
+  else
+    return Qnil;
+}
+
 DEFUN ("funcall", Ffuncall, Sfuncall, 1, MANY, 0,
        doc: /* Call first argument as a function, passing remaining arguments to it.
 Return the value that function returns.
@@ -3115,8 +3255,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
 	  abort ();
 	}
     }
-  if (COMPILEDP (fun))
-    val = funcall_lambda (fun, numargs, args + 1);
+
+  if (FUNVECP (fun))
+    val = funcall_lambda (fun, numargs, args + 1, Qnil);
   else
     {
       if (EQ (fun, Qunbound))
@@ -3127,7 +3268,13 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
       if (!SYMBOLP (funcar))
 	xsignal1 (Qinvalid_function, original_fun);
       if (EQ (funcar, Qlambda))
-	val = funcall_lambda (fun, numargs, args + 1);
+	val = funcall_lambda (fun, numargs, args + 1, Qnil);
+      else if (EQ (funcar, Qclosure)
+	       && CONSP (XCDR (fun))
+	       && CONSP (XCDR (XCDR (fun)))
+	       && EQ (XCAR (XCDR (XCDR (fun))), Qlambda))
+	val = funcall_lambda (XCDR (XCDR (fun)), numargs, args + 1,
+			      XCAR (XCDR (fun)));
       else if (EQ (funcar, Qautoload))
 	{
 	  do_autoload (fun, original_fun);
@@ -3147,9 +3294,10 @@ usage: (funcall FUNCTION &rest ARGUMENTS)  */)
 }
 
 Lisp_Object
-apply_lambda (fun, args, eval_flag)
+apply_lambda (fun, args, eval_flag, lexenv)
      Lisp_Object fun, args;
      int eval_flag;
+     Lisp_Object lexenv;
 {
   Lisp_Object args_left;
   Lisp_Object numargs;
@@ -3181,7 +3329,7 @@ apply_lambda (fun, args, eval_flag)
       backtrace_list->nargs = i;
     }
   backtrace_list->evalargs = 0;
-  tem = funcall_lambda (fun, XINT (numargs), arg_vector);
+  tem = funcall_lambda (fun, XINT (numargs), arg_vector, lexenv);
 
   /* Do the debug-on-exit now, while arg_vector still exists.  */
   if (backtrace_list->debug_on_exit)
@@ -3191,20 +3339,100 @@ apply_lambda (fun, args, eval_flag)
   return tem;
 }
 
+
+/* Call a non-bytecode funvec object FUN, on the argments in ARGS (of
+   length NARGS).  */
+
+static Lisp_Object
+funcall_funvec (fun, nargs, args)
+     Lisp_Object fun;
+     int nargs;
+     Lisp_Object *args;
+{
+  int size = FUNVEC_SIZE (fun);
+  Lisp_Object tag = (size > 0 ? AREF (fun, 0) : Qnil);
+
+  if (EQ (tag, Qcurry))
+    {
+      /* A curried function is a way to attach arguments to a another
+	 function. The first element of the vector is the identifier
+	 `curry', the second is the wrapped function, and remaining
+	 elements are the attached arguments.  */
+      int num_curried_args = size - 2;
+      /* Offset of the curried and user args in the final arglist.  Curried
+	 args are first in the new arg vector, after the function.  User
+	 args follow.  */
+      int curried_args_offs = 1;
+      int user_args_offs = curried_args_offs + num_curried_args;
+      /* The curried function and arguments.  */
+      Lisp_Object *curry_params = XVECTOR (fun)->contents + 1;
+      /* The arguments in the curry vector.  */
+      Lisp_Object *curried_args = curry_params + 1;
+      /* The number of arguments with which we'll call funcall, and the
+	 arguments themselves.  */
+      int num_funcall_args = 1 + num_curried_args + nargs;
+      Lisp_Object *funcall_args
+	= (Lisp_Object *) alloca (num_funcall_args * sizeof (Lisp_Object));
+
+      /* First comes the real function.  */
+      funcall_args[0] = curry_params[0];
+
+      /* Then the arguments in the appropriate order.  */
+      bcopy (curried_args, funcall_args + curried_args_offs,
+	     num_curried_args * sizeof (Lisp_Object));
+      bcopy (args, funcall_args + user_args_offs,
+	     nargs * sizeof (Lisp_Object));
+
+      return Ffuncall (num_funcall_args, funcall_args);
+    }
+  else
+    xsignal1 (Qinvalid_function, fun);
+}
+
+
 /* Apply a Lisp function FUN to the NARGS evaluated arguments in ARG_VECTOR
    and return the result of evaluation.
    FUN must be either a lambda-expression or a compiled-code object.  */
 
 static Lisp_Object
-funcall_lambda (fun, nargs, arg_vector)
+funcall_lambda (fun, nargs, arg_vector, lexenv)
      Lisp_Object fun;
      int nargs;
      register Lisp_Object *arg_vector;
+     Lisp_Object lexenv;
 {
   Lisp_Object val, syms_left, next;
   int count = SPECPDL_INDEX ();
   int i, optional, rest;
 
+  if (COMPILEDP (fun)
+      && FUNVEC_SIZE (fun) > COMPILED_PUSH_ARGS
+      && ! NILP (XVECTOR (fun)->contents[COMPILED_PUSH_ARGS]))
+    /* A byte-code object with a non-nil `push args' slot means we
+       shouldn't bind any arguments, instead just call the byte-code
+       interpreter directly; it will push arguments as necessary.
+
+       Byte-code objects with either a non-existant, or a nil value for
+       the `push args' slot (the default), have dynamically-bound
+       arguments, and use the argument-binding code below instead (as do
+       all interpreted functions, even lexically bound ones).  */
+    {
+      /* If we have not actually read the bytecode string
+	 and constants vector yet, fetch them from the file.  */
+      if (CONSP (AREF (fun, COMPILED_BYTECODE)))
+	Ffetch_bytecode (fun);
+      return exec_byte_code (AREF (fun, COMPILED_BYTECODE),
+			     AREF (fun, COMPILED_CONSTANTS),
+			     AREF (fun, COMPILED_STACK_DEPTH),
+			     AREF (fun, COMPILED_ARGLIST),
+			     nargs, arg_vector);
+    }
+
+  if (FUNVECP (fun) && !FUNVEC_COMPILED_P (fun))
+    /* Byte-compiled functions are handled directly below, but we
+       call other funvec types via funcall_funvec.  */
+    return funcall_funvec (fun, nargs, arg_vector);
+
   if (CONSP (fun))
     {
       syms_left = XCDR (fun);
@@ -3236,12 +3464,27 @@ funcall_lambda (fun, nargs, arg_vector)
 	  specbind (next, Flist (nargs - i, &arg_vector[i]));
 	  i = nargs;
 	}
-      else if (i < nargs)
-	specbind (next, arg_vector[i++]);
-      else if (!optional)
-	xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
       else
-	specbind (next, Qnil);
+	{
+	  Lisp_Object val;
+
+	  /* Get the argument's actual value.  */
+	  if (i < nargs)
+	    val = arg_vector[i++];
+	  else if (!optional)
+	    xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
+	  else
+	    val = Qnil;
+
+	  /* Bind the argument.  */
+	  if (!NILP (lexenv)
+	      && SYMBOLP (next) && !XSYMBOL (next)->declared_special)
+	    /* Lexically bind NEXT by adding it to the lexenv alist.  */
+	    lexenv = Fcons (Fcons (next, val), lexenv);
+	  else
+	    /* Dynamically bind NEXT.  */
+	    specbind (next, val);
+	}
     }
 
   if (!NILP (syms_left))
@@ -3249,6 +3492,10 @@ funcall_lambda (fun, nargs, arg_vector)
   else if (i < nargs)
     xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs));
 
+  if (!EQ (lexenv, Vinternal_interpreter_environment))
+    /* Instantiate a new lexical environment.  */
+    specbind (Qinternal_interpreter_environment, lexenv);
+
   if (CONSP (fun))
     val = Fprogn (XCDR (XCDR (fun)));
   else
@@ -3257,9 +3504,10 @@ funcall_lambda (fun, nargs, arg_vector)
 	 and constants vector yet, fetch them from the file.  */
       if (CONSP (AREF (fun, COMPILED_BYTECODE)))
 	Ffetch_bytecode (fun);
-      val = Fbyte_code (AREF (fun, COMPILED_BYTECODE),
-			AREF (fun, COMPILED_CONSTANTS),
-			AREF (fun, COMPILED_STACK_DEPTH));
+      val = exec_byte_code (AREF (fun, COMPILED_BYTECODE),
+			    AREF (fun, COMPILED_CONSTANTS),
+			    AREF (fun, COMPILED_STACK_DEPTH),
+			    Qnil, 0, 0);
     }
 
   return unbind_to (count, val);
@@ -3502,7 +3750,42 @@ unbind_to (count, value)
   UNGCPRO;
   return value;
 }
+
 
+
+DEFUN ("specialp", Fspecialp, Sspecialp, 1, 1, 0,
+       doc: /* Return non-nil if SYMBOL's global binding has been declared special.
+A special variable is one that will be bound dynamically, even in a
+context where binding is lexical by default.  */)
+  (symbol)
+     Lisp_Object symbol;
+{
+   CHECK_SYMBOL (symbol);
+   return XSYMBOL (symbol)->declared_special ? Qt : Qnil;
+}
+
+
+
+DEFUN ("curry", Fcurry, Scurry, 1, MANY, 0,
+       doc: /* Return FUN curried with ARGS.
+The result is a function-like object that will append any arguments it
+is called with to ARGS, and call FUN with the resulting list of arguments.
+
+For instance:
+  (funcall (curry '+ 3 4 5) 2) is the same as (funcall '+ 3 4 5 2)
+and:
+  (mapcar (curry 'concat "The ") '("a" "b" "c"))
+  => ("The a" "The b" "The c")
+
+usage: (curry FUN &rest ARGS)  */)
+     (nargs, args)
+     register int nargs;
+     Lisp_Object *args;
+{
+  return make_funvec (Qcurry, 0, nargs, args);
+}
+
+
 DEFUN ("backtrace-debug", Fbacktrace_debug, Sbacktrace_debug, 2, 2, 0,
        doc: /* Set the debug-on-exit flag of eval frame LEVEL levels down to FLAG.
 The debugger is entered when that frame exits, if the flag is non-nil.  */)
@@ -3713,6 +3996,15 @@ before making `inhibit-quit' nil.  */);
   Qand_optional = intern_c_string ("&optional");
   staticpro (&Qand_optional);
 
+  Qclosure = intern_c_string ("closure");
+  staticpro (&Qclosure);
+
+  Qcurry = intern_c_string ("curry");
+  staticpro (&Qcurry);
+
+  Qunevalled = intern_c_string ("unevalled");
+  staticpro (&Qunevalled);
+
   Qdebug = intern_c_string ("debug");
   staticpro (&Qdebug);
 
@@ -3788,6 +4080,17 @@ DECL is a list `(declare ...)' containing the declarations.
 The value the function returns is not used.  */);
   Vmacro_declaration_function = Qnil;
 
+  Qinternal_interpreter_environment
+    = intern_c_string ("internal-interpreter-environment");
+  staticpro (&Qinternal_interpreter_environment);
+  DEFVAR_LISP ("internal-interpreter-environment",
+	       &Vinternal_interpreter_environment,
+	       doc: /* If non-nil, the current lexical environment of the lisp interpreter.
+When lexical binding is not being used, this variable is nil.
+A value of `(t)' indicates an empty environment, otherwise it is an
+alist of active lexical bindings.  */);
+  Vinternal_interpreter_environment = Qnil;
+
   Vrun_hooks = intern_c_string ("run-hooks");
   staticpro (&Vrun_hooks);
 
@@ -3833,9 +4136,13 @@ The value the function returns is not used.  */);
   defsubr (&Srun_hook_with_args_until_success);
   defsubr (&Srun_hook_with_args_until_failure);
   defsubr (&Sfetch_bytecode);
+  defsubr (&Scurry);
   defsubr (&Sbacktrace_debug);
   defsubr (&Sbacktrace);
   defsubr (&Sbacktrace_frame);
+  defsubr (&Scurry);
+  defsubr (&Sspecialp);
+  defsubr (&Sfunctionp);
 }
 
 /* arch-tag: 014a07aa-33ab-4a8f-a3d2-ee8a4a9ff7fb
diff --git a/src/fns.c b/src/fns.c
index 3f984905d1e..9569c214268 100644
--- a/src/fns.c
+++ b/src/fns.c
@@ -149,8 +149,8 @@ To get the number of bytes, use `string-bytes'.  */)
     XSETFASTINT (val, MAX_CHAR);
   else if (BOOL_VECTOR_P (sequence))
     XSETFASTINT (val, XBOOL_VECTOR (sequence)->size);
-  else if (COMPILEDP (sequence))
-    XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK);
+  else if (FUNVECP (sequence))
+    XSETFASTINT (val, FUNVEC_SIZE (sequence));
   else if (CONSP (sequence))
     {
       i = 0;
@@ -535,7 +535,7 @@ concat (nargs, args, target_type, last_special)
     {
       this = args[argnum];
       if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this)
-	    || COMPILEDP (this) || BOOL_VECTOR_P (this)))
+	    || FUNVECP (this) || BOOL_VECTOR_P (this)))
 	wrong_type_argument (Qsequencep, this);
     }
 
@@ -559,7 +559,7 @@ concat (nargs, args, target_type, last_special)
 	  Lisp_Object ch;
 	  int this_len_byte;
 
-	  if (VECTORP (this))
+	  if (VECTORP (this) || FUNVECP (this))
 	    for (i = 0; i < len; i++)
 	      {
 		ch = AREF (this, i);
@@ -1383,7 +1383,9 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0,
     return Fcar (Fnthcdr (n, sequence));
 
   /* Faref signals a "not array" error, so check here.  */
-  CHECK_ARRAY (sequence, Qsequencep);
+  if (! FUNVECP (sequence))
+    CHECK_ARRAY (sequence, Qsequencep);
+
   return Faref (sequence, n);
 }
 
@@ -2199,13 +2201,14 @@ internal_equal (o1, o2, depth, props)
 	if (WINDOW_CONFIGURATIONP (o1))
 	  return compare_window_configurations (o1, o2, 0);
 
-	/* Aside from them, only true vectors, char-tables, compiled
-	   functions, and fonts (font-spec, font-entity, font-ojbect)
-	   are sensible to compare, so eliminate the others now.  */
+	/* Aside from them, only true vectors, char-tables, function vectors,
+	   and fonts (font-spec, font-entity, font-ojbect) are sensible to
+	   compare, so eliminate the others now.  */
 	if (size & PSEUDOVECTOR_FLAG)
 	  {
-	    if (!(size & (PVEC_COMPILED
-			  | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT)))
+	    if (!(size & (PVEC_FUNVEC
+			  | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE
+			  | PVEC_FONT)))
 	      return 0;
 	    size &= PSEUDOVECTOR_SIZE_MASK;
 	  }
@@ -2416,7 +2419,7 @@ mapcar1 (leni, vals, fn, seq)
     1) lists are not relocated and 2) the list is marked via `seq' so will not
     be freed */
 
-  if (VECTORP (seq))
+  if (VECTORP (seq) || FUNVECP (seq))
     {
       for (i = 0; i < leni; i++)
 	{
diff --git a/src/image.c b/src/image.c
index b9620e10948..67c228cbc7f 100644
--- a/src/image.c
+++ b/src/image.c
@@ -885,7 +885,7 @@ parse_image_spec (spec, keywords, nkeywords, type)
 	case IMAGE_FUNCTION_VALUE:
 	  value = indirect_function (value);
 	  if (SUBRP (value)
-	      || COMPILEDP (value)
+	      || FUNVECP (value)
 	      || (CONSP (value) && EQ (XCAR (value), Qlambda)))
 	    break;
 	  return 0;
diff --git a/src/keyboard.c b/src/keyboard.c
index 63372d600e3..18d75f9b01c 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -10390,7 +10390,7 @@ a special event, so ignore the prefix argument and don't clear it.  */)
       return Fexecute_kbd_macro (final, prefixarg, Qnil);
     }
 
-  if (CONSP (final) || SUBRP (final) || COMPILEDP (final))
+  if (CONSP (final) || SUBRP (final) || FUNVECP (final))
     /* Don't call Fcall_interactively directly because we want to make
        sure the backtrace has an entry for `call-interactively'.
        For the same reason, pass `cmd' rather than `final'.  */
diff --git a/src/lisp.h b/src/lisp.h
index 1941a2471a4..c7e8ea0fb8b 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -344,7 +344,7 @@ enum pvec_type
   PVEC_NORMAL_VECTOR = 0,
   PVEC_PROCESS = 0x200,
   PVEC_FRAME = 0x400,
-  PVEC_COMPILED = 0x800,
+  PVEC_FUNVEC = 0x800,
   PVEC_WINDOW = 0x1000,
   PVEC_WINDOW_CONFIGURATION = 0x2000,
   PVEC_SUBR = 0x4000,
@@ -623,7 +623,7 @@ extern size_t pure_size;
 #define XSETWINDOW(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_WINDOW))
 #define XSETTERMINAL(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_TERMINAL))
 #define XSETSUBR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_SUBR))
-#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED))
+#define XSETFUNVEC(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FUNVEC))
 #define XSETBUFFER(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BUFFER))
 #define XSETCHAR_TABLE(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_CHAR_TABLE))
 #define XSETBOOL_VECTOR(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_BOOL_VECTOR))
@@ -639,6 +639,9 @@ extern size_t pure_size;
    eassert ((IDX) >= 0 && (IDX) < ASIZE (ARRAY)),	\
    AREF ((ARRAY), (IDX)) = (VAL))
 
+/* Return the size of the psuedo-vector object FUNVEC.  */
+#define FUNVEC_SIZE(funvec)	(ASIZE (funvec) & PSEUDOVECTOR_SIZE_MASK)
+
 /* Convenience macros for dealing with Lisp strings.  */
 
 #define SDATA(string)		(XSTRING (string)->data + 0)
@@ -1020,6 +1023,10 @@ struct Lisp_Symbol
   /* Interned state of the symbol.  This is an enumerator from
      enum symbol_interned.  */
   unsigned interned : 2;
+  
+  /* Non-zero means that this variable has been explicitly declared
+     special (with `defvar' etc), and shouldn't be lexically bound.  */
+  unsigned declared_special : 1;
 
   /* The symbol's name, as a Lisp string.
 
@@ -1475,7 +1482,7 @@ struct Lisp_Float
 typedef unsigned char UCHAR;
 #endif
 
-/* Meanings of slots in a Lisp_Compiled:  */
+/* Meanings of slots in a byte-compiled function vector:  */
 
 #define COMPILED_ARGLIST 0
 #define COMPILED_BYTECODE 1
@@ -1483,6 +1490,25 @@ typedef unsigned char UCHAR;
 #define COMPILED_STACK_DEPTH 3
 #define COMPILED_DOC_STRING 4
 #define COMPILED_INTERACTIVE 5
+#define COMPILED_PUSH_ARGS 6
+
+/* Return non-zero if TAG, the first element from a funvec object, refers
+   to a byte-code object.  Byte-code objects are distinguished from other
+   `funvec' objects by having a (possibly empty) list as their first
+   element -- other funvec types use a non-nil symbol there.  */
+#define FUNVEC_COMPILED_TAG_P(tag)					      \
+  (NILP (tag) || CONSP (tag))
+
+/* Return non-zero if FUNVEC, which should be a `funvec' object, is a
+   byte-compiled function. Byte-compiled function are funvecs with the
+   arglist as the first element (other funvec types will have a symbol
+   identifying the type as the first object).  */
+#define FUNVEC_COMPILED_P(funvec)					      \
+  (FUNVEC_SIZE (funvec) > 0 && FUNVEC_COMPILED_TAG_P (AREF (funvec, 0)))
+
+/* Return non-zero if OBJ is byte-compile function.  */
+#define COMPILEDP(obj)							      \
+  (FUNVECP (obj) && FUNVEC_COMPILED_P (obj))
 
 /* Flag bits in a character.  These also get used in termhooks.h.
    Richard Stallman <rms@gnu.ai.mit.edu> thinks that MULE
@@ -1604,7 +1630,7 @@ typedef struct {
 #define WINDOWP(x) PSEUDOVECTORP (x, PVEC_WINDOW)
 #define TERMINALP(x) PSEUDOVECTORP (x, PVEC_TERMINAL)
 #define SUBRP(x) PSEUDOVECTORP (x, PVEC_SUBR)
-#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED)
+#define FUNVECP(x) PSEUDOVECTORP (x, PVEC_FUNVEC)
 #define BUFFERP(x) PSEUDOVECTORP (x, PVEC_BUFFER)
 #define CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_CHAR_TABLE)
 #define SUB_CHAR_TABLE_P(x) PSEUDOVECTORP (x, PVEC_SUB_CHAR_TABLE)
@@ -1797,7 +1823,7 @@ typedef struct {
 #define FUNCTIONP(OBJ)					\
      ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda))		\
       || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ)))	\
-      || COMPILEDP (OBJ)				\
+      || FUNVECP (OBJ)					\
       || SUBRP (OBJ))
 
 /* defsubr (Sname);
@@ -2697,6 +2723,7 @@ EXFUN (Fmake_list, 2);
 extern Lisp_Object allocate_misc P_ ((void));
 EXFUN (Fmake_vector, 2);
 EXFUN (Fvector, MANY);
+EXFUN (Ffunvec, MANY);
 EXFUN (Fmake_symbol, 1);
 EXFUN (Fmake_marker, 0);
 EXFUN (Fmake_string, 2);
@@ -2715,6 +2742,7 @@ extern Lisp_Object make_pure_c_string (const char *data);
 extern Lisp_Object pure_cons P_ ((Lisp_Object, Lisp_Object));
 extern Lisp_Object make_pure_vector P_ ((EMACS_INT));
 EXFUN (Fgarbage_collect, 0);
+extern Lisp_Object make_funvec P_ ((Lisp_Object, int, int, Lisp_Object *));
 EXFUN (Fmake_byte_code, MANY);
 EXFUN (Fmake_bool_vector, 2);
 extern Lisp_Object Qchar_table_extra_slots;
@@ -2894,7 +2922,7 @@ extern Lisp_Object call5 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object
 extern Lisp_Object call6 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object));
 extern Lisp_Object call7 P_ ((Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object));
 EXFUN (Fdo_auto_save, 2);
-extern Lisp_Object apply_lambda P_ ((Lisp_Object, Lisp_Object, int));
+extern Lisp_Object apply_lambda P_ ((Lisp_Object, Lisp_Object, int, Lisp_Object));
 extern Lisp_Object internal_catch P_ ((Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object));
 extern Lisp_Object internal_lisp_condition_case P_ ((Lisp_Object, Lisp_Object, Lisp_Object));
 extern Lisp_Object internal_condition_case P_ ((Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object)));
@@ -3312,11 +3340,13 @@ extern int read_bytecode_char P_ ((int));
 
 /* Defined in bytecode.c */
 extern Lisp_Object Qbytecode;
-EXFUN (Fbyte_code, 3);
+EXFUN (Fbyte_code, MANY);
 extern void syms_of_bytecode P_ ((void));
 extern struct byte_stack *byte_stack_list;
 extern void mark_byte_stack P_ ((void));
 extern void unmark_byte_stack P_ ((void));
+extern Lisp_Object exec_byte_code P_ ((Lisp_Object, Lisp_Object, Lisp_Object,
+				       Lisp_Object, int, Lisp_Object *));
 
 /* Defined in macros.c */
 extern Lisp_Object Qexecute_kbd_macro;
diff --git a/src/lread.c b/src/lread.c
index 3a77a62b27f..53f26faea36 100644
--- a/src/lread.c
+++ b/src/lread.c
@@ -83,6 +83,7 @@ Lisp_Object Qascii_character, Qload, Qload_file_name;
 Lisp_Object Qbackquote, Qcomma, Qcomma_at, Qcomma_dot, Qfunction;
 Lisp_Object Qinhibit_file_name_operation;
 Lisp_Object Qeval_buffer_list, Veval_buffer_list;
+Lisp_Object Qlexical_binding;
 Lisp_Object Qfile_truename, Qdo_after_load_evaluation; /* ACM 2006/5/16 */
 
 /* Used instead of Qget_file_char while loading *.elc files compiled
@@ -93,6 +94,7 @@ static Lisp_Object Qload_force_doc_strings;
 
 extern Lisp_Object Qevent_symbol_element_mask;
 extern Lisp_Object Qfile_exists_p;
+extern Lisp_Object Qinternal_interpreter_environment;
 
 /* non-zero if inside `load' */
 int load_in_progress;
@@ -157,6 +159,9 @@ Lisp_Object Vread_with_symbol_positions;
 /* List of (SYMBOL . POSITION) accumulated so far. */
 Lisp_Object Vread_symbol_positions_list;
 
+/* If non-nil `readevalloop' evaluates code in a lexical environment.  */
+Lisp_Object Vlexical_binding;
+
 /* List of descriptors now open for Fload.  */
 static Lisp_Object load_descriptor_list;
 
@@ -864,6 +869,118 @@ DEFUN ("get-file-char", Fget_file_char, Sget_file_char, 0, 0, 0,
 
 
 
+
+/* Return true if the lisp code read using READCHARFUN defines a non-nil
+   `lexical-binding' file variable.  After returning, the stream is
+   positioned following the first line, if it is a comment, otherwise
+   nothing is read.  */
+
+static int
+lisp_file_lexically_bound_p (readcharfun)
+     Lisp_Object readcharfun;
+{
+  int ch = READCHAR;
+  if (ch != ';')
+    /* The first line isn't a comment, just give up.  */
+    {
+      UNREAD (ch);
+      return 0;
+    }
+  else
+    /* Look for an appropriate file-variable in the first line.  */
+    {
+      int rv = 0;
+      enum {
+	NOMINAL, AFTER_FIRST_DASH, AFTER_ASTERIX,
+      } beg_end_state = NOMINAL;
+      int in_file_vars = 0;
+
+#define UPDATE_BEG_END_STATE(ch)					      \
+  if (beg_end_state == NOMINAL)						      \
+    beg_end_state = (ch == '-' ? AFTER_FIRST_DASH : NOMINAL);		      \
+  else if (beg_end_state == AFTER_FIRST_DASH)				      \
+    beg_end_state = (ch == '*' ? AFTER_ASTERIX : NOMINAL);		      \
+  else if (beg_end_state == AFTER_ASTERIX)				      \
+    {									      \
+      if (ch == '-')							      \
+	in_file_vars = !in_file_vars;					      \
+      beg_end_state = NOMINAL;						      \
+    }
+
+      /* Skip until we get to the file vars, if any.  */
+      do
+	{
+	  ch = READCHAR;
+	  UPDATE_BEG_END_STATE (ch);
+	}
+      while (!in_file_vars && ch != '\n' && ch != EOF);
+
+      while (in_file_vars)
+	{
+	  char var[100], *var_end, val[100], *val_end;
+
+	  ch = READCHAR;
+
+	  /* Read a variable name.  */
+	  while (ch == ' ' || ch == '\t')
+	    ch = READCHAR;
+
+	  var_end = var;
+	  while (ch != ':' && ch != '\n' && ch != EOF)
+	    {
+	      if (var_end < var + sizeof var - 1)
+		*var_end++ = ch;
+	      UPDATE_BEG_END_STATE (ch);
+	      ch = READCHAR;
+	    }
+	  
+	  while (var_end > var
+		 && (var_end[-1] == ' ' || var_end[-1] == '\t'))
+	    var_end--;
+	  *var_end = '\0';
+
+	  if (ch == ':')
+	    {
+	      /* Read a variable value.  */
+	      ch = READCHAR;
+
+	      while (ch == ' ' || ch == '\t')
+		ch = READCHAR;
+
+	      val_end = val;
+	      while (ch != ';' && ch != '\n' && ch != EOF && in_file_vars)
+		{
+		  if (val_end < val + sizeof val - 1)
+		    *val_end++ = ch;
+		  UPDATE_BEG_END_STATE (ch);
+		  ch = READCHAR;
+		}
+	      if (! in_file_vars)
+		/* The value was terminated by an end-marker, which
+		   remove.  */
+		val_end -= 3;
+	      while (val_end > val
+		     && (val_end[-1] == ' ' || val_end[-1] == '\t'))
+		val_end--;
+	      *val_end = '\0';
+
+	      if (strcmp (var, "lexical-binding") == 0)
+		/* This is it...  */
+		{
+		  rv = (strcmp (val, "nil") != 0);
+		  break;
+		}
+	    }
+	}
+
+      while (ch != '\n' && ch != EOF)
+	ch = READCHAR;
+
+      return rv;
+    }
+}
+
+
 /* Value is a version number of byte compiled code if the file
    associated with file descriptor FD is a compiled Lisp file that's
    safe to load.  Only files compiled with Emacs are safe to load.
@@ -1129,6 +1246,12 @@ Return t if the file exists and loads successfully.  */)
     Vloads_in_progress = Fcons (found, Vloads_in_progress);
   }
 
+  /* All loads are by default dynamic, unless the file itself specifies
+     otherwise using a file-variable in the first line.  This is bound here
+     so that it takes effect whether or not we use
+     Vload_source_file_function.  */
+  specbind (Qlexical_binding, Qnil);
+
   /* Get the name for load-history. */
   hist_file_name = (! NILP (Vpurify_flag)
                     ? Fconcat (2, (tmp[0] = Ffile_name_directory (file),
@@ -1253,7 +1376,13 @@ Return t if the file exists and loads successfully.  */)
   specbind (Qinhibit_file_name_operation, Qnil);
   load_descriptor_list
     = Fcons (make_number (fileno (stream)), load_descriptor_list);
+
   specbind (Qload_in_progress, Qt);
+
+  instream = stream;
+  if (lisp_file_lexically_bound_p (Qget_file_char))
+    Fset (Qlexical_binding, Qt);
+
   if (! version || version >= 22)
     readevalloop (Qget_file_char, stream, hist_file_name,
 		  Feval, 0, Qnil, Qnil, Qnil, Qnil);
@@ -1652,6 +1781,7 @@ readevalloop (readcharfun, stream, sourcename, evalfun,
   struct gcpro gcpro1, gcpro2, gcpro3, gcpro4;
   struct buffer *b = 0;
   int continue_reading_p;
+  Lisp_Object lex_bound;
   /* Nonzero if reading an entire buffer.  */
   int whole_buffer = 0;
   /* 1 on the first time around.  */
@@ -1677,6 +1807,15 @@ readevalloop (readcharfun, stream, sourcename, evalfun,
   record_unwind_protect (readevalloop_1, load_convert_to_unibyte ? Qt : Qnil);
   load_convert_to_unibyte = !NILP (unibyte);
 
+  /* If lexical binding is active (either because it was specified in
+     the file's header, or via a buffer-local variable), create an empty
+     lexical environment, otherwise, turn off lexical binding.  */
+  lex_bound = find_symbol_value (Qlexical_binding);
+  if (NILP (lex_bound) || EQ (lex_bound, Qunbound))
+    specbind (Qinternal_interpreter_environment, Qnil);
+  else
+    specbind (Qinternal_interpreter_environment, Fcons (Qt, Qnil));
+
   GCPRO4 (sourcename, readfun, start, end);
 
   /* Try to ensure sourcename is a truename, except whilst preloading. */
@@ -1837,8 +1976,11 @@ This function preserves the position of point.  */)
 
   specbind (Qeval_buffer_list, Fcons (buf, Veval_buffer_list));
   specbind (Qstandard_output, tem);
+  specbind (Qlexical_binding, Qnil);
   record_unwind_protect (save_excursion_restore, save_excursion_save ());
   BUF_TEMP_SET_PT (XBUFFER (buf), BUF_BEGV (XBUFFER (buf)));
+  if (lisp_file_lexically_bound_p (buf))
+    Fset (Qlexical_binding, Qt);
   readevalloop (buf, 0, filename, Feval,
 		!NILP (printflag), unibyte, Qnil, Qnil, Qnil);
   unbind_to (count, Qnil);
@@ -2481,14 +2623,8 @@ read1 (readcharfun, pch, first_in_list)
 	  invalid_syntax ("#&...", 5);
 	}
       if (c == '[')
-	{
-	  /* Accept compiled functions at read-time so that we don't have to
-	     build them using function calls.  */
-	  Lisp_Object tmp;
-	  tmp = read_vector (readcharfun, 1);
-	  return Fmake_byte_code (XVECTOR (tmp)->size,
-				  XVECTOR (tmp)->contents);
-	}
+	/* `function vector' objects, including byte-compiled functions.  */
+	return read_vector (readcharfun, 1);
       if (c == '(')
 	{
 	  Lisp_Object tmp;
@@ -3300,9 +3436,9 @@ isfloat_string (cp, ignore_trailing)
 
 
 static Lisp_Object
-read_vector (readcharfun, bytecodeflag)
+read_vector (readcharfun, read_funvec)
      Lisp_Object readcharfun;
-     int bytecodeflag;
+     int read_funvec;
 {
   register int i;
   register int size;
@@ -3310,6 +3446,11 @@ read_vector (readcharfun, bytecodeflag)
   register Lisp_Object tem, item, vector;
   register struct Lisp_Cons *otem;
   Lisp_Object len;
+  /* If we're reading a funvec object we start out assuming it's also a
+     byte-code object (a subset of funvecs), so we can do any special
+     processing needed.  If it's just an ordinary funvec object, we'll
+     realize that as soon as we've read the first element.  */
+  int read_bytecode = read_funvec;
 
   tem = read_list (1, readcharfun);
   len = Flength (tem);
@@ -3320,11 +3461,19 @@ read_vector (readcharfun, bytecodeflag)
   for (i = 0; i < size; i++)
     {
       item = Fcar (tem);
+
+      /* If READ_BYTECODE is set, check whether this is really a byte-code
+	 object, or just an ordinary `funvec' object -- non-byte-code
+	 funvec objects use the same reader syntax.  We can tell from the
+	 first element which one it is.  */
+      if (read_bytecode && i == 0 && ! FUNVEC_COMPILED_TAG_P (item))
+	read_bytecode = 0;	/* Nope. */
+
       /* If `load-force-doc-strings' is t when reading a lazily-loaded
 	 bytecode object, the docstring containing the bytecode and
 	 constants values must be treated as unibyte and passed to
 	 Fread, to get the actual bytecode string and constants vector.  */
-      if (bytecodeflag && load_force_doc_strings)
+      if (read_bytecode && load_force_doc_strings)
 	{
 	  if (i == COMPILED_BYTECODE)
 	    {
@@ -3377,6 +3526,14 @@ read_vector (readcharfun, bytecodeflag)
       tem = Fcdr (tem);
       free_cons (otem);
     }
+
+  if (read_bytecode && size >= 4)
+    /* Convert this vector to a bytecode object.  */
+    vector = Fmake_byte_code (size, XVECTOR (vector)->contents);
+  else if (read_funvec && size >= 1)
+    /* Convert this vector to an ordinary funvec object.  */
+    XSETFUNVEC (vector, XVECTOR (vector));
+
   return vector;
 }
 
@@ -3979,6 +4136,7 @@ defvar_int (struct Lisp_Intfwd *i_fwd,
   sym = intern_c_string (namestring);
   i_fwd->type = Lisp_Fwd_Int;
   i_fwd->intvar = address;
+  XSYMBOL (sym)->declared_special = 1;
   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)i_fwd);
 }
@@ -3993,6 +4151,7 @@ defvar_bool (struct Lisp_Boolfwd *b_fwd,
   sym = intern_c_string (namestring);
   b_fwd->type = Lisp_Fwd_Bool;
   b_fwd->boolvar = address;
+  XSYMBOL (sym)->declared_special = 1;
   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)b_fwd);
   Vbyte_boolean_vars = Fcons (sym, Vbyte_boolean_vars);
@@ -4011,6 +4170,7 @@ defvar_lisp_nopro (struct Lisp_Objfwd *o_fwd,
   sym = intern_c_string (namestring);
   o_fwd->type = Lisp_Fwd_Obj;
   o_fwd->objvar = address;
+  XSYMBOL (sym)->declared_special = 1;
   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)o_fwd);
 }
@@ -4023,6 +4183,7 @@ defvar_lisp (struct Lisp_Objfwd *o_fwd,
   staticpro (address);
 }
 
+
 /* Similar but define a variable whose value is the Lisp Object stored
    at a particular offset in the current kboard object.  */
 
@@ -4034,6 +4195,7 @@ defvar_kboard (struct Lisp_Kboard_Objfwd *ko_fwd,
   sym = intern_c_string (namestring);
   ko_fwd->type = Lisp_Fwd_Kboard_Obj;
   ko_fwd->offset = offset;
+  XSYMBOL (sym)->declared_special = 1;
   XSYMBOL (sym)->redirect = SYMBOL_FORWARDED;
   SET_SYMBOL_FWD (XSYMBOL (sym), (union Lisp_Fwd *)ko_fwd);
 }
@@ -4463,6 +4625,16 @@ to load.  See also `load-dangerous-libraries'.  */);
   Vbytecomp_version_regexp
     = make_pure_c_string ("^;;;.\\(in Emacs version\\|bytecomp version FSF\\)");
 
+  Qlexical_binding = intern ("lexical-binding");
+  staticpro (&Qlexical_binding);
+  DEFVAR_LISP ("lexical-binding", &Vlexical_binding,
+	       doc: /* If non-nil, use lexical binding when evaluating code.
+This only applies to code evaluated by `eval-buffer' and `eval-region'.
+This variable is automatically set from the file variables of an interpreted
+  lisp file read using `load'.
+This variable automatically becomes buffer-local when set.  */);
+  Fmake_variable_buffer_local (Qlexical_binding);
+
   DEFVAR_LISP ("eval-buffer-list", &Veval_buffer_list,
 	       doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'.  */);
   Veval_buffer_list = Qnil;
diff --git a/src/print.c b/src/print.c
index 6d403e00fe0..fb298233666 100644
--- a/src/print.c
+++ b/src/print.c
@@ -1340,7 +1340,7 @@ print_preprocess (obj)
 
  loop:
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
-      || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
+      || FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
       || HASH_TABLE_P (obj)
       || (! NILP (Vprint_gensym)
 	  && SYMBOLP (obj)
@@ -1543,7 +1543,7 @@ print_object (obj, printcharfun, escapeflag)
 
   /* Detect circularities and truncate them.  */
   if (STRINGP (obj) || CONSP (obj) || VECTORP (obj)
-      || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
+      || FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj)
       || HASH_TABLE_P (obj)
       || (! NILP (Vprint_gensym)
 	  && SYMBOLP (obj)
@@ -2175,7 +2175,7 @@ print_object (obj, printcharfun, escapeflag)
       else
 	{
 	  EMACS_INT size = XVECTOR (obj)->size;
-	  if (COMPILEDP (obj))
+	  if (FUNVECP (obj))
 	    {
 	      PRINTCHAR ('#');
 	      size &= PSEUDOVECTOR_SIZE_MASK;