From b9598260f96ddc652cd82ab64bbe922ccfc48a29 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 13 Jun 2010 16:36:17 -0400 Subject: [PATCH 01/45] 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. --- doc/lispref/elisp.texi | 7 +- doc/lispref/functions.texi | 72 ++- doc/lispref/objects.texi | 61 ++- doc/lispref/vol1.texi | 2 +- doc/lispref/vol2.texi | 2 +- etc/NEWS.lexbind | 55 ++ lisp/ChangeLog.funvec | 10 + lisp/ChangeLog.lexbind | 256 +++++++++ lisp/Makefile.in | 9 +- lisp/emacs-lisp/byte-lexbind.el | 696 +++++++++++++++++++++++++ lisp/emacs-lisp/byte-opt.el | 263 ++++++++-- lisp/emacs-lisp/bytecomp.el | 884 +++++++++++++++++++++++--------- lisp/emacs-lisp/disass.el | 15 +- lisp/emacs-lisp/lisp-mode.el | 10 +- lisp/help-fns.el | 65 ++- lisp/subr.el | 6 + src/ChangeLog.funvec | 37 ++ src/ChangeLog.lexbind | 104 ++++ src/alloc.c | 76 ++- src/buffer.c | 1 + src/bytecode.c | 128 ++++- src/data.c | 28 +- src/doc.c | 11 +- src/eval.c | 377 ++++++++++++-- src/fns.c | 25 +- src/image.c | 2 +- src/keyboard.c | 2 +- src/lisp.h | 44 +- src/lread.c | 194 ++++++- src/print.c | 6 +- 30 files changed, 3032 insertions(+), 416 deletions(-) create mode 100644 etc/NEWS.lexbind create mode 100644 lisp/ChangeLog.funvec create mode 100644 lisp/ChangeLog.lexbind create mode 100644 lisp/emacs-lisp/byte-lexbind.el create mode 100644 src/ChangeLog.funvec create mode 100644 src/ChangeLog.lexbind 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 + + * 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 + + * Makefile.in (COMPILE_FIRST_STACK_DEPTH): New variable. + (compile, compile-always): Use it. + +2005-10-24 Miles Bader + + * 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 + + 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 + + * 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 + + * 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 + + * emacs-lisp/byte-lexbind.el (byte-compile-compute-lforminfo): + Look at variable's global specialp state too. + +2004-04-09 Miles Bader + + * 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 + + * emacs-lisp/lisp-mode.el (eval-last-sexp-1): Setup the lexical + environment if lexical-binding is enabled. + +2003-10-14 Miles Bader + + * emacs-lisp/macroexp.el (macroexpand-all-1): Special-case + `backquote-list*' to avoid stack overflows. + +2003-04-04 Miles Bader + + * help-fns.el (help-function-arglist): Handle interpreted closures. + +2002-11-20 Miles Bader + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + * 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 + + 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 + + * 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 +;; 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" lap0) (setq lap (delq lap0 (delq lap1 lap)))) - ((= tmp 0) + ((= stack-adjust 0) (byte-compile-log-lap " %s discard\t-->\t 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: ;; (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 #" 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 + + * 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 + + * eval.c (Ffunctionp): Return nil for special forms. + (Qunevalled): New variable. + (syms_of_eval): Initialize it. + +2007-10-18 Miles Bader + + * eval.c (FletX): Test the type of VARLIST rather than just !NILP. + (Flet): Use XCAR instead of Fcar. + +2007-10-16 Miles Bader + + * alloc.c (make_funvec, Fpurecopy): Set the pseudo-vector type. + +2006-02-10 Miles Bader + + * eval.c (Ffunctionp): Supply new 2nd arg to Findirect_function. + +2005-03-04 Miles Bader + + * eval.c (FletX): Update Vinterpreter_lexical_environment for each + variable we bind, instead of all at once like `let'. + +2004-08-09 Miles Bader + + 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 + + * eval.c (Fspecialp): New function. + (syms_of_eval): Initialize it. + +2004-04-03 Miles Bader + + * 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 + + * bytecode.c (Fbyte_code): Fsub1 can GC, so protect it. + +2002-06-12 Miles Bader + + 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 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; @@ -863,6 +868,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 @@ -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; From f43cb6490878cb8f1dcb7e45044bc635f54d5951 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 13 Jun 2010 23:27:16 -0400 Subject: [PATCH 02/45] * lisp/Makefile.in (.el.elc): Increase max-lisp-eval-depth. * lisp/emacs-lisp/bytecomp.el (byte-compile-check-variable): Update byte-compile-not-obsolete-var to byte-compile-not-obsolete-vars. --- lisp/ChangeLog | 7 +++++++ lisp/Makefile.in | 7 +++++-- lisp/emacs-lisp/bytecomp.el | 2 +- 3 files changed, 13 insertions(+), 3 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c33ed04e0c2..af456bd5d2e 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2010-06-14 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-check-variable): + Update byte-compile-not-obsolete-var to byte-compile-not-obsolete-vars. + + * Makefile.in (.el.elc): Increase max-lisp-eval-depth. + 2010-06-12 Chong Yidong * term/common-win.el (x-colors): Add all the color names defined diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 25f7b89c9db..e6f2a66ec8e 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -202,7 +202,9 @@ 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.el -f byte-compile-refresh-preloaded $(BIG_STACK_OPTS) $(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 @@ -217,7 +219,8 @@ compile-onefile: # cannot have prerequisites. .el.elc: @echo Compiling $< - @$(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $< + @$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ + -f batch-byte-compile $< .PHONY: compile-first compile-main compile compile-always diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c80bcd49b82..490d928c5a0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3038,7 +3038,7 @@ If BINDING is non-nil, VAR is being bound." (if (symbolp var) "constant" "nonvariable") (prin1-to-string var)))) ((and (get var 'byte-obsolete-variable) - (not (eq var byte-compile-not-obsolete-var))) + (not (memq var byte-compile-not-obsolete-vars))) (byte-compile-warn-obsolete var)))) (defsubst byte-compile-dynamic-variable-op (base-op var) From 3c3ddb9833996729545bb4909bea359e5dbaa02e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 14 Jun 2010 22:51:25 -0400 Subject: [PATCH 03/45] * lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Don't macroexpand before evaluating in eval-and-compile, in case `body's macro expansion uses macros and functions defined in itself. * src/bytecode.c (exec_byte_code): * src/eval.c (Ffunctionp): Fix up int/Lisp_Object confusions. --- lisp/ChangeLog | 6 ++++++ lisp/emacs-lisp/bytecomp.el | 5 +---- src/ChangeLog | 5 +++++ src/bytecode.c | 2 +- src/eval.c | 7 ++----- 5 files changed, 15 insertions(+), 10 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index af456bd5d2e..856d4ea3898 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,9 @@ +2010-06-15 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): + Don't macroexpand before evaluating in eval-and-compile, in case + `body's macro expansion uses macros and functions defined in itself. + 2010-06-14 Stefan Monnier * emacs-lisp/bytecomp.el (byte-compile-check-variable): diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 490d928c5a0..df93528683c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -479,10 +479,7 @@ This list lives partly on the stack.") (cons 'progn body) byte-compile-initial-macro-environment)))))) (eval-and-compile . (lambda (&rest body) - (byte-compile-eval-before-compile - (macroexpand-all - (cons 'progn body) - byte-compile-initial-macro-environment)) + (byte-compile-eval-before-compile (cons 'progn body)) (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 diff --git a/src/ChangeLog b/src/ChangeLog index 3e6c8f24398..017b3eb2553 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2010-06-15 Stefan Monnier + + * bytecode.c (exec_byte_code): + * eval.c (Ffunctionp): Fix up int/Lisp_Object confusions. + 2010-06-12 Eli Zaretskii * makefile.w32-in ($(BLD)/bidi.$(O)): Depend on biditype.h and diff --git a/src/bytecode.c b/src/bytecode.c index fec855c0b83..192d397c45f 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -1742,7 +1742,7 @@ exec_byte_code (bytestr, vector, maxdepth, args_template, nargs, args) if (! VECTORP (vec)) wrong_type_argument (Qvectorp, vec); else if (index < 0 || index >= XVECTOR (vec)->size) - args_out_of_range (vec, index); + args_out_of_range (vec, make_number (index)); if (op == Bvec_ref) PUSH (XVECTOR (vec)->contents[index]); diff --git a/src/eval.c b/src/eval.c index 875b4498a61..71a0b111849 100644 --- a/src/eval.c +++ b/src/eval.c @@ -62,7 +62,7 @@ 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 Qcurry; Lisp_Object Qinternal_interpreter_environment, Qclosure; Lisp_Object Qdebug; @@ -3109,7 +3109,7 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, } if (SUBRP (object)) - return (XSUBR (object)->max_args != Qunevalled) ? Qt : Qnil; + return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil; else if (FUNVECP (object)) return Qt; else if (CONSP (object)) @@ -4002,9 +4002,6 @@ before making `inhibit-quit' nil. */); Qcurry = intern_c_string ("curry"); staticpro (&Qcurry); - Qunevalled = intern_c_string ("unevalled"); - staticpro (&Qunevalled); - Qdebug = intern_c_string ("debug"); staticpro (&Qdebug); From 4a330052b4815cf833071aae5cb312f6f0f63613 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 18 Jun 2010 09:11:47 -0400 Subject: [PATCH 04/45] * src/eval.c (Fspecial_variable_p): Rename from `specialp'. * lisp/emacs-lisp/byte-lexbind.el (byte-compile-compute-lforminfo): specialp -> special-variable-p. --- lisp/ChangeLog | 5 +++++ lisp/emacs-lisp/byte-lexbind.el | 8 ++++---- src/ChangeLog | 4 ++++ src/eval.c | 4 ++-- 4 files changed, 15 insertions(+), 6 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 856d4ea3898..f5b18ef6bec 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2010-06-18 Stefan Monnier + + * emacs-lisp/byte-lexbind.el (byte-compile-compute-lforminfo): + specialp -> special-variable-p. + 2010-06-15 Stefan Monnier * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): diff --git a/lisp/emacs-lisp/byte-lexbind.el b/lisp/emacs-lisp/byte-lexbind.el index a01829abf50..df463c17549 100644 --- a/lisp/emacs-lisp/byte-lexbind.el +++ b/lisp/emacs-lisp/byte-lexbind.el @@ -1,6 +1,6 @@ ;;; byte-lexbind.el --- Lexical binding support for byte-compiler ;; -;; Copyright (C) 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2010 Free Software Foundation, Inc. ;; ;; Author: Miles Bader ;; Keywords: lisp, compiler, lexical binding @@ -9,7 +9,7 @@ ;; 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) +;; the Free Software Foundation; either version 3, or (at your option) ;; any later version. ;; GNU Emacs is distributed in the hope that it will be useful, @@ -123,7 +123,7 @@ The result is an `lforminfo' data structure." ;; Find the bound variables (dolist (clause (cadr form)) (let ((var (if (consp clause) (car clause) clause))) - (unless (or (specialp var) (memq var special)) + (unless (or (special-variable-p var) (memq var special)) (byte-compile-lforminfo-add-var lforminfo var t)))) ;; Analyze the body (unless (null (byte-compile-lforminfo-vars lforminfo)) @@ -137,7 +137,7 @@ The result is an `lforminfo' data structure." (when (and (consp clause) lforminfo) (byte-compile-lforminfo-analyze lforminfo (cadr clause) special nil)) - (unless (or (specialp var) (memq var special)) + (unless (or (special-variable-p var) (memq var special)) (byte-compile-lforminfo-add-var lforminfo var t)))) ;; Analyze the body (unless (null (byte-compile-lforminfo-vars lforminfo)) diff --git a/src/ChangeLog b/src/ChangeLog index 017b3eb2553..e70aefd75b5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2010-06-18 Stefan Monnier + + * eval.c (Fspecial_variable_p): Rename from `specialp'. + 2010-06-15 Stefan Monnier * bytecode.c (exec_byte_code): diff --git a/src/eval.c b/src/eval.c index 71a0b111849..a6290618753 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3753,7 +3753,7 @@ unbind_to (count, value) -DEFUN ("specialp", Fspecialp, Sspecialp, 1, 1, 0, +DEFUN ("special-variable-p", Fspecial_variable_p, Sspecial_variable_p, 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. */) @@ -4138,7 +4138,7 @@ alist of active lexical bindings. */); defsubr (&Sbacktrace); defsubr (&Sbacktrace_frame); defsubr (&Scurry); - defsubr (&Sspecialp); + defsubr (&Sspecial_variable_p); defsubr (&Sfunctionp); } From 0bfdb86f425a88fe43ebc88851c6f9a6418e1862 Mon Sep 17 00:00:00 2001 From: Andreas Schwab Date: Fri, 23 Jul 2010 18:48:41 +0200 Subject: [PATCH 05/45] * eval.c (funcall_funvec): Replace bcopy by memcpy. --- src/ChangeLog | 4 ++++ src/eval.c | 8 ++++---- 2 files changed, 8 insertions(+), 4 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index 6329382df95..e1c0e6e5e9a 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2010-07-23 Andreas Schwab + + * eval.c (funcall_funvec): Replace bcopy by memcpy. + 2010-06-18 Stefan Monnier * eval.c (Fspecial_variable_p): Rename from `specialp'. diff --git a/src/eval.c b/src/eval.c index ec031f391c8..940e52a4d0a 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3292,10 +3292,10 @@ funcall_funvec (fun, nargs, args) 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)); + memcpy (funcall_args + curried_args_offs, curried_args, + num_curried_args * sizeof (Lisp_Object)); + memcpy (funcall_args + user_args_offs, args, + nargs * sizeof (Lisp_Object)); return Ffuncall (num_funcall_args, funcall_args); } From f07a954eeb0930029104402e706165bf89853576 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 12 Dec 2010 23:04:15 -0500 Subject: [PATCH 06/45] Make the effect of (defvar foo) local. * src/eval.c (apply_lambda): Make static. Remove eval_flag arg. (Fsetq): Don't check declared_special. (Fdefun, Fdefmacro): Use Ffunction. (Fdefvar): Don't set declared_special for (defvar foo). (FletX): Check locally-special vars. Only do specbind once. (Flet): Check locally-special vars. (Feval): Don't check declared_special. (funcall_lambda): Check locally-special vars. * src/lisp.h (apply_lambda): Remove extern declaration. * src/lread.c (readevalloop): CSE. * lisp/subr.el (with-lexical-binding): Remove. --- lisp/ChangeLog | 4 ++ lisp/subr.el | 10 ++--- src/ChangeLog | 14 ++++++ src/eval.c | 116 ++++++++++++++++++++++++++++--------------------- src/lisp.h | 1 - src/lread.c | 7 ++- 6 files changed, 92 insertions(+), 60 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 65d422a80ea..5a5b7ef44dc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2010-12-13 Stefan Monnier + + * subr.el (with-lexical-binding): Remove. + 2010-06-18 Stefan Monnier * emacs-lisp/byte-lexbind.el (byte-compile-compute-lforminfo): diff --git a/lisp/subr.el b/lisp/subr.el index c79a69b221e..99f632fb586 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -427,11 +427,11 @@ 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)) +;; Remove this since we don't know how to handle it in the byte-compiler yet. +;; (defmacro with-lexical-binding (&rest body) +;; "Execute the statements in BODY using lexical binding." +;; `(let ((internal-interpreter-environment '(t))) +;; ,@body)) (defun assq-delete-all (key alist) "Delete from ALIST all elements whose car is `eq' to KEY. diff --git a/src/ChangeLog b/src/ChangeLog index e1c0e6e5e9a..6abdf583b00 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,17 @@ +2010-12-13 Stefan Monnier + + Make the effect of (defvar foo) local. + * eval.c (apply_lambda): Make static. Remove eval_flag arg. + (Fsetq): Don't check declared_special. + (Fdefun, Fdefmacro): Use Ffunction. + (Fdefvar): Don't set declared_special for (defvar foo). + (FletX): Check locally-special vars. Only do specbind once. + (Flet): Check locally-special vars. + (Feval): Don't check declared_special. + (funcall_lambda): Check locally-special vars. + * lisp.h (apply_lambda): Remove extern declaration. + * lread.c (readevalloop): CSE. + 2010-07-23 Andreas Schwab * eval.c (funcall_funvec): Replace bcopy by memcpy. diff --git a/src/eval.c b/src/eval.c index 574c4ebf361..63ea95513b3 100644 --- a/src/eval.c +++ b/src/eval.c @@ -81,9 +81,12 @@ 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 + alist of lexically-bound variable, or (t), indicating an empty environment. The lisp name of this variable is - `internal-interpreter-lexical-environment'. */ + `internal-interpreter-environment'. Every element of this list + can be either a cons (VAR . VAL) specifying a lexical binding, + or a single symbol VAR indicating that this variable should use + dynamic scoping. */ Lisp_Object Vinternal_interpreter_environment; @@ -175,6 +178,8 @@ int handling_signal; Lisp_Object Vmacro_declaration_function; +static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args, + Lisp_Object lexenv) static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *, Lisp_Object); static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; @@ -505,10 +510,12 @@ usage: (setq [SYM VAL]...) */) val = Feval (Fcar (Fcdr (args_left))); sym = Fcar (args_left); - if (!NILP (Vinternal_interpreter_environment) + /* Like for Feval, we do not check declared_special here since + it's been done when let-binding. */ + if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ && SYMBOLP (sym) - && !XSYMBOL (sym)->declared_special - && !NILP (lex_binding = Fassq (sym, Vinternal_interpreter_environment))) + && !NILP (lex_binding + = Fassq (sym, Vinternal_interpreter_environment))) XSETCDR (lex_binding, val); /* SYM is lexically bound. */ else Fset (sym, val); /* SYM is dynamically bound. */ @@ -667,8 +674,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 (Vinternal_interpreter_environment)) /* Mere optimization! */ + defn = Ffunction (Fcons (defn, Qnil)); if (!NILP (Vpurify_flag)) defn = Fpurecopy (defn); if (CONSP (XSYMBOL (fn_name)->function) @@ -742,8 +749,8 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) tail = Fcons (lambda_list, Fcons (doc, tail)); defn = Fcons (Qlambda, tail); - if (! NILP (Vinternal_interpreter_environment)) - defn = Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, defn)); + if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ + defn = Ffunction (Fcons (defn, Qnil)); defn = Fcons (Qmacro, defn); if (!NILP (Vpurify_flag)) @@ -888,16 +895,23 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) Fput (sym, Qvariable_documentation, tem); } LOADHIST_ATTACH (sym); + + if (SYMBOLP (sym)) + XSYMBOL (sym)->declared_special = 1; } + else if (!NILP (Vinternal_interpreter_environment) + && !XSYMBOL (sym)->declared_special) + /* A simple (defvar foo) with lexical scoping does "nothing" except + declare that var to be dynamically scoped *locally* (i.e. within + the current file or let-block). */ + Vinternal_interpreter_environment = + Fcons (sym, Vinternal_interpreter_environment); else /* Simple (defvar ) should not count as a definition at all. 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; } @@ -1038,12 +1052,21 @@ usage: (let* VARLIST BODY...) */) val = Feval (Fcar (Fcdr (elt))); } - if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special) + if (!NILP (lexenv) && SYMBOLP (var) + && !XSYMBOL (var)->declared_special + && NILP (Fmemq (var, Vinternal_interpreter_environment))) /* Lexically bind VAR by adding it to the interpreter's binding alist. */ { - lexenv = Fcons (Fcons (var, val), lexenv); - specbind (Qinternal_interpreter_environment, lexenv); + Lisp_Object newenv + = Fcons (Fcons (var, val), Vinternal_interpreter_environment); + if (EQ (Vinternal_interpreter_environment, lexenv)) + /* Save the old lexical environment on the specpdl stack, + but only for the first lexical binding, since we'll never + need to revert to one of the intermediate ones. */ + specbind (Qinternal_interpreter_environment, newenv); + else + Vinternal_interpreter_environment = newenv; } else specbind (var, val); @@ -1110,7 +1133,9 @@ usage: (let VARLIST BODY...) */) var = SYMBOLP (elt) ? elt : Fcar (elt); tem = temps[argnum++]; - if (!NILP (lexenv) && SYMBOLP (var) && !XSYMBOL (var)->declared_special) + if (!NILP (lexenv) && SYMBOLP (var) + && !XSYMBOL (var)->declared_special + && NILP (Fmemq (var, Vinternal_interpreter_environment))) /* Lexically bind VAR by adding it to the lexenv alist. */ lexenv = Fcons (Fcons (var, tem), lexenv); else @@ -2302,25 +2327,17 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, if (SYMBOLP (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); + /* Look up its binding in the lexical environment. + We do not pay attention to the declared_special flag here, since we + already did that when let-binding the variable. */ + Lisp_Object lex_binding + = !NILP (Vinternal_interpreter_environment) /* Mere optimization! */ + ? Fassq (form, Vinternal_interpreter_environment) + : Qnil; + if (CONSP (lex_binding)) + return XCDR (lex_binding); + else + return Fsymbol_value (form); } if (!CONSP (form)) @@ -2485,7 +2502,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, } } if (FUNVECP (fun)) - val = apply_lambda (fun, original_args, 1, Qnil); + val = apply_lambda (fun, original_args, Qnil); else { if (EQ (fun, Qunbound)) @@ -2503,7 +2520,7 @@ 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, /* Only pass down the current lexical environment if FUN is lexically embedded in FORM. */ (CONSP (original_fun) @@ -2513,7 +2530,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, && CONSP (XCDR (fun)) && CONSP (XCDR (XCDR (fun))) && EQ (XCAR (XCDR (XCDR (fun))), Qlambda)) - val = apply_lambda (XCDR (XCDR (fun)), original_args, 1, + val = apply_lambda (XCDR (XCDR (fun)), original_args, XCAR (XCDR (fun))); else xsignal1 (Qinvalid_function, original_fun); @@ -3208,9 +3225,8 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) return val; } -Lisp_Object -apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag, - Lisp_Object lexenv) +static Lisp_Object +apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv) { Lisp_Object args_left; Lisp_Object numargs; @@ -3230,18 +3246,15 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, int eval_flag, for (i = 0; i < XINT (numargs);) { tem = Fcar (args_left), args_left = Fcdr (args_left); - if (eval_flag) tem = Feval (tem); + tem = Feval (tem); arg_vector[i++] = tem; gcpro1.nvars = i; } UNGCPRO; - if (eval_flag) - { - backtrace_list->args = arg_vector; - backtrace_list->nargs = i; - } + backtrace_list->args = arg_vector; + backtrace_list->nargs = i; backtrace_list->evalargs = 0; tem = funcall_lambda (fun, XINT (numargs), arg_vector, lexenv); @@ -3387,8 +3400,11 @@ funcall_lambda (Lisp_Object fun, int nargs, val = Qnil; /* Bind the argument. */ - if (!NILP (lexenv) - && SYMBOLP (next) && !XSYMBOL (next)->declared_special) + if (!NILP (lexenv) && SYMBOLP (next) + /* FIXME: there's no good reason to allow dynamic-scoping + on function arguments, other than consistency with let. */ + && !XSYMBOL (next)->declared_special + && NILP (Fmemq (next, Vinternal_interpreter_environment))) /* Lexically bind NEXT by adding it to the lexenv alist. */ lexenv = Fcons (Fcons (next, val), lexenv); else diff --git a/src/lisp.h b/src/lisp.h index 36653e91e4e..aafa3884273 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2985,7 +2985,6 @@ extern Lisp_Object call5 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Li extern Lisp_Object call6 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object call7 (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 (Lisp_Object, Lisp_Object, int, Lisp_Object); extern Lisp_Object internal_catch (Lisp_Object, Lisp_Object (*) (Lisp_Object), Lisp_Object); extern Lisp_Object internal_lisp_condition_case (Lisp_Object, Lisp_Object, Lisp_Object); extern Lisp_Object internal_condition_case (Lisp_Object (*) (void), Lisp_Object, Lisp_Object (*) (Lisp_Object)); diff --git a/src/lread.c b/src/lread.c index 83c94b02e23..d85d146b157 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1767,10 +1767,9 @@ readevalloop (Lisp_Object readcharfun, 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)); + specbind (Qinternal_interpreter_environment, + NILP (lex_bound) || EQ (lex_bound, Qunbound) + ? Qnil : Fcons (Qt, Qnil)); GCPRO4 (sourcename, readfun, start, end); From defb141157dfa37c33cdcbfa4b29c702a8fc9edf Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 13 Dec 2010 22:37:44 -0500 Subject: [PATCH 07/45] Try and be more careful about propagation of lexical environment. * src/eval.c (apply_lambda, funcall_lambda): Remove lexenv arg. (Feval): Always eval in the empty environment. (eval_sub): New function. Use it for all calls to Feval that should evaluate in the lexical environment of the caller. Pass `closure's as is to apply_lambda. (Ffuncall): Pass `closure's as is to funcall_lambda. (funcall_lambda): Extract lexenv for `closure's, when applicable. Also use lexical scoping for the &rest argument, if applicable. * src/lisp.h (eval_sub): Declare. * src/lread.c (readevalloop): Remove `evalfun' argument. * src/print.c (Fwith_output_to_temp_buffer): * src/data.c (Fsetq_default): Use eval_sub. * lisp/emacs-lisp/bytecomp.el (byte-compile-condition-case): Use push. --- lisp/ChangeLog | 4 ++ lisp/emacs-lisp/bytecomp.el | 16 ++--- src/ChangeLog | 16 +++++ src/bytecode.c | 8 +-- src/callint.c | 2 +- src/data.c | 2 +- src/eval.c | 133 ++++++++++++++++++------------------ src/lisp.h | 1 + src/lread.c | 14 ++-- src/minibuf.c | 1 + src/print.c | 2 +- 11 files changed, 110 insertions(+), 89 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5a5b7ef44dc..053eb95329c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2010-12-14 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-condition-case): Use push. + 2010-12-13 Stefan Monnier * subr.el (with-lexical-binding): Remove. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 90fcf7fb8a6..0f7018b9b64 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2979,6 +2979,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; Given BYTECOMP-BODY, compile it and return a new body. (defun byte-compile-top-level-body (bytecomp-body &optional for-effect) + ;; FIXME: lexbind. Check all callers! (setq bytecomp-body (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t)) (cond ((eq (car-safe bytecomp-body) 'progn) @@ -4083,8 +4084,8 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." (defun byte-compile-track-mouse (form) (byte-compile-form - `(funcall '(lambda nil - (track-mouse ,@(byte-compile-top-level-body (cdr form))))))) + `(funcall #'(lambda nil + (track-mouse ,@(byte-compile-top-level-body (cdr form))))))) (defun byte-compile-condition-case (form) (let* ((var (nth 1 form)) @@ -4121,11 +4122,10 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." ;; "`%s' is not a known condition name (in condition-case)" ;; condition)) ) - (setq compiled-clauses - (cons (cons condition - (byte-compile-top-level-body - (cdr clause) for-effect)) - compiled-clauses))) + (push (cons condition + (byte-compile-top-level-body + (cdr clause) for-effect)) + compiled-clauses)) (setq clauses (cdr clauses))) (byte-compile-push-constant (nreverse compiled-clauses))) (byte-compile-out 'byte-condition-case 0))) @@ -4244,7 +4244,7 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." `(if (not (default-boundp ',var)) (setq-default ,var ,value)))) (when (eq fun 'defconst) ;; This will signal an appropriate error at runtime. - `(eval ',form))) + `(eval ',form))) ;FIXME: lexbind `',var)))) (defun byte-compile-autoload (form) diff --git a/src/ChangeLog b/src/ChangeLog index 6abdf583b00..c333b6388c6 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,19 @@ +2010-12-14 Stefan Monnier + + Try and be more careful about propagation of lexical environment. + * eval.c (apply_lambda, funcall_lambda): Remove lexenv arg. + (Feval): Always eval in the empty environment. + (eval_sub): New function. Use it for all calls to Feval that should + evaluate in the lexical environment of the caller. + Pass `closure's as is to apply_lambda. + (Ffuncall): Pass `closure's as is to funcall_lambda. + (funcall_lambda): Extract lexenv for `closure's, when applicable. + Also use lexical scoping for the &rest argument, if applicable. + * lisp.h (eval_sub): Declare. + * lread.c (readevalloop): Remove `evalfun' argument. + * print.c (Fwith_output_to_temp_buffer): + * data.c (Fsetq_default): Use eval_sub. + 2010-12-13 Stefan Monnier Make the effect of (defvar foo) local. diff --git a/src/bytecode.c b/src/bytecode.c index d94b19b2d07..01fce0577b0 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -901,7 +901,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, case Bsave_window_excursion: BEFORE_POTENTIAL_GC (); - TOP = Fsave_window_excursion (TOP); + TOP = Fsave_window_excursion (TOP); /* FIXME: lexbind */ AFTER_POTENTIAL_GC (); break; @@ -915,13 +915,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; - TOP = internal_catch (TOP, Feval, v1); + TOP = internal_catch (TOP, Feval, v1); /* FIXME: lexbind */ AFTER_POTENTIAL_GC (); break; } case Bunwind_protect: - record_unwind_protect (Fprogn, POP); + record_unwind_protect (Fprogn, POP); /* FIXME: lexbind */ break; case Bcondition_case: @@ -930,7 +930,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, handlers = POP; body = POP; BEFORE_POTENTIAL_GC (); - TOP = internal_lisp_condition_case (TOP, body, handlers); + TOP = internal_lisp_condition_case (TOP, body, handlers); /* FIXME: lexbind */ AFTER_POTENTIAL_GC (); break; } diff --git a/src/callint.c b/src/callint.c index ae11c7cb24d..960158029c3 100644 --- a/src/callint.c +++ b/src/callint.c @@ -342,7 +342,7 @@ invoke it. If KEYS is omitted or nil, the return value of input = specs; /* Compute the arg values using the user's expression. */ GCPRO2 (input, filter_specs); - specs = Feval (specs); + specs = Feval (specs); /* FIXME: lexbind */ UNGCPRO; if (i != num_input_events || !NILP (record_flag)) { diff --git a/src/data.c b/src/data.c index 924a717cf3d..42d9e076e80 100644 --- a/src/data.c +++ b/src/data.c @@ -1452,7 +1452,7 @@ usage: (setq-default [VAR VALUE]...) */) do { - val = Feval (Fcar (Fcdr (args_left))); + val = eval_sub (Fcar (Fcdr (args_left))); symbol = XCAR (args_left); Fset_default (symbol, val); args_left = Fcdr (XCDR (args_left)); diff --git a/src/eval.c b/src/eval.c index 74dd7e63aa1..485ba00c1e4 100644 --- a/src/eval.c +++ b/src/eval.c @@ -178,10 +178,8 @@ int handling_signal; Lisp_Object Vmacro_declaration_function; -static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args, - Lisp_Object lexenv); -static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *, - Lisp_Object); +static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); +static Lisp_Object funcall_lambda (Lisp_Object, int, Lisp_Object *); static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; void @@ -308,7 +306,7 @@ usage: (or CONDITIONS...) */) while (CONSP (args)) { - val = Feval (XCAR (args)); + val = eval_sub (XCAR (args)); if (!NILP (val)) break; args = XCDR (args); @@ -332,7 +330,7 @@ usage: (and CONDITIONS...) */) while (CONSP (args)) { - val = Feval (XCAR (args)); + val = eval_sub (XCAR (args)); if (NILP (val)) break; args = XCDR (args); @@ -354,11 +352,11 @@ usage: (if COND THEN ELSE...) */) struct gcpro gcpro1; GCPRO1 (args); - cond = Feval (Fcar (args)); + cond = eval_sub (Fcar (args)); UNGCPRO; if (!NILP (cond)) - return Feval (Fcar (Fcdr (args))); + return eval_sub (Fcar (Fcdr (args))); return Fprogn (Fcdr (Fcdr (args))); } @@ -382,7 +380,7 @@ usage: (cond CLAUSES...) */) while (!NILP (args)) { clause = Fcar (args); - val = Feval (Fcar (clause)); + val = eval_sub (Fcar (clause)); if (!NILP (val)) { if (!EQ (XCDR (clause), Qnil)) @@ -408,7 +406,7 @@ usage: (progn BODY...) */) while (CONSP (args)) { - val = Feval (XCAR (args)); + val = eval_sub (XCAR (args)); args = XCDR (args); } @@ -438,9 +436,9 @@ usage: (prog1 FIRST BODY...) */) do { if (!(argnum++)) - val = Feval (Fcar (args_left)); + val = eval_sub (Fcar (args_left)); else - Feval (Fcar (args_left)); + eval_sub (Fcar (args_left)); args_left = Fcdr (args_left); } while (!NILP(args_left)); @@ -473,9 +471,9 @@ usage: (prog2 FORM1 FORM2 BODY...) */) do { if (!(argnum++)) - val = Feval (Fcar (args_left)); + val = eval_sub (Fcar (args_left)); else - Feval (Fcar (args_left)); + eval_sub (Fcar (args_left)); args_left = Fcdr (args_left); } while (!NILP (args_left)); @@ -507,10 +505,10 @@ usage: (setq [SYM VAL]...) */) do { - val = Feval (Fcar (Fcdr (args_left))); + val = eval_sub (Fcar (Fcdr (args_left))); sym = Fcar (args_left); - /* Like for Feval, we do not check declared_special here since + /* Like for eval_sub, we do not check declared_special here since it's been done when let-binding. */ if (!NILP (Vinternal_interpreter_environment) /* Mere optimization! */ && SYMBOLP (sym) @@ -870,7 +868,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) } if (NILP (tem)) - Fset_default (sym, Feval (Fcar (tail))); + Fset_default (sym, eval_sub (Fcar (tail))); else { /* Check if there is really a global binding rather than just a let binding that shadows the global unboundness of the var. */ @@ -935,7 +933,7 @@ usage: (defconst SYMBOL INITVALUE [DOCSTRING]) */) if (!NILP (Fcdr (Fcdr (Fcdr (args))))) error ("Too many arguments"); - tem = Feval (Fcar (Fcdr (args))); + tem = eval_sub (Fcar (Fcdr (args))); if (!NILP (Vpurify_flag)) tem = Fpurecopy (tem); Fset_default (sym, tem); @@ -1049,7 +1047,7 @@ usage: (let* VARLIST BODY...) */) else { var = Fcar (elt); - val = Feval (Fcar (Fcdr (elt))); + val = eval_sub (Fcar (Fcdr (elt))); } if (!NILP (lexenv) && SYMBOLP (var) @@ -1117,7 +1115,7 @@ usage: (let VARLIST BODY...) */) else if (! NILP (Fcdr (Fcdr (elt)))) signal_error ("`let' bindings can have only one value-form", elt); else - temps [argnum++] = Feval (Fcar (Fcdr (elt))); + temps [argnum++] = eval_sub (Fcar (Fcdr (elt))); gcpro2.nvars = argnum; } UNGCPRO; @@ -1166,7 +1164,7 @@ usage: (while TEST BODY...) */) test = Fcar (args); body = Fcdr (args); - while (!NILP (Feval (test))) + while (!NILP (eval_sub (test))) { QUIT; Fprogn (body); @@ -1268,7 +1266,7 @@ usage: (catch TAG BODY...) */) struct gcpro gcpro1; GCPRO1 (args); - tag = Feval (Fcar (args)); + tag = eval_sub (Fcar (args)); UNGCPRO; return internal_catch (tag, Fprogn, Fcdr (args)); } @@ -1401,7 +1399,7 @@ usage: (unwind-protect BODYFORM UNWINDFORMS...) */) int count = SPECPDL_INDEX (); record_unwind_protect (Fprogn, Fcdr (args)); - val = Feval (Fcar (args)); + val = eval_sub (Fcar (args)); return unbind_to (count, val); } @@ -1502,7 +1500,7 @@ internal_lisp_condition_case (volatile Lisp_Object var, Lisp_Object bodyform, h.tag = &c; handlerlist = &h; - val = Feval (bodyform); + val = eval_sub (bodyform); catchlist = c.next; handlerlist = h.next; return val; @@ -2316,6 +2314,16 @@ do_autoload (Lisp_Object fundef, Lisp_Object funname) DEFUN ("eval", Feval, Seval, 1, 1, 0, doc: /* Evaluate FORM and return its value. */) (Lisp_Object form) +{ + int count = SPECPDL_INDEX (); + specbind (Qinternal_interpreter_environment, Qnil); + return unbind_to (count, eval_sub (form)); +} + +/* Eval a sub-expression of the current expression (i.e. in the same + lexical scope). */ +Lisp_Object +eval_sub (Lisp_Object form) { Lisp_Object fun, val, original_fun, original_args; Lisp_Object funcar; @@ -2424,7 +2432,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, while (!NILP (args_left)) { - vals[argnum++] = Feval (Fcar (args_left)); + vals[argnum++] = eval_sub (Fcar (args_left)); args_left = Fcdr (args_left); gcpro3.nvars = argnum; } @@ -2445,7 +2453,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, maxargs = XSUBR (fun)->max_args; for (i = 0; i < maxargs; args_left = Fcdr (args_left)) { - argvals[i] = Feval (Fcar (args_left)); + argvals[i] = eval_sub (Fcar (args_left)); gcpro3.nvars = ++i; } @@ -2502,7 +2510,7 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, } } if (FUNVECP (fun)) - val = apply_lambda (fun, original_args, Qnil); + val = apply_lambda (fun, original_args); else { if (EQ (fun, Qunbound)) @@ -2518,20 +2526,10 @@ DEFUN ("eval", Feval, Seval, 1, 1, 0, goto retry; } if (EQ (funcar, Qmacro)) - val = Feval (apply1 (Fcdr (fun), original_args)); - else if (EQ (funcar, Qlambda)) - val = apply_lambda (fun, original_args, - /* 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, - XCAR (XCDR (fun))); + val = eval_sub (apply1 (Fcdr (fun), original_args)); + else if (EQ (funcar, Qlambda) + || EQ (funcar, Qclosure)) + val = apply_lambda (fun, original_args); else xsignal1 (Qinvalid_function, original_fun); } @@ -3189,7 +3187,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) } if (FUNVECP (fun)) - val = funcall_lambda (fun, numargs, args + 1, Qnil); + val = funcall_lambda (fun, numargs, args + 1); else { if (EQ (fun, Qunbound)) @@ -3199,14 +3197,9 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) funcar = XCAR (fun); if (!SYMBOLP (funcar)) xsignal1 (Qinvalid_function, original_fun); - if (EQ (funcar, Qlambda)) - 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))); + if (EQ (funcar, Qlambda) + || EQ (funcar, Qclosure)) + val = funcall_lambda (fun, numargs, args + 1); else if (EQ (funcar, Qautoload)) { do_autoload (fun, original_fun); @@ -3226,7 +3219,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) } static Lisp_Object -apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv) +apply_lambda (Lisp_Object fun, Lisp_Object args) { Lisp_Object args_left; Lisp_Object numargs; @@ -3246,7 +3239,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv) for (i = 0; i < XINT (numargs);) { tem = Fcar (args_left), args_left = Fcdr (args_left); - tem = Feval (tem); + tem = eval_sub (tem); arg_vector[i++] = tem; gcpro1.nvars = i; } @@ -3256,7 +3249,7 @@ apply_lambda (Lisp_Object fun, Lisp_Object args, Lisp_Object lexenv) backtrace_list->args = arg_vector; backtrace_list->nargs = i; backtrace_list->evalargs = 0; - tem = funcall_lambda (fun, XINT (numargs), arg_vector, lexenv); + tem = funcall_lambda (fun, XINT (numargs), arg_vector); /* Do the debug-on-exit now, while arg_vector still exists. */ if (backtrace_list->debug_on_exit) @@ -3321,10 +3314,9 @@ funcall_funvec (Lisp_Object fun, int nargs, Lisp_Object *args) static Lisp_Object funcall_lambda (Lisp_Object fun, int nargs, - register Lisp_Object *arg_vector, - Lisp_Object lexenv) + register Lisp_Object *arg_vector) { - Lisp_Object val, syms_left, next; + Lisp_Object val, syms_left, next, lexenv; int count = SPECPDL_INDEX (); int i, optional, rest; @@ -3358,6 +3350,14 @@ funcall_lambda (Lisp_Object fun, int nargs, if (CONSP (fun)) { + if (EQ (XCAR (fun), Qclosure)) + { + fun = XCDR (fun); /* Drop `closure'. */ + lexenv = XCAR (fun); + fun = XCDR (fun); /* Drop the lexical environment. */ + } + else + lexenv = Qnil; syms_left = XCDR (fun); if (CONSP (syms_left)) syms_left = XCAR (syms_left); @@ -3365,7 +3365,10 @@ funcall_lambda (Lisp_Object fun, int nargs, xsignal1 (Qinvalid_function, fun); } else if (COMPILEDP (fun)) - syms_left = AREF (fun, COMPILED_ARGLIST); + { + syms_left = AREF (fun, COMPILED_ARGLIST); + lexenv = Qnil; + } else abort (); @@ -3382,23 +3385,21 @@ funcall_lambda (Lisp_Object fun, int nargs, rest = 1; else if (EQ (next, Qand_optional)) optional = 1; - else if (rest) - { - specbind (next, Flist (nargs - i, &arg_vector[i])); - i = nargs; - } else { Lisp_Object val; - - /* Get the argument's actual value. */ - if (i < nargs) + if (rest) + { + val = Flist (nargs - i, &arg_vector[i]); + i = nargs; + } + else 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) /* FIXME: there's no good reason to allow dynamic-scoping diff --git a/src/lisp.h b/src/lisp.h index aafa3884273..20b50632c49 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2972,6 +2972,7 @@ extern void signal_error (const char *, Lisp_Object) NO_RETURN; EXFUN (Fautoload, 5); EXFUN (Fcommandp, 2); EXFUN (Feval, 1); +extern Lisp_Object eval_sub (Lisp_Object form); EXFUN (Fapply, MANY); EXFUN (Ffuncall, MANY); EXFUN (Fbacktrace, 0); diff --git a/src/lread.c b/src/lread.c index d85d146b157..550b5f076f9 100644 --- a/src/lread.c +++ b/src/lread.c @@ -220,8 +220,7 @@ static Lisp_Object Vbytecomp_version_regexp; static int read_emacs_mule_char (int, int (*) (int, Lisp_Object), Lisp_Object); -static void readevalloop (Lisp_Object, FILE*, Lisp_Object, - Lisp_Object (*) (Lisp_Object), int, +static void readevalloop (Lisp_Object, FILE*, Lisp_Object, int, Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object); static Lisp_Object load_unwind (Lisp_Object); @@ -1355,13 +1354,13 @@ Return t if the file exists and loads successfully. */) if (! version || version >= 22) readevalloop (Qget_file_char, stream, hist_file_name, - Feval, 0, Qnil, Qnil, Qnil, Qnil); + 0, Qnil, Qnil, Qnil, Qnil); else { /* We can't handle a file which was compiled with byte-compile-dynamic by older version of Emacs. */ specbind (Qload_force_doc_strings, Qt); - readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, Feval, + readevalloop (Qget_emacs_mule_file_char, stream, hist_file_name, 0, Qnil, Qnil, Qnil, Qnil); } unbind_to (count, Qnil); @@ -1726,7 +1725,6 @@ static void readevalloop (Lisp_Object readcharfun, FILE *stream, Lisp_Object sourcename, - Lisp_Object (*evalfun) (Lisp_Object), int printflag, Lisp_Object unibyte, Lisp_Object readfun, Lisp_Object start, Lisp_Object end) @@ -1872,7 +1870,7 @@ readevalloop (Lisp_Object readcharfun, unbind_to (count1, Qnil); /* Now eval what we just read. */ - val = (*evalfun) (val); + val = eval_sub (val); if (printflag) { @@ -1935,7 +1933,7 @@ This function preserves the position of point. */) 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, + readevalloop (buf, 0, filename, !NILP (printflag), unibyte, Qnil, Qnil, Qnil); unbind_to (count, Qnil); @@ -1969,7 +1967,7 @@ This function does not move point. */) specbind (Qeval_buffer_list, Fcons (cbuf, Veval_buffer_list)); /* readevalloop calls functions which check the type of start and end. */ - readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, Feval, + readevalloop (cbuf, 0, XBUFFER (cbuf)->filename, !NILP (printflag), Qnil, read_function, start, end); diff --git a/src/minibuf.c b/src/minibuf.c index 0f3def614f2..409f8a9a9ef 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1026,6 +1026,7 @@ is a string to insert in the minibuffer before reading. Such arguments are used as in `read-from-minibuffer'.) */) (Lisp_Object prompt, Lisp_Object initial_contents) { + /* FIXME: lexbind. */ return Feval (read_minibuf (Vread_expression_map, initial_contents, prompt, Qnil, 1, Qread_expression_history, make_number (0), Qnil, 0, 0)); diff --git a/src/print.c b/src/print.c index 77cc2916952..41aa7fc4387 100644 --- a/src/print.c +++ b/src/print.c @@ -652,7 +652,7 @@ usage: (with-output-to-temp-buffer BUFNAME BODY...) */) Lisp_Object buf, val; GCPRO1(args); - name = Feval (Fcar (args)); + name = eval_sub (Fcar (args)); CHECK_STRING (name); temp_output_buffer_setup (SDATA (name)); buf = Vstandard_output; From a0ee6f2751acba71df443d4d795bb350eb6421dd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 15 Dec 2010 12:46:59 -0500 Subject: [PATCH 08/45] Obey lexical-binding in interactive evaluation commands. * lisp/emacs-lisp/edebug.el (edebug-eval-defun, edebug-eval): * lisp/emacs-lisp/lisp-mode.el (eval-last-sexp-1, eval-defun-1): * lisp/ielm.el (ielm-eval-input): * lisp/simple.el (eval-expression): Use new eval arg to obey lexical-binding. * src/eval.c (Feval): Add `lexical' argument. Adjust callers. (Ffuncall, eval_sub): Avoid goto. --- lisp/ChangeLog | 7 + lisp/emacs-lisp/edebug.el | 17 ++- lisp/emacs-lisp/lisp-mode.el | 26 ++-- lisp/ielm.el | 3 +- lisp/simple.el | 4 +- src/ChangeLog | 5 + src/bytecode.c | 2 +- src/callint.c | 2 +- src/doc.c | 2 +- src/eval.c | 257 +++++++++++++++++------------------ src/keyboard.c | 12 +- src/lisp.h | 2 +- src/minibuf.c | 4 +- 13 files changed, 179 insertions(+), 164 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 053eb95329c..87794ceb5d2 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2010-12-15 Stefan Monnier + + * emacs-lisp/edebug.el (edebug-eval-defun, edebug-eval): + * emacs-lisp/lisp-mode.el (eval-last-sexp-1, eval-defun-1): + * ielm.el (ielm-eval-input): + * simple.el (eval-expression): Use new eval arg to obey lexical-binding. + 2010-12-14 Stefan Monnier * emacs-lisp/bytecomp.el (byte-compile-condition-case): Use push. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 77953b37021..4dfccb4c5b4 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -521,7 +521,7 @@ the minibuffer." ((and (eq (car form) 'defcustom) (default-boundp (nth 1 form))) ;; Force variable to be bound. - (set-default (nth 1 form) (eval (nth 2 form)))) + (set-default (nth 1 form) (eval (nth 2 form) lexical-binding))) ((eq (car form) 'defface) ;; Reset the face. (setq face-new-frame-defaults @@ -534,7 +534,7 @@ the minibuffer." (put ',(nth 1 form) 'customized-face ,(nth 2 form))) (put (nth 1 form) 'saved-face nil))))) - (setq edebug-result (eval form)) + (setq edebug-result (eval form lexical-binding)) (if (not edebugging) (princ edebug-result) edebug-result))) @@ -2466,6 +2466,7 @@ MSG is printed after `::::} '." (if edebug-global-break-condition (condition-case nil (setq edebug-global-break-result + ;; FIXME: lexbind. (eval edebug-global-break-condition)) (error nil)))) (edebug-break)) @@ -2477,6 +2478,7 @@ MSG is printed after `::::} '." (and edebug-break-data (or (not edebug-break-condition) (setq edebug-break-result + ;; FIXME: lexbind. (eval edebug-break-condition)))))) (if (and edebug-break (nth 2 edebug-break-data)) ; is it temporary? @@ -3637,9 +3639,10 @@ Return the result of the last expression." (defun edebug-eval (edebug-expr) ;; Are there cl lexical variables active? - (if (bound-and-true-p cl-debug-env) - (eval (cl-macroexpand-all edebug-expr cl-debug-env)) - (eval edebug-expr))) + (eval (if (bound-and-true-p cl-debug-env) + (cl-macroexpand-all edebug-expr cl-debug-env) + edebug-expr) + lexical-binding)) ;; FIXME: lexbind. (defun edebug-safe-eval (edebug-expr) ;; Evaluate EXPR safely. @@ -4241,8 +4244,8 @@ It is removed when you hit any char." ;;; Menus (defun edebug-toggle (variable) - (set variable (not (eval variable))) - (message "%s: %s" variable (eval variable))) + (set variable (not (symbol-value variable))) + (message "%s: %s" variable (symbol-value variable))) ;; We have to require easymenu (even for Emacs 18) just so ;; the easy-menu-define macro call is compiled correctly. diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index c90d1394978..2cdbd115928 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -699,16 +699,9 @@ 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)) - ;; preserve the current lexical environment - (internal-interpreter-environment internal-interpreter-environment)) + (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) ;; 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))))) + (eval-last-sexp-print-value (eval (preceding-sexp) lexical-binding)))) (defun eval-last-sexp-print-value (value) @@ -772,16 +765,18 @@ Reinitialize the face according to the `defface' specification." ;; `defcustom' is now macroexpanded to ;; `custom-declare-variable' with a quoted value arg. ((and (eq (car form) 'custom-declare-variable) - (default-boundp (eval (nth 1 form)))) + (default-boundp (eval (nth 1 form) lexical-binding))) ;; Force variable to be bound. - (set-default (eval (nth 1 form)) (eval (nth 1 (nth 2 form)))) + (set-default (eval (nth 1 form) lexical-binding) + (eval (nth 1 (nth 2 form)) lexical-binding)) form) ;; `defface' is macroexpanded to `custom-declare-face'. ((eq (car form) 'custom-declare-face) ;; Reset the face. (setq face-new-frame-defaults - (assq-delete-all (eval (nth 1 form)) face-new-frame-defaults)) - (put (eval (nth 1 form)) 'face-defface-spec nil) + (assq-delete-all (eval (nth 1 form) lexical-binding) + face-new-frame-defaults)) + (put (eval (nth 1 form) lexical-binding) 'face-defface-spec nil) ;; Setting `customized-face' to the new spec after calling ;; the form, but preserving the old saved spec in `saved-face', ;; imitates the situation when the new face spec is set @@ -792,10 +787,11 @@ Reinitialize the face according to the `defface' specification." ;; `defface' change the spec, regardless of a saved spec. (prog1 `(prog1 ,form (put ,(nth 1 form) 'saved-face - ',(get (eval (nth 1 form)) 'saved-face)) + ',(get (eval (nth 1 form) lexical-binding) + 'saved-face)) (put ,(nth 1 form) 'customized-face ,(nth 2 form))) - (put (eval (nth 1 form)) 'saved-face nil))) + (put (eval (nth 1 form) lexical-binding) 'saved-face nil))) ((eq (car form) 'progn) (cons 'progn (mapcar 'eval-defun-1 (cdr form)))) (t form))) diff --git a/lisp/ielm.el b/lisp/ielm.el index 40e87cd6709..e1f8dc78d32 100644 --- a/lisp/ielm.el +++ b/lisp/ielm.el @@ -372,7 +372,8 @@ simply inserts a newline." (*** *3)) (kill-buffer (current-buffer)) (set-buffer ielm-wbuf) - (setq ielm-result (eval ielm-form)) + (setq ielm-result + (eval ielm-form lexical-binding)) (setq ielm-wbuf (current-buffer)) (setq ielm-temp-buffer diff --git a/lisp/simple.el b/lisp/simple.el index da8ac55c01d..a977be7cf8e 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -1212,12 +1212,12 @@ this command arranges for all errors to enter the debugger." current-prefix-arg)) (if (null eval-expression-debug-on-error) - (setq values (cons (eval eval-expression-arg) values)) + (push (eval eval-expression-arg lexical-binding) values) (let ((old-value (make-symbol "t")) new-value) ;; Bind debug-on-error to something unique so that we can ;; detect when evaled code changes it. (let ((debug-on-error old-value)) - (setq values (cons (eval eval-expression-arg) values)) + (push (eval eval-expression-arg lexical-binding) values) (setq new-value debug-on-error)) ;; If evaled code has changed the value of debug-on-error, ;; propagate that change to the global binding. diff --git a/src/ChangeLog b/src/ChangeLog index c333b6388c6..2de6a5ed66c 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2010-12-15 Stefan Monnier + + * eval.c (Feval): Add `lexical' argument. Adjust callers. + (Ffuncall, eval_sub): Avoid goto. + 2010-12-14 Stefan Monnier Try and be more careful about propagation of lexical environment. diff --git a/src/bytecode.c b/src/bytecode.c index 01fce0577b0..eb12b9c4963 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -915,7 +915,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; - TOP = internal_catch (TOP, Feval, v1); /* FIXME: lexbind */ + TOP = internal_catch (TOP, eval_sub, v1); /* FIXME: lexbind */ AFTER_POTENTIAL_GC (); break; } diff --git a/src/callint.c b/src/callint.c index 960158029c3..5eb65b31cbf 100644 --- a/src/callint.c +++ b/src/callint.c @@ -342,7 +342,7 @@ invoke it. If KEYS is omitted or nil, the return value of input = specs; /* Compute the arg values using the user's expression. */ GCPRO2 (input, filter_specs); - specs = Feval (specs); /* FIXME: lexbind */ + specs = Feval (specs, Qnil); /* FIXME: lexbind */ UNGCPRO; if (i != num_input_events || !NILP (record_flag)) { diff --git a/src/doc.c b/src/doc.c index b887b3149bc..8ae152dca9a 100644 --- a/src/doc.c +++ b/src/doc.c @@ -490,7 +490,7 @@ aren't strings. */) } else if (!STRINGP (tem)) /* Feval protects its argument. */ - tem = Feval (tem); + tem = Feval (tem, Qnil); if (NILP (raw) && STRINGP (tem)) tem = Fsubstitute_command_keys (tem); diff --git a/src/eval.c b/src/eval.c index 485ba00c1e4..7104a8a8396 100644 --- a/src/eval.c +++ b/src/eval.c @@ -2311,12 +2311,14 @@ do_autoload (Lisp_Object fundef, Lisp_Object funname) } -DEFUN ("eval", Feval, Seval, 1, 1, 0, - doc: /* Evaluate FORM and return its value. */) - (Lisp_Object form) +DEFUN ("eval", Feval, Seval, 1, 2, 0, + doc: /* Evaluate FORM and return its value. +If LEXICAL is t, evaluate using lexical scoping. */) + (Lisp_Object form, Lisp_Object lexical) { int count = SPECPDL_INDEX (); - specbind (Qinternal_interpreter_environment, Qnil); + specbind (Qinternal_interpreter_environment, + NILP (lexical) ? Qnil : Fcons (Qt, Qnil)); return unbind_to (count, eval_sub (form)); } @@ -2414,10 +2416,8 @@ eval_sub (Lisp_Object form) { backtrace.evalargs = 0; val = (XSUBR (fun)->function.aUNEVALLED) (args_left); - goto done; } - - if (XSUBR (fun)->max_args == MANY) + else if (XSUBR (fun)->max_args == MANY) { /* Pass a vector of evaluated arguments */ Lisp_Object *vals; @@ -2443,73 +2443,74 @@ eval_sub (Lisp_Object form) val = (XSUBR (fun)->function.aMANY) (XINT (numargs), vals); UNGCPRO; SAFE_FREE (); - goto done; } - - GCPRO3 (args_left, fun, fun); - gcpro3.var = argvals; - gcpro3.nvars = 0; - - maxargs = XSUBR (fun)->max_args; - for (i = 0; i < maxargs; args_left = Fcdr (args_left)) + else { - argvals[i] = eval_sub (Fcar (args_left)); - gcpro3.nvars = ++i; - } + GCPRO3 (args_left, fun, fun); + gcpro3.var = argvals; + gcpro3.nvars = 0; + + maxargs = XSUBR (fun)->max_args; + for (i = 0; i < maxargs; args_left = Fcdr (args_left)) + { + argvals[i] = eval_sub (Fcar (args_left)); + gcpro3.nvars = ++i; + } + + UNGCPRO; - UNGCPRO; + backtrace.args = argvals; + backtrace.nargs = XINT (numargs); - backtrace.args = argvals; - backtrace.nargs = XINT (numargs); + switch (i) + { + case 0: + val = (XSUBR (fun)->function.a0) (); + break; + case 1: + val = (XSUBR (fun)->function.a1) (argvals[0]); + break; + case 2: + val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]); + break; + case 3: + val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1], + argvals[2]); + break; + case 4: + val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1], + argvals[2], argvals[3]); + break; + case 5: + val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4]); + break; + case 6: + val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4], argvals[5]); + break; + case 7: + val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4], argvals[5], + argvals[6]); - switch (i) - { - case 0: - val = (XSUBR (fun)->function.a0) (); - goto done; - case 1: - val = (XSUBR (fun)->function.a1) (argvals[0]); - goto done; - case 2: - val = (XSUBR (fun)->function.a2) (argvals[0], argvals[1]); - goto done; - case 3: - val = (XSUBR (fun)->function.a3) (argvals[0], argvals[1], - argvals[2]); - goto done; - case 4: - val = (XSUBR (fun)->function.a4) (argvals[0], argvals[1], - argvals[2], argvals[3]); - goto done; - case 5: - val = (XSUBR (fun)->function.a5) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4]); - goto done; - case 6: - val = (XSUBR (fun)->function.a6) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4], argvals[5]); - goto done; - case 7: - val = (XSUBR (fun)->function.a7) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4], argvals[5], - argvals[6]); - goto done; + break; + case 8: + val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2], + argvals[3], argvals[4], argvals[5], + argvals[6], argvals[7]); - case 8: - val = (XSUBR (fun)->function.a8) (argvals[0], argvals[1], argvals[2], - argvals[3], argvals[4], argvals[5], - argvals[6], argvals[7]); - goto done; - - default: - /* Someone has created a subr that takes more arguments than - is supported by this code. We need to either rewrite the - subr to use a different argument protocol, or add more - cases to this switch. */ - abort (); + break; + default: + /* Someone has created a subr that takes more arguments than + is supported by this code. We need to either rewrite the + subr to use a different argument protocol, or add more + cases to this switch. */ + abort (); + } } } - if (FUNVECP (fun)) + else if (FUNVECP (fun)) val = apply_lambda (fun, original_args); else { @@ -2533,7 +2534,6 @@ eval_sub (Lisp_Object form) else xsignal1 (Qinvalid_function, original_fun); } - done: CHECK_CONS_LIST (); lisp_eval_depth--; @@ -3109,7 +3109,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) if (SUBRP (fun)) { - if (numargs < XSUBR (fun)->min_args + if (numargs < XSUBR (fun)->min_args || (XSUBR (fun)->max_args >= 0 && XSUBR (fun)->max_args < numargs)) { XSETFASTINT (lisp_numargs, numargs); @@ -3119,74 +3119,72 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) if (XSUBR (fun)->max_args == UNEVALLED) xsignal1 (Qinvalid_function, original_fun); - if (XSUBR (fun)->max_args == MANY) - { - val = (XSUBR (fun)->function.aMANY) (numargs, args + 1); - goto done; - } - - if (XSUBR (fun)->max_args > numargs) - { - internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object)); - memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object)); - for (i = numargs; i < XSUBR (fun)->max_args; i++) - internal_args[i] = Qnil; - } + else if (XSUBR (fun)->max_args == MANY) + val = (XSUBR (fun)->function.aMANY) (numargs, args + 1); else - internal_args = args + 1; - switch (XSUBR (fun)->max_args) { - case 0: - val = (XSUBR (fun)->function.a0) (); - goto done; - case 1: - val = (XSUBR (fun)->function.a1) (internal_args[0]); - goto done; - case 2: - val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]); - goto done; - case 3: - val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1], - internal_args[2]); - goto done; - case 4: - val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3]); - goto done; - case 5: - val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4]); - goto done; - case 6: - val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4], internal_args[5]); - goto done; - case 7: - val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4], internal_args[5], - internal_args[6]); - goto done; + if (XSUBR (fun)->max_args > numargs) + { + internal_args = (Lisp_Object *) alloca (XSUBR (fun)->max_args * sizeof (Lisp_Object)); + memcpy (internal_args, args + 1, numargs * sizeof (Lisp_Object)); + for (i = numargs; i < XSUBR (fun)->max_args; i++) + internal_args[i] = Qnil; + } + else + internal_args = args + 1; + switch (XSUBR (fun)->max_args) + { + case 0: + val = (XSUBR (fun)->function.a0) (); + break; + case 1: + val = (XSUBR (fun)->function.a1) (internal_args[0]); + break; + case 2: + val = (XSUBR (fun)->function.a2) (internal_args[0], internal_args[1]); + break; + case 3: + val = (XSUBR (fun)->function.a3) (internal_args[0], internal_args[1], + internal_args[2]); + break; + case 4: + val = (XSUBR (fun)->function.a4) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3]); + break; + case 5: + val = (XSUBR (fun)->function.a5) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4]); + break; + case 6: + val = (XSUBR (fun)->function.a6) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4], internal_args[5]); + break; + case 7: + val = (XSUBR (fun)->function.a7) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4], internal_args[5], + internal_args[6]); + break; - case 8: - val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1], - internal_args[2], internal_args[3], - internal_args[4], internal_args[5], - internal_args[6], internal_args[7]); - goto done; + case 8: + val = (XSUBR (fun)->function.a8) (internal_args[0], internal_args[1], + internal_args[2], internal_args[3], + internal_args[4], internal_args[5], + internal_args[6], internal_args[7]); + break; - default: + default: - /* If a subr takes more than 8 arguments without using MANY - or UNEVALLED, we need to extend this function to support it. - Until this is done, there is no way to call the function. */ - abort (); + /* If a subr takes more than 8 arguments without using MANY + or UNEVALLED, we need to extend this function to support it. + Until this is done, there is no way to call the function. */ + abort (); + } } } - - if (FUNVECP (fun)) + else if (FUNVECP (fun)) val = funcall_lambda (fun, numargs, args + 1); else { @@ -3209,7 +3207,6 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) else xsignal1 (Qinvalid_function, original_fun); } - done: CHECK_CONS_LIST (); lisp_eval_depth--; if (backtrace.debug_on_exit) diff --git a/src/keyboard.c b/src/keyboard.c index 17819170640..df69c526f71 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -1327,7 +1327,7 @@ command_loop_2 (Lisp_Object ignore) Lisp_Object top_level_2 (void) { - return Feval (Vtop_level); + return Feval (Vtop_level, Qnil); } Lisp_Object @@ -3255,7 +3255,7 @@ read_char (int commandflag, int nmaps, Lisp_Object *maps, Lisp_Object prev_event help_form_saved_window_configs); record_unwind_protect (read_char_help_form_unwind, Qnil); - tem0 = Feval (Vhelp_form); + tem0 = Feval (Vhelp_form, Qnil); if (STRINGP (tem0)) internal_with_output_to_temp_buffer ("*Help*", print_help, tem0); @@ -7696,6 +7696,12 @@ menu_item_eval_property_1 (Lisp_Object arg) return Qnil; } +static Lisp_Object +eval_dyn (Lisp_Object form) +{ + return Feval (form, Qnil); +} + /* Evaluate an expression and return the result (or nil if something went wrong). Used to evaluate dynamic parts of menu items. */ Lisp_Object @@ -7704,7 +7710,7 @@ menu_item_eval_property (Lisp_Object sexpr) int count = SPECPDL_INDEX (); Lisp_Object val; specbind (Qinhibit_redisplay, Qt); - val = internal_condition_case_1 (Feval, sexpr, Qerror, + val = internal_condition_case_1 (eval_dyn, sexpr, Qerror, menu_item_eval_property_1); return unbind_to (count, val); } diff --git a/src/lisp.h b/src/lisp.h index 20b50632c49..db78996be55 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2971,7 +2971,7 @@ extern void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) NO_RET extern void signal_error (const char *, Lisp_Object) NO_RETURN; EXFUN (Fautoload, 5); EXFUN (Fcommandp, 2); -EXFUN (Feval, 1); +EXFUN (Feval, 2); extern Lisp_Object eval_sub (Lisp_Object form); EXFUN (Fapply, MANY); EXFUN (Ffuncall, MANY); diff --git a/src/minibuf.c b/src/minibuf.c index 409f8a9a9ef..9dd32a8bab4 100644 --- a/src/minibuf.c +++ b/src/minibuf.c @@ -1026,10 +1026,10 @@ is a string to insert in the minibuffer before reading. Such arguments are used as in `read-from-minibuffer'.) */) (Lisp_Object prompt, Lisp_Object initial_contents) { - /* FIXME: lexbind. */ return Feval (read_minibuf (Vread_expression_map, initial_contents, prompt, Qnil, 1, Qread_expression_history, - make_number (0), Qnil, 0, 0)); + make_number (0), Qnil, 0, 0), + Qnil); } /* Functions that use the minibuffer to read various things. */ From 590130fb19e1f433965c421d98fedeb2d7c33310 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 27 Dec 2010 12:55:38 -0500 Subject: [PATCH 09/45] * src/eval.c (Fdefvar): Record specialness before computing initial value. * lisp/emacs-lisp/bytecomp.el (byte-compile-track-mouse): Don't use #'. --- lisp/ChangeLog | 4 ++++ lisp/emacs-lisp/bytecomp.el | 18 ++++++++++++++++-- src/ChangeLog | 4 ++++ src/eval.c | 7 ++++--- 4 files changed, 28 insertions(+), 5 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 87794ceb5d2..7e3982a5a70 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2010-12-27 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-track-mouse): Don't use #'. + 2010-12-15 Stefan Monnier * emacs-lisp/edebug.el (edebug-eval-defun, edebug-eval): diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 0f7018b9b64..82b5ed3367d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -441,6 +441,7 @@ specify different fields to sort on." ;(defvar byte-compile-debug nil) (defvar byte-compile-debug t) +(setq debug-on-error t) ;; (defvar byte-compile-overwrite-file t ;; "If nil, old .elc files are deleted before the new is saved, and .elc @@ -4084,8 +4085,21 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." (defun byte-compile-track-mouse (form) (byte-compile-form - `(funcall #'(lambda nil - (track-mouse ,@(byte-compile-top-level-body (cdr form))))))) + ;; Use quote rather that #' here, because we don't want to go + ;; through the body again, which would lead to an infinite recursion: + ;; "byte-compile-track-mouse" (0xbffc98e4) + ;; "byte-compile-form" (0xbffc9c54) + ;; "byte-compile-top-level" (0xbffc9fd4) + ;; "byte-compile-lambda" (0xbffca364) + ;; "byte-compile-closure" (0xbffca6d4) + ;; "byte-compile-function-form" (0xbffcaa44) + ;; "byte-compile-form" (0xbffcadc0) + ;; "mapc" (0xbffcaf74) + ;; "byte-compile-funcall" (0xbffcb2e4) + ;; "byte-compile-form" (0xbffcb654) + ;; "byte-compile-track-mouse" (0xbffcb9d4) + `(funcall '(lambda nil + (track-mouse ,@(byte-compile-top-level-body (cdr form))))))) (defun byte-compile-condition-case (form) (let* ((var (nth 1 form)) diff --git a/src/ChangeLog b/src/ChangeLog index 2de6a5ed66c..f7a3fcc8b1b 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,7 @@ +2010-12-27 Stefan Monnier + + * eval.c (Fdefvar): Record specialness before computing initial value. + 2010-12-15 Stefan Monnier * eval.c (Feval): Add `lexical' argument. Adjust callers. diff --git a/src/eval.c b/src/eval.c index 7104a8a8396..36acca01c8b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -855,6 +855,10 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) tem = Fdefault_boundp (sym); if (!NILP (tail)) { + if (SYMBOLP (sym)) + /* Do it before evaluating the initial value, for self-references. */ + XSYMBOL (sym)->declared_special = 1; + if (SYMBOL_CONSTANT_P (sym)) { /* For upward compatibility, allow (defvar :foo (quote :foo)). */ @@ -893,9 +897,6 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) Fput (sym, Qvariable_documentation, tem); } LOADHIST_ATTACH (sym); - - if (SYMBOLP (sym)) - XSYMBOL (sym)->declared_special = 1; } else if (!NILP (Vinternal_interpreter_environment) && !XSYMBOL (sym)->declared_special) From 94d11cb5773b3b37367ee3c4885a374ff129d475 Mon Sep 17 00:00:00 2001 From: Igor Kuzmin Date: Thu, 10 Feb 2011 13:53:49 -0500 Subject: [PATCH 10/45] * lisp/emacs-lisp/cconv.el: New file. * lisp/emacs-lisp/bytecomp.el: Use cconv. (byte-compile-file-form, byte-compile): Call cconv-closure-convert-toplevel when requested. * lisp/server.el: * lisp/mpc.el: * lisp/emacs-lisp/pcase.el: * lisp/doc-view.el: * lisp/dired.el: Use lexical-binding. --- lisp/ChangeLog | 12 + lisp/dired.el | 1 + lisp/doc-view.el | 41 +- lisp/emacs-lisp/bytecomp.el | 11 +- lisp/emacs-lisp/cconv.el | 891 ++++++++++++++++++++++++++++++++++++ lisp/emacs-lisp/pcase.el | 18 +- lisp/mpc.el | 33 +- lisp/server.el | 320 +++++++------ 8 files changed, 1109 insertions(+), 218 deletions(-) create mode 100644 lisp/emacs-lisp/cconv.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7e3982a5a70..c137860013b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2011-02-10 Igor Kuzmin + + * emacs-lisp/cconv.el: New file. + * emacs-lisp/bytecomp.el: Use cconv. + (byte-compile-file-form, byte-compile): + Call cconv-closure-convert-toplevel when requested. + * server.el: + * mpc.el: + * emacs-lisp/pcase.el: + * doc-view.el: + * dired.el: Use lexical-binding. + 2010-12-27 Stefan Monnier * emacs-lisp/bytecomp.el (byte-compile-track-mouse): Don't use #'. diff --git a/lisp/dired.el b/lisp/dired.el index 02d855a0d33..f98ad641fe3 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1,3 +1,4 @@ +;;; -*- lexical-binding: t -*- ;;; dired.el --- directory-browsing commands ;; Copyright (C) 1985-1986, 1992-1997, 2000-2011 diff --git a/lisp/doc-view.el b/lisp/doc-view.el index c67205fd52b..4f8c338409b 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1,3 +1,4 @@ +;;; -*- lexical-binding: t -*- ;;; doc-view.el --- View PDF/PostScript/DVI files in Emacs ;; Copyright (C) 2007-2011 Free Software Foundation, Inc. @@ -155,7 +156,7 @@ (defcustom doc-view-ghostscript-options '("-dSAFER" ;; Avoid security problems when rendering files from untrusted - ;; sources. + ;; sources. "-dNOPAUSE" "-sDEVICE=png16m" "-dTextAlphaBits=4" "-dBATCH" "-dGraphicsAlphaBits=4" "-dQUIET") "A list of options to give to ghostscript." @@ -442,9 +443,7 @@ Can be `dvi', `pdf', or `ps'.") doc-view-current-converter-processes) ;; The PNG file hasn't been generated yet. (doc-view-pdf->png-1 doc-view-buffer-file-name file page - (lexical-let ((page page) - (win (selected-window)) - (file file)) + (let ((win (selected-window))) (lambda () (and (eq (current-buffer) (window-buffer win)) ;; If we changed page in the mean @@ -453,7 +452,7 @@ Can be `dvi', `pdf', or `ps'.") ;; Make sure we don't infloop. (file-readable-p file) (with-selected-window win - (doc-view-goto-page page)))))))) + (doc-view-goto-page page)))))))) (overlay-put (doc-view-current-overlay) 'help-echo (doc-view-current-info)))) @@ -713,8 +712,8 @@ Should be invoked when the cached images aren't up-to-date." (if (and doc-view-dvipdf-program (executable-find doc-view-dvipdf-program)) (doc-view-start-process "dvi->pdf" doc-view-dvipdf-program - (list dvi pdf) - callback) + (list dvi pdf) + callback) (doc-view-start-process "dvi->pdf" doc-view-dvipdfm-program (list "-o" pdf dvi) callback))) @@ -735,7 +734,7 @@ is named like ODF with the extension turned to pdf." (list (format "-r%d" (round doc-view-resolution)) (concat "-sOutputFile=" png) pdf-ps)) - (lexical-let ((resolution doc-view-resolution)) + (let ((resolution doc-view-resolution)) (lambda () ;; Only create the resolution file when it's all done, so it also ;; serves as a witness that the conversion is complete. @@ -780,7 +779,7 @@ Start by converting PAGES, and then the rest." ;; (almost) consecutive, but since in 99% of the cases, there'll be only ;; a single page anyway, and of the remaining 1%, few cases will have ;; consecutive pages, it's not worth the trouble. - (lexical-let ((pdf pdf) (png png) (rest (cdr pages))) + (let ((rest (cdr pages))) (doc-view-pdf->png-1 pdf (format png (car pages)) (car pages) (lambda () @@ -793,8 +792,8 @@ Start by converting PAGES, and then the rest." ;; not sufficient. (dolist (win (get-buffer-window-list (current-buffer) nil 'visible)) (with-selected-window win - (when (stringp (get-char-property (point-min) 'display)) - (doc-view-goto-page (doc-view-current-page))))) + (when (stringp (get-char-property (point-min) 'display)) + (doc-view-goto-page (doc-view-current-page))))) ;; Convert the rest of the pages. (doc-view-pdf/ps->png pdf png))))))) @@ -816,10 +815,8 @@ Start by converting PAGES, and then the rest." (ps ;; Doc is a PS, so convert it to PDF (which will be converted to ;; TXT thereafter). - (lexical-let ((pdf (expand-file-name "doc.pdf" - (doc-view-current-cache-dir))) - (txt txt) - (callback callback)) + (let ((pdf (expand-file-name "doc.pdf" + (doc-view-current-cache-dir)))) (doc-view-ps->pdf doc-view-buffer-file-name pdf (lambda () (doc-view-pdf->txt pdf txt callback))))) (dvi @@ -873,9 +870,7 @@ Those files are saved in the directory given by the function (dvi ;; DVI files have to be converted to PDF before Ghostscript can process ;; it. - (lexical-let - ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir)) - (png-file png-file)) + (let ((pdf (expand-file-name "doc.pdf" doc-view-current-cache-dir))) (doc-view-dvi->pdf doc-view-buffer-file-name pdf (lambda () (doc-view-pdf/ps->png pdf png-file))))) (odf @@ -1026,8 +1021,8 @@ have the page we want to view." (and (not (member pagefile prev-pages)) (member pagefile doc-view-current-files))) (with-selected-window win - (assert (eq (current-buffer) buffer)) - (doc-view-goto-page page)))))))) + (assert (eq (current-buffer) buffer)) + (doc-view-goto-page page)))))))) (defun doc-view-buffer-message () ;; Only show this message initially, not when refreshing the buffer (in which @@ -1470,9 +1465,9 @@ See the command `doc-view-mode' for more information on this mode." (when (not (eq major-mode 'doc-view-mode)) (doc-view-toggle-display)) (with-selected-window - (or (get-buffer-window (current-buffer) 0) - (selected-window)) - (doc-view-goto-page page))))) + (or (get-buffer-window (current-buffer) 0) + (selected-window)) + (doc-view-goto-page page))))) (provide 'doc-view) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index be3e1ed617c..b258524b45f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -119,6 +119,7 @@ (require 'backquote) (require 'macroexp) +(require 'cconv) (eval-when-compile (require 'cl)) (or (fboundp 'defsubst) @@ -2238,6 +2239,8 @@ list that represents a doc string reference. (let ((byte-compile-current-form nil) ; close over this for warnings. bytecomp-handler) (setq form (macroexpand-all form byte-compile-macro-environment)) + (if lexical-binding + (setq form (cconv-closure-convert-toplevel form))) (cond ((not (consp form)) (byte-compile-keep-pending form)) ((and (symbolp (car form)) @@ -2585,9 +2588,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." (setq fun (cdr fun))) (cond ((eq (car-safe fun) 'lambda) ;; expand macros - (setq fun - (macroexpand-all fun - byte-compile-initial-macro-environment)) + (setq fun + (macroexpand-all fun + byte-compile-initial-macro-environment)) + (if lexical-binding + (setq fun (cconv-closure-convert-toplevel fun))) ;; get rid of the `function' quote added by the `lambda' macro (setq fun (cadr fun)) (setq fun (if macro diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el new file mode 100644 index 00000000000..ddcc7882d82 --- /dev/null +++ b/lisp/emacs-lisp/cconv.el @@ -0,0 +1,891 @@ +;;; -*- lexical-binding: t -*- +;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. + +;; licence stuff will be added later(I don't know yet what to write here) + +;;; Commentary: + +;; This takes a piece of Elisp code, and eliminates all free variables from +;; lambda expressions. The user entry points are cconv-closure-convert and +;; cconv-closure-convert-toplevel(for toplevel forms). +;; All macros should be expanded. +;; +;; Here is a brief explanation how this code works. +;; Firstly, we analyse the tree by calling cconv-analyse-form. +;; This function finds all mutated variables, all functions that are suitable +;; for lambda lifting and all variables captured by closure. It passes the tree +;; once, returning a list of three lists. +;; +;; Then we calculate the intersection of first and third lists returned by +;; cconv-analyse form to find all mutated variables that are captured by +;; closure. + +;; Armed with this data, we call cconv-closure-convert-rec, that rewrites the +;; tree recursivly, lifting lambdas where possible, building closures where it +;; is needed and eliminating mutable variables used in closure. +;; +;; We do following replacements : +;; (lambda (v1 ...) ... fv1 fv2 ...) => (lambda (v1 ... fv1 fv2 ) ... fv1 fv2 .) +;; if the function is suitable for lambda lifting (if all calls are known) +;; +;; (function (lambda (v1 ...) ... fv ...)) => +;; (curry (lambda (env v1 ...) ... env ...) env) +;; if the function has only 1 free variable +;; +;; and finally +;; (function (lambda (v1 ...) ... fv1 fv2 ...)) => +;; (curry (lambda (env v1 ..) .. (aref env 0) (aref env 1) ..) (vector fv1 fv2)) +;; if the function has 2 or more free variables +;; +;; If the function has no free variables, we don't do anything. +;; +;; If the variable is mutable(updated by setq), and it is used in closure +;; we wrap it's definition with list: (list var) and we also replace +;; var => (car var) wherever this variable is used, and also +;; (setq var value) => (setcar var value) where it is updated. +;; +;; If defun argument is closure mutable, we letbind it and wrap it's +;; definition with list. +;; (defun foo (... mutable-arg ...) ...) => +;; (defun foo (... m-arg ...) (let ((m-arg (list m-arg))) ...)) +;; +;; +;; +;; +;; +;;; Code: + +(require 'pcase) +(eval-when-compile (require 'cl)) + +(defconst cconv-liftwhen 3 + "Try to do lambda lifting if the number of arguments + free variables +is less than this number.") +(defvar cconv-mutated + "List of mutated variables in current form") +(defvar cconv-captured + "List of closure captured variables in current form") +(defvar cconv-captured+mutated + "An intersection between cconv-mutated and cconv-captured lists.") +(defvar cconv-lambda-candidates + "List of candidates for lambda lifting") + + + +(defun cconv-freevars (form &optional fvrs) + "Find all free variables of given form. +Arguments: +-- FORM is a piece of Elisp code after macroexpansion. +-- FVRS(optional) is a list of variables already found. Used for recursive tree +traversal + +Returns a list of free variables." + ;; If a leaf in the tree is a symbol, but it is not a global variable, not a + ;; keyword, not 'nil or 't we consider this leaf as a variable. + ;; Free variables are the variables that are not declared above in this tree. + ;; For example free variables of (lambda (a1 a2 ..) body-forms) are + ;; free variables of body-forms excluding a1, a2 .. + ;; Free variables of (let ((v1 ..) (v2) ..)) body-forms) are + ;; free variables of body-forms excluding v1, v2 ... + ;; and so on. + + ;; a list of free variables already found(FVRS) is passed in parameter + ;; to try to use cons or push where possible, and to minimize the usage + ;; of append + + ;; This function can contain duplicates(because we use 'append instead + ;; of union of two sets - for performance reasons). + (pcase form + (`(let ,varsvalues . ,body-forms) ; let special form + (let ((fvrs-1 '())) + (dolist (exp body-forms) + (setq fvrs-1 (cconv-freevars exp fvrs-1))) + (dolist (elm varsvalues) + (if (listp elm) + (setq fvrs-1 (delq (car elm) fvrs-1)) + (setq fvrs-1 (delq elm fvrs-1)))) + (setq fvrs (append fvrs fvrs-1)) + (dolist (exp varsvalues) + (when (listp exp) (setq fvrs (cconv-freevars (cadr exp) fvrs)))) + fvrs)) + + (`(let* ,varsvalues . ,body-forms) ; let* special form + (let ((vrs '()) + (fvrs-1 '())) + (dolist (exp varsvalues) + (if (listp exp) + (progn + (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1)) + (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) + (push (car exp) vrs)) + (progn + (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) + (push exp vrs)))) + (dolist (exp body-forms) + (setq fvrs-1 (cconv-freevars exp fvrs-1))) + (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) + (append fvrs fvrs-1))) + + (`((lambda . ,_) . ,_) ; first element is lambda expression + (dolist (exp `((function ,(car form)) . ,(cdr form))) + (setq fvrs (cconv-freevars exp fvrs))) fvrs) + + (`(cond . ,cond-forms) ; cond special form + (dolist (exp1 cond-forms) + (dolist (exp2 exp1) + (setq fvrs (cconv-freevars exp2 fvrs)))) fvrs) + + (`(quote . ,_) fvrs) ; quote form + + (`(function . ((lambda ,vars . ,body-forms))) + (let ((functionform (cadr form)) (fvrs-1 '())) + (dolist (exp body-forms) + (setq fvrs-1 (cconv-freevars exp fvrs-1))) + (dolist (elm vars) (setq fvrs-1 (delq elm fvrs-1))) + (append fvrs fvrs-1))) ; function form + + (`(function . ,_) fvrs) ; same as quote + ;condition-case + (`(condition-case ,var ,protected-form . ,conditions-bodies) + (let ((fvrs-1 '())) + (setq fvrs-1 (cconv-freevars protected-form '())) + (dolist (exp conditions-bodies) + (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1))) + (setq fvrs-1 (delq var fvrs-1)) + (append fvrs fvrs-1))) + + (`(,(and sym (or `defun `defconst `defvar)) . ,_) + ;; we call cconv-freevars only for functions(lambdas) + ;; defun, defconst, defvar are not allowed to be inside + ;; a function(lambda) + (error "Invalid form: %s inside a function" sym)) + + (`(,_ . ,body-forms) ; first element is a function or whatever + (dolist (exp body-forms) + (setq fvrs (cconv-freevars exp fvrs))) fvrs) + + (_ (if (or (not (symbolp form)) ; form is not a list + (special-variable-p form) + (memq form '(nil t)) + (keywordp form)) + fvrs + (cons form fvrs))))) + +;;;###autoload +(defun cconv-closure-convert (form &optional toplevel) + ;; cconv-closure-convert-rec has a lot of parameters that are + ;; whether useless for user, whether they should contain + ;; specific data like a list of closure mutables or the list + ;; of lambdas suitable for lifting. + ;; + ;; That's why this function exists. + "Main entry point for non-toplevel forms. +-- FORM is a piece of Elisp code after macroexpansion. +-- TOPLEVEL(optional) is a boolean variable, true if we are at the root of AST + +Returns a form where all lambdas don't have any free variables." + (let ((cconv-mutated '()) + (cconv-lambda-candidates '()) + (cconv-captured '()) + (cconv-captured+mutated '())) + ;; Analyse form - fill these variables with new information + (cconv-analyse-form form '() nil) + ;; Calculate an intersection of cconv-mutated and cconv-captured + (dolist (mvr cconv-mutated) + (when (memq mvr cconv-captured) ; + (push mvr cconv-captured+mutated))) + (cconv-closure-convert-rec + form ; the tree + '() ; + '() ; fvrs initially empty + '() ; envs initially empty + '() + toplevel))) ; true if the tree is a toplevel form + +;;;###autoload +(defun cconv-closure-convert-toplevel (form) + "Entry point for toplevel forms. +-- FORM is a piece of Elisp code after macroexpansion. + +Returns a form where all lambdas don't have any free variables." + ;; we distinguish toplevel forms to treat def(un|var|const) correctly. + (cconv-closure-convert form t)) + +(defun cconv-closure-convert-rec + (form emvrs fvrs envs lmenvs defs-are-legal) + ;; This function actually rewrites the tree. + "Eliminates all free variables of all lambdas in given forms. +Arguments: +-- FORM is a piece of Elisp code after macroexpansion. +-- LMENVS is a list of environments used for lambda-lifting. Initially empty. +-- EMVRS is a list that contains mutated variables that are visible +within current environment. +-- ENVS is an environment(list of free variables) of current closure. +Initially empty. +-- FVRS is a list of variables to substitute in each context. +Initially empty. +-- DEFS-ARE-LEGAL is a boolean variable, true if def(un|var|const) +can be used in this form(e.g. toplevel form) + +Returns a form where all lambdas don't have any free variables." + ;; What's the difference between fvrs and envs? + ;; Suppose that we have the code + ;; (lambda (..) fvr (let ((fvr 1)) (+ fvr 1))) + ;; only the first occurrence of fvr should be replaced by + ;; (aref env ...). + ;; So initially envs and fvrs are the same thing, but when we descend to + ;; the 'let, we delete fvr from fvrs. Why we don't delete fvr from envs? + ;; Because in envs the order of variables is important. We use this list + ;; to find the number of a specific variable in the environment vector, + ;; so we never touch it(unless we enter to the other closure). +;;(if (listp form) (print (car form)) form) + (pcase form + (`(,(and letsym (or `let* `let)) ,varsvalues . ,body-forms) + + ; let and let* special forms + (let ((body-forms-new '()) + (varsvalues-new '()) + ;; next for variables needed for delayed push + ;; because we should process + ;; before we change any arguments + (lmenvs-new '()) ;needed only in case of let + (emvrs-new '()) ;needed only in case of let + (emvr-push) ;needed only in case of let* + (lmenv-push)) ;needed only in case of let* + + (dolist (elm varsvalues) ;begin of dolist over varsvalues + (let (var value elm-new iscandidate ismutated) + (if (listp elm) ; (let (v1) ...) => (let ((v1 nil)) ...) + (progn + (setq var (car elm)) + (setq value (cadr elm))) + (setq var elm)) + + ;; Check if var is a candidate for lambda lifting + (let ((lcandid cconv-lambda-candidates)) + (while (and lcandid (not iscandidate)) + (when (and (eq (caar lcandid) var) + (eq (caddar lcandid) elm) + (eq (cadr (cddar lcandid)) form)) + (setq iscandidate t)) + (setq lcandid (cdr lcandid)))) + + ; declared variable is a candidate + ; for lambda lifting + (if iscandidate + (let* ((func (cadr elm)) ; function(lambda) itself + ; free variables + (fv (delete-dups (cconv-freevars func '()))) + (funcvars (append fv (cadadr func))) ;function args + (funcbodies (cddadr func)) ; function bodies + (funcbodies-new '())) + ; lambda lifting condition + (if (or (not fv) (< cconv-liftwhen (length funcvars))) + ; do not lift + (setq + elm-new + `(,var + ,(cconv-closure-convert-rec + func emvrs fvrs envs lmenvs nil))) + ; lift + (progn + (dolist (elm2 funcbodies) + (push ; convert function bodies + (cconv-closure-convert-rec + elm2 emvrs nil envs lmenvs nil) + funcbodies-new)) + (if (eq letsym 'let*) + (setq lmenv-push (cons var fv)) + (push (cons var fv) lmenvs-new)) + ; push lifted function + + (setq elm-new + `(,var + (function . + ((lambda ,funcvars . + ,(reverse funcbodies-new))))))))) + + ;declared variable is not a function + (progn + ;; Check if var is mutated + (let ((lmutated cconv-captured+mutated)) + (while (and lmutated (not ismutated)) + (when (and (eq (caar lmutated) var) + (eq (caddar lmutated) elm) + (eq (cadr (cddar lmutated)) form)) + (setq ismutated t)) + (setq lmutated (cdr lmutated)))) + (if ismutated + (progn ; declared variable is mutated + (setq elm-new + `(,var (list ,(cconv-closure-convert-rec + value emvrs + fvrs envs lmenvs nil)))) + (if (eq letsym 'let*) + (setq emvr-push var) + (push var emvrs-new))) + (progn + (setq + elm-new + `(,var ; else + ,(cconv-closure-convert-rec + value emvrs fvrs envs lmenvs nil))))))) + + ;; this piece of code below letbinds free + ;; variables of a lambda lifted function + ;; if they are redefined in this let + ;; example: + ;; (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1)) + ;; Here we can not pass y as parameter because it is + ;; redefined. We add a (closed-y y) declaration. + ;; We do that even if the function is not used inside + ;; this let(*). The reason why we ignore this case is + ;; that we can't "look forward" to see if the function + ;; is called there or not. To treat well this case we + ;; need to traverse the tree one more time to collect this + ;; data, and I think that it's not worth it. + + (when (eq letsym 'let*) + (let ((closedsym '()) + (new-lmenv '()) + (old-lmenv '())) + (dolist (lmenv lmenvs) + (when (memq var (cdr lmenv)) + (setq closedsym + (make-symbol + (concat "closed-" (symbol-name var)))) + (setq new-lmenv (list (car lmenv))) + (dolist (frv (cdr lmenv)) (if (eq frv var) + (push closedsym new-lmenv) + (push frv new-lmenv))) + (setq new-lmenv (reverse new-lmenv)) + (setq old-lmenv lmenv))) + (when new-lmenv + (setq lmenvs (remq old-lmenv lmenvs)) + (push new-lmenv lmenvs) + (push `(,closedsym ,var) varsvalues-new)))) + ;; we push the element after redefined free variables + ;; are processes. this is important to avoid the bug + ;; when free variable and the function have the same + ;; name + (push elm-new varsvalues-new) + + (when (eq letsym 'let*) ; update fvrs + (setq fvrs (remq var fvrs)) + (setq emvrs (remq var emvrs)) ; remove if redefined + (when emvr-push + (push emvr-push emvrs) + (setq emvr-push nil)) + (let (lmenvs-1) ; remove var from lmenvs if redefined + (dolist (iter lmenvs) + (when (not (assq var lmenvs)) + (push iter lmenvs-1))) + (setq lmenvs lmenvs-1)) + (when lmenv-push + (push lmenv-push lmenvs) + (setq lmenv-push nil))) + )) ; end of dolist over varsvalues + (when (eq letsym 'let) + + (let (var fvrs-1 emvrs-1 lmenvs-1) + ;; Here we update emvrs, fvrs and lmenvs lists + (dolist (vr fvrs) + ; safely remove + (when (not (assq vr varsvalues-new)) (push vr fvrs-1))) + (setq fvrs fvrs-1) + (dolist (vr emvrs) + ; safely remove + (when (not (assq vr varsvalues-new)) (push vr emvrs-1))) + (setq emvrs emvrs-1) + ; push new + (setq emvrs (append emvrs emvrs-new)) + (dolist (vr lmenvs) + (when (not (assq (car vr) varsvalues-new)) + (push vr lmenvs-1))) + (setq lmenvs (append lmenvs lmenvs-new))) + + ;; Here we do the same letbinding as for let* above + ;; to avoid situation when a free variable of a lambda lifted + ;; function got redefined. + + (let ((new-lmenv) + (var nil) + (closedsym nil) + (letbinds '()) + (fvrs-new)) ; list of (closed-var var) + (dolist (elm varsvalues) + (if (listp elm) + (setq var (car elm)) + (setq var elm)) + + (let ((lmenvs-1 lmenvs)) ; just to avoid manipulating + (dolist (lmenv lmenvs-1) ; the counter inside the loop + (when (memq var (cdr lmenv)) + (setq closedsym (make-symbol + (concat "closed-" + (symbol-name var)))) + + (setq new-lmenv (list (car lmenv))) + (dolist (frv (cdr lmenv)) (if (eq frv var) + (push closedsym new-lmenv) + (push frv new-lmenv))) + (setq new-lmenv (reverse new-lmenv)) + (setq lmenvs (remq lmenv lmenvs)) + (push new-lmenv lmenvs) + (push `(,closedsym ,var) letbinds) + )))) + (setq varsvalues-new (append varsvalues-new letbinds)))) + + (dolist (elm body-forms) ; convert body forms + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + body-forms-new)) + `(,letsym ,(reverse varsvalues-new) . ,(reverse body-forms-new)))) + ;end of let let* forms + + ; first element is lambda expression + (`(,(and `(lambda . ,_) fun) . ,other-body-forms) + + (let ((other-body-forms-new '())) + (dolist (elm other-body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + other-body-forms-new)) + (cons + (cadr + (cconv-closure-convert-rec + (list 'function fun) emvrs fvrs envs lmenvs nil)) + (reverse other-body-forms-new)))) + + (`(cond . ,cond-forms) ; cond special form + (let ((cond-forms-new '())) + (dolist (elm cond-forms) + (push (let ((elm-new '())) + (dolist (elm-2 elm) + (push + (cconv-closure-convert-rec + elm-2 emvrs fvrs envs lmenvs nil) + elm-new)) + (reverse elm-new)) + cond-forms-new)) + (cons 'cond + (reverse cond-forms-new)))) + + (`(quote . ,_) form) ; quote form + + (`(function . ((lambda ,vars . ,body-forms))) ; function form + (let (fvrs-new) ; we remove vars from fvrs + (dolist (elm fvrs) ;i use such a tricky way to avoid side effects + (when (not (memq elm vars)) + (push elm fvrs-new))) + (setq fvrs fvrs-new)) + (let* ((fv (delete-dups (cconv-freevars form '()))) + (leave fvrs) ; leave = non nil if we should leave env unchanged + (body-forms-new '()) + (letbind '()) + (mv nil) + (envector nil)) + (when fv + ;; Here we form our environment vector. + ;; If outer closure contains all + ;; free variables of this function(and nothing else) + ;; then we use the same environment vector as for outer closure, + ;; i.e. we leave the environment vector unchanged + ;; otherwise we build a new environmet vector + (if (eq (length envs) (length fv)) + (let ((fv-temp fv)) + (while (and fv-temp leave) + (when (not (memq (car fv-temp) fvrs)) (setq leave nil)) + (setq fv-temp (cdr fv-temp)))) + (setq leave nil)) + + (if (not leave) + (progn + (dolist (elm fv) + (push + (cconv-closure-convert-rec + elm (remq elm emvrs) fvrs envs lmenvs nil) + envector)) ; process vars for closure vector + (setq envector (reverse envector)) + (setq envs fv)) + (setq envector `(env))) ; leave unchanged + (setq fvrs fv)) ; update substitution list + + ;; the difference between envs and fvrs is explained + ;; in comment in the beginning of the function + (dolist (elm cconv-captured+mutated) ; find mutated arguments + (setq mv (car elm)) ; used in inner closures + (when (and (memq mv vars) (eq form (caddr elm))) + (progn (push mv emvrs) + (push `(,mv (list ,mv)) letbind)))) + (dolist (elm body-forms) ; convert function body + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + body-forms-new)) + + (setq body-forms-new + (if letbind `((let ,letbind . ,(reverse body-forms-new))) + (reverse body-forms-new))) + + (cond + ;if no freevars - do nothing + ((null envector) + `(function (lambda ,vars . ,body-forms-new))) + ; 1 free variable - do not build vector + ((null (cdr envector)) + `(curry + (function (lambda (env . ,vars) . ,body-forms-new)) + ,(car envector))) + ; >=2 free variables - build vector + (t + `(curry + (function (lambda (env . ,vars) . ,body-forms-new)) + (vector . ,envector)))))) + + (`(function . ,_) form) ; same as quote + + ;defconst, defvar + (`(,(and sym (or `defconst `defvar)) ,definedsymbol . ,body-forms) + + (if defs-are-legal + (let ((body-forms-new '())) + (dolist (elm body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + body-forms-new)) + (setq body-forms-new (reverse body-forms-new)) + `(,sym ,definedsymbol . ,body-forms-new)) + (error "Invalid form: %s inside a function" sym))) + + ;defun, defmacro, defsubst + (`(,(and sym (or `defun `defmacro `defsubst)) + ,func ,vars . ,body-forms) + (if defs-are-legal + (let ((body-new '()) ; the whole body + (body-forms-new '()) ; body w\o docstring and interactive + (letbind '())) + ; find mutable arguments + (let ((lmutated cconv-captured+mutated) ismutated) + (dolist (elm vars) + (setq ismutated nil) + (while (and lmutated (not ismutated)) + (when (and (eq (caar lmutated) elm) + (eq (cadar lmutated) form)) + (setq ismutated t)) + (setq lmutated (cdr lmutated))) + (when ismutated + (push elm letbind) + (push elm emvrs)))) + ;transform body-forms + (when (stringp (car body-forms)) ; treat docstring well + (push (car body-forms) body-new) + (setq body-forms (cdr body-forms))) + (when (and (listp (car body-forms)) ; treat (interactive) well + (eq (caar body-forms) 'interactive)) + (push + (cconv-closure-convert-rec + (car body-forms) + emvrs fvrs envs lmenvs nil) body-new) + (setq body-forms (cdr body-forms))) + + (dolist (elm body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + body-forms-new)) + (setq body-forms-new (reverse body-forms-new)) + + (if letbind + ; letbind mutable arguments + (let ((varsvalues-new '())) + (dolist (elm letbind) (push `(,elm (list ,elm)) + varsvalues-new)) + (push `(let ,(reverse varsvalues-new) . + ,body-forms-new) body-new) + (setq body-new (reverse body-new))) + (setq body-new (append (reverse body-new) body-forms-new))) + + `(,sym ,func ,vars . ,body-new)) + + (error "Invalid form: defun inside a function"))) + ;condition-case + (`(condition-case ,var ,protected-form . ,conditions-bodies) + (let ((conditions-bodies-new '())) + (setq fvrs (remq var fvrs)) + (dolist (elm conditions-bodies) + (push (let ((elm-new '())) + (dolist (elm-2 (cdr elm)) + (push + (cconv-closure-convert-rec + elm-2 emvrs fvrs envs lmenvs nil) + elm-new)) + (cons (car elm) (reverse elm-new))) + conditions-bodies-new)) + `(condition-case + ,var + ,(cconv-closure-convert-rec + protected-form emvrs fvrs envs lmenvs nil) + . ,(reverse conditions-bodies-new)))) + + (`(setq . ,forms) ; setq special form + (let (prognlist sym sym-new value) + (while forms + (setq sym (car forms)) + (setq sym-new (cconv-closure-convert-rec + sym + (remq sym emvrs) fvrs envs lmenvs nil)) + (setq value + (cconv-closure-convert-rec + (cadr forms) emvrs fvrs envs lmenvs nil)) + (if (memq sym emvrs) + (push `(setcar ,sym-new ,value) prognlist) + (if (symbolp sym-new) + (push `(setq ,sym-new ,value) prognlist) + (push `(set ,sym-new ,value) prognlist))) + (setq forms (cddr forms))) + (if (cdr prognlist) + `(progn . ,(reverse prognlist)) + (car prognlist)))) + + (`(,(and (or `funcall `apply) callsym) ,fun . ,args) + ; funcall is not a special form + ; but we treat it separately + ; for the needs of lambda lifting + (let ((fv (cdr (assq fun lmenvs)))) + (if fv + (let ((args-new '()) + (processed-fv '())) + ;; All args (free variables and actual arguments) + ;; should be processed, because they can be fvrs + ;; (free variables of another closure) + (dolist (fvr fv) + (push (cconv-closure-convert-rec + fvr (remq fvr emvrs) + fvrs envs lmenvs nil) + processed-fv)) + (setq processed-fv (reverse processed-fv)) + (dolist (elm args) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + args-new)) + (setq args-new (append processed-fv (reverse args-new))) + (setq fun (cconv-closure-convert-rec + fun emvrs fvrs envs lmenvs nil)) + `(,callsym ,fun . ,args-new)) + (let ((cdr-new '())) + (dolist (elm (cdr form)) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + cdr-new)) + `(,callsym . ,(reverse cdr-new)))))) + + (`(,func . ,body-forms) ; first element is function or whatever + ; function-like forms are: + ; or, and, if, progn, prog1, prog2, + ; while, until + (let ((body-forms-new '())) + (dolist (elm body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs defs-are-legal) + body-forms-new)) + (setq body-forms-new (reverse body-forms-new)) + `(,func . ,body-forms-new))) + + (_ + (if (memq form fvrs) ;form is a free variable + (let* ((numero (position form envs)) + (var '())) + (assert numero) + (if (null (cdr envs)) + (setq var 'env) + ;replace form => + ;(aref env #) + (setq var `(aref env ,numero))) + (if (memq form emvrs) ; form => (car (aref env #)) if mutable + `(car ,var) + var)) + (if (memq form emvrs) ; if form is a mutable variable + `(car ,form) ; replace form => (car form) + form))))) + +(defun cconv-analyse-form (form vars inclosure) + + "Find mutated variables and variables captured by closure. Analyse +lambdas if they are suitable for lambda lifting. +-- FORM is a piece of Elisp code after macroexpansion. +-- MLCVRS is a structure that contains captured and mutated variables. + (first MLCVRS) is a list of mutated variables, (second MLCVRS) is a +list of candidates for lambda lifting and (third MLCVRS) is a list of +variables captured by closure. It should be (nil nil nil) initially. +-- VARS is a list of local variables visible in current environment + (initially empty). +-- INCLOSURE is a boolean variable, true if we are in closure. +Initially false" + (pcase form + ; let special form + (`(,(and (or `let* `let) letsym) ,varsvalues . ,body-forms) + + (when (eq letsym 'let) + (dolist (elm varsvalues) ; analyse values + (when (listp elm) + (cconv-analyse-form (cadr elm) vars inclosure)))) + + (let ((v nil) + (var nil) + (value nil) + (varstruct nil)) + (dolist (elm varsvalues) + (if (listp elm) + (progn + (setq var (car elm)) + (setq value (cadr elm))) + (progn + (setq var elm) ; treat the form (let (x) ...) well + (setq value nil))) + + (when (eq letsym 'let*) ; analyse value + (cconv-analyse-form value vars inclosure)) + + (let (vars-new) ; remove the old var + (dolist (vr vars) + (when (not (eq (car vr) var)) + (push vr vars-new))) + (setq vars vars-new)) + + (setq varstruct (list var inclosure elm form)) + (push varstruct vars) ; push a new one + + (when (and (listp value) + (eq (car value) 'function) + (eq (caadr value) 'lambda)) + ; if var is a function + ; push it to lambda list + (push varstruct cconv-lambda-candidates)))) + + (dolist (elm body-forms) ; analyse body forms + (cconv-analyse-form elm vars inclosure)) + nil) + ; defun special form + (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms) + (let ((v nil)) + (dolist (vr vrs) + (push (list vr form) vars))) ;push vrs to vars + (dolist (elm body-forms) ; analyse body forms + (cconv-analyse-form elm vars inclosure)) + nil) + + (`(function . ((lambda ,vrs . ,body-forms))) + (if inclosure ;we are in closure + (setq inclosure (+ inclosure 1)) + (setq inclosure 1)) + (let (vars-new) ; update vars + (dolist (vr vars) ; we do that in such a tricky way + (when (not (memq (car vr) vrs)) ; to avoid side effects + (push vr vars-new))) + (dolist (vr vrs) + (push (list vr inclosure form) vars-new)) + (setq vars vars-new)) + + (dolist (elm body-forms) + (cconv-analyse-form elm vars inclosure)) + nil) + + (`(setq . ,forms) ; setq + ; if a local variable (member of vars) + ; is modified by setq + ; then it is a mutated variable + (while forms + (let ((v (assq (car forms) vars))) ; v = non nil if visible + (when v + (push v cconv-mutated) + ;; delete from candidate list for lambda lifting + (setq cconv-lambda-candidates (delq v cconv-lambda-candidates)) + (when inclosure + ;; test if v is declared as argument for lambda + (let* ((thirdv (third v)) + (isarg (if (listp thirdv) + (eq (car thirdv) 'function) nil))) + (if isarg + (when (> inclosure (cadr v)) ; when we are in closure + (push v cconv-captured)) ; push it to captured vars + ;; FIXME more detailed comments needed + (push v cconv-captured)))))) + (cconv-analyse-form (cadr forms) vars inclosure) + (setq forms (cddr forms))) + nil) + + (`((lambda . ,_) . ,_) ; first element is lambda expression + (dolist (exp `((function ,(car form)) . ,(cdr form))) + (cconv-analyse-form exp vars inclosure)) + nil) + + (`(cond . ,cond-forms) ; cond special form + (dolist (exp1 cond-forms) + (dolist (exp2 exp1) + (cconv-analyse-form exp2 vars inclosure))) + nil) + + (`(quote . ,_) nil) ; quote form + + (`(function . ,_) nil) ; same as quote + + (`(condition-case ,var ,protected-form . ,conditions-bodies) + ;condition-case + (cconv-analyse-form protected-form vars inclosure) + (dolist (exp conditions-bodies) + (cconv-analyse-form (cadr exp) vars inclosure)) + nil) + + (`(,(or `defconst `defvar `defsubst) ,value) + (cconv-analyse-form value vars inclosure)) + + (`(,(or `funcall `apply) ,fun . ,args) + ;; Here we ignore fun because + ;; funcall and apply are the only two + ;; functions where we can pass a candidate + ;; for lambda lifting as argument. + ;; So, if we see fun elsewhere, we'll + ;; delete it from lambda candidate list. + + ;; If this funcall and the definition of fun + ;; are in different closures - we delete fun from + ;; canidate list, because it is too complicated + ;; to manage free variables in this case. + (let ((lv (assq fun cconv-lambda-candidates))) + (when lv + (when (not (eq (cadr lv) inclosure)) + (setq cconv-lambda-candidates + (delq lv cconv-lambda-candidates))))) + + (dolist (elm args) + (cconv-analyse-form elm vars inclosure)) + nil) + + (`(,_ . ,body-forms) ; first element is a function or whatever + (dolist (exp body-forms) + (cconv-analyse-form exp vars inclosure)) + nil) + + (_ + (when (and (symbolp form) + (not (memq form '(nil t))) + (not (keywordp form)) + (not (special-variable-p form))) + (let ((dv (assq form vars))) ; dv = declared and visible + (when dv + (when inclosure + ;; test if v is declared as argument of lambda + (let* ((thirddv (third dv)) + (isarg (if (listp thirddv) + (eq (car thirddv) 'function) nil))) + (if isarg + ;; FIXME add detailed comments + (when (> inclosure (cadr dv)) ; capturing condition + (push dv cconv-captured)) + (push dv cconv-captured)))) + ; delete lambda + (setq cconv-lambda-candidates ; if it is found here + (delq dv cconv-lambda-candidates))))) + nil))) + +(provide 'cconv) +;;; cconv.el ends here diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 24ea0a3e801..7990df264a9 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -1,3 +1,4 @@ +;;; -*- lexical-binding: t -*- ;;; pcase.el --- ML-style pattern-matching macro for Elisp ;; Copyright (C) 2010-2011 Free Software Foundation, Inc. @@ -501,15 +502,14 @@ and otherwise defers to REST which is a list of branches of the form ;; `(PAT3 . PAT4)) which the programmer can easily rewrite ;; to the more efficient `(,(and PAT1 PAT3) . ,(and PAT2 PAT4))). (pcase--u1 `((match ,sym . ,(cadr upat))) - (lexical-let ((rest rest)) - ;; FIXME: This codegen is not careful to share its - ;; code if used several times: code blow up is likely. - (lambda (vars) - ;; `vars' will likely contain bindings which are - ;; not always available in other paths to - ;; `rest', so there' no point trying to pass - ;; them down. - (pcase--u rest))) + ;; FIXME: This codegen is not careful to share its + ;; code if used several times: code blow up is likely. + (lambda (vars) + ;; `vars' will likely contain bindings which are + ;; not always available in other paths to + ;; `rest', so there' no point trying to pass + ;; them down. + (pcase--u rest)) vars (list `((and . ,matches) ,code . ,vars)))) (t (error "Unknown upattern `%s'" upat))))) diff --git a/lisp/mpc.el b/lisp/mpc.el index 8feddf8829b..4f21a162c08 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1,3 +1,4 @@ +;;; -*- lexical-binding: t -*- ;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8 -*- ;; Copyright (C) 2006-2011 Free Software Foundation, Inc. @@ -341,9 +342,7 @@ CMD can be a string which is passed as-is to MPD or a list of strings which will be concatenated with proper quoting before passing them to MPD." (let ((proc (mpc-proc))) (if (and callback (not (process-get proc 'ready))) - (lexical-let ((old (process-get proc 'callback)) - (callback callback) - (cmd cmd)) + (let ((old (process-get proc 'callback))) (process-put proc 'callback (lambda () (funcall old) @@ -359,8 +358,7 @@ which will be concatenated with proper quoting before passing them to MPD." (mapconcat 'mpc--proc-quote-string cmd " ")) "\n"))) (if callback - (lexical-let ((buf (current-buffer)) - (callback callback)) + (let ((buf (current-buffer))) (process-put proc 'callback callback ;; (lambda () @@ -402,8 +400,7 @@ which will be concatenated with proper quoting before passing them to MPD." (defun mpc-proc-cmd-to-alist (cmd &optional callback) (if callback - (lexical-let ((buf (current-buffer)) - (callback callback)) + (let ((buf (current-buffer))) (mpc-proc-cmd cmd (lambda () (funcall callback (prog1 (mpc-proc-buf-to-alist (current-buffer)) @@ -522,7 +519,7 @@ to call FUN for any change whatsoever.") (defun mpc-status-refresh (&optional callback) "Refresh `mpc-status'." - (lexical-let ((cb callback)) + (let ((cb callback)) (mpc-proc-cmd (mpc-proc-cmd-list '("status" "currentsong")) (lambda () (mpc--status-callback) @@ -775,7 +772,7 @@ The songs are returned as alists." (defun mpc-cmd-pause (&optional arg callback) "Pause or resume playback of the queue of songs." - (lexical-let ((cb callback)) + (let ((cb callback)) (mpc-proc-cmd (list "pause" arg) (lambda () (mpc-status-refresh) (if cb (funcall cb)))) (unless callback (mpc-proc-sync)))) @@ -839,7 +836,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (puthash (cons 'Playlist playlist) nil mpc--find-memoize)))) (defun mpc-cmd-update (&optional arg callback) - (lexical-let ((cb callback)) + (let ((cb callback)) (mpc-proc-cmd (if arg (list "update" arg) "update") (lambda () (mpc-status-refresh) (if cb (funcall cb)))) (unless callback (mpc-proc-sync)))) @@ -2351,8 +2348,7 @@ This is used so that they can be compared with `eq', which is needed for (mpc-proc-cmd (list "seekid" songid time) 'mpc-status-refresh)))) (let ((status (mpc-cmd-status))) - (lexical-let* ((songid (cdr (assq 'songid status))) - (step step) + (let* ((songid (cdr (assq 'songid status))) (time (if songid (string-to-number (cdr (assq 'time status)))))) (let ((timer (run-with-timer @@ -2389,13 +2385,12 @@ This is used so that they can be compared with `eq', which is needed for (if mpc--faster-toggle-timer (mpc--faster-stop) (mpc-status-refresh) (mpc-proc-sync) - (lexical-let* ((speedup speedup) - songid ;The ID of the currently ffwd/rewinding song. - songnb ;The position of that song in the playlist. - songduration ;The duration of that song. - songtime ;The time of the song last time we ran. - oldtime ;The timeoftheday last time we ran. - prevsongid) ;The song we're in the process leaving. + (let* (songid ;The ID of the currently ffwd/rewinding song. + songnb ;The position of that song in the playlist. + songduration ;The duration of that song. + songtime ;The time of the song last time we ran. + oldtime ;The timeoftheday last time we ran. + prevsongid) ;The song we're in the process leaving. (let ((fun (lambda () (let ((newsongid (cdr (assq 'songid mpc-status))) diff --git a/lisp/server.el b/lisp/server.el index 62c59b41cee..1ee30f5bc3c 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -1,3 +1,4 @@ +;;; -*- lexical-binding: t -*- ;;; server.el --- Lisp code for GNU Emacs running as server process ;; Copyright (C) 1986-1987, 1992, 1994-2011 Free Software Foundation, Inc. @@ -335,9 +336,9 @@ If CLIENT is non-nil, add a description of it to the logged message." (goto-char (point-max)) (insert (funcall server-log-time-function) (cond - ((null client) " ") - ((listp client) (format " %s: " (car client))) - (t (format " %s: " client))) + ((null client) " ") + ((listp client) (format " %s: " (car client))) + (t (format " %s: " client))) string) (or (bolp) (newline))))) @@ -355,7 +356,7 @@ If CLIENT is non-nil, add a description of it to the logged message." (and (process-contact proc :server) (eq (process-status proc) 'closed) (ignore-errors - (delete-file (process-get proc :server-file)))) + (delete-file (process-get proc :server-file)))) (server-log (format "Status changed to %s: %s" (process-status proc) msg) proc) (server-delete-client proc)) @@ -410,10 +411,10 @@ If CLIENT is non-nil, add a description of it to the logged message." proc ;; See if this is the last frame for this client. (>= 1 (let ((frame-num 0)) - (dolist (f (frame-list)) - (when (eq proc (frame-parameter f 'client)) - (setq frame-num (1+ frame-num)))) - frame-num))) + (dolist (f (frame-list)) + (when (eq proc (frame-parameter f 'client)) + (setq frame-num (1+ frame-num)))) + frame-num))) (server-log (format "server-handle-delete-frame, frame %s" frame) proc) (server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later. @@ -534,8 +535,8 @@ To force-start a server, do \\[server-force-delete] and then (if (not (eq t (server-running-p server-name))) ;; Remove any leftover socket or authentication file (ignore-errors - (let (delete-by-moving-to-trash) - (delete-file server-file))) + (let (delete-by-moving-to-trash) + (delete-file server-file))) (setq server-mode nil) ;; already set by the minor mode code (display-warning 'server @@ -590,11 +591,11 @@ server or call `M-x server-force-delete' to forcibly disconnect it.") (when server-use-tcp (let ((auth-key (loop - ;; The auth key is a 64-byte string of random chars in the - ;; range `!'..`~'. - repeat 64 - collect (+ 33 (random 94)) into auth - finally return (concat auth)))) + ;; The auth key is a 64-byte string of random chars in the + ;; range `!'..`~'. + repeat 64 + collect (+ 33 (random 94)) into auth + finally return (concat auth)))) (process-put server-process :auth-key auth-key) (with-temp-file server-file (set-buffer-multibyte nil) @@ -689,31 +690,31 @@ Server mode runs a process that accepts commands from the (add-to-list 'frame-inherited-parameters 'client) (let ((frame (server-with-environment (process-get proc 'env) - '("LANG" "LC_CTYPE" "LC_ALL" - ;; For tgetent(3); list according to ncurses(3). - "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES" - "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING" - "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO" - "TERMINFO_DIRS" "TERMPATH" - ;; rxvt wants these - "COLORFGBG" "COLORTERM") - (make-frame `((window-system . nil) - (tty . ,tty) - (tty-type . ,type) - ;; Ignore nowait here; we always need to - ;; clean up opened ttys when the client dies. - (client . ,proc) - ;; This is a leftover from an earlier - ;; attempt at making it possible for process - ;; run in the server process to use the - ;; environment of the client process. - ;; It has no effect now and to make it work - ;; we'd need to decide how to make - ;; process-environment interact with client - ;; envvars, and then to change the - ;; C functions `child_setup' and - ;; `getenv_internal' accordingly. - (environment . ,(process-get proc 'env))))))) + '("LANG" "LC_CTYPE" "LC_ALL" + ;; For tgetent(3); list according to ncurses(3). + "BAUDRATE" "COLUMNS" "ESCDELAY" "HOME" "LINES" + "NCURSES_ASSUMED_COLORS" "NCURSES_NO_PADDING" + "NCURSES_NO_SETBUF" "TERM" "TERMCAP" "TERMINFO" + "TERMINFO_DIRS" "TERMPATH" + ;; rxvt wants these + "COLORFGBG" "COLORTERM") + (make-frame `((window-system . nil) + (tty . ,tty) + (tty-type . ,type) + ;; Ignore nowait here; we always need to + ;; clean up opened ttys when the client dies. + (client . ,proc) + ;; This is a leftover from an earlier + ;; attempt at making it possible for process + ;; run in the server process to use the + ;; environment of the client process. + ;; It has no effect now and to make it work + ;; we'd need to decide how to make + ;; process-environment interact with client + ;; envvars, and then to change the + ;; C functions `child_setup' and + ;; `getenv_internal' accordingly. + (environment . ,(process-get proc 'env))))))) ;; ttys don't use the `display' parameter, but callproc.c does to set ;; the DISPLAY environment on subprocesses. @@ -777,8 +778,7 @@ Server mode runs a process that accepts commands from the ;; frame because input from that display will be blocked (until exiting ;; the minibuffer). Better exit this minibuffer right away. ;; Similarly with recursive-edits such as the splash screen. - (run-with-timer 0 nil (lexical-let ((proc proc)) - (lambda () (server-execute-continuation proc)))) + (run-with-timer 0 nil (lambda () (server-execute-continuation proc))) (top-level))) ;; We use various special properties on process objects: @@ -944,119 +944,119 @@ The following commands are accepted by the client: (setq command-line-args-left (mapcar 'server-unquote-arg (split-string request " " t))) (while (setq arg (pop command-line-args-left)) - (cond - ;; -version CLIENT-VERSION: obsolete at birth. - ((and (equal "-version" arg) command-line-args-left) - (pop command-line-args-left)) + (cond + ;; -version CLIENT-VERSION: obsolete at birth. + ((and (equal "-version" arg) command-line-args-left) + (pop command-line-args-left)) - ;; -nowait: Emacsclient won't wait for a result. - ((equal "-nowait" arg) (setq nowait t)) + ;; -nowait: Emacsclient won't wait for a result. + ((equal "-nowait" arg) (setq nowait t)) - ;; -current-frame: Don't create frames. - ((equal "-current-frame" arg) (setq use-current-frame t)) + ;; -current-frame: Don't create frames. + ((equal "-current-frame" arg) (setq use-current-frame t)) - ;; -display DISPLAY: - ;; Open X frames on the given display instead of the default. - ((and (equal "-display" arg) command-line-args-left) - (setq display (pop command-line-args-left)) - (if (zerop (length display)) (setq display nil))) + ;; -display DISPLAY: + ;; Open X frames on the given display instead of the default. + ((and (equal "-display" arg) command-line-args-left) + (setq display (pop command-line-args-left)) + (if (zerop (length display)) (setq display nil))) - ;; -parent-id ID: - ;; Open X frame within window ID, via XEmbed. - ((and (equal "-parent-id" arg) command-line-args-left) - (setq parent-id (pop command-line-args-left)) - (if (zerop (length parent-id)) (setq parent-id nil))) + ;; -parent-id ID: + ;; Open X frame within window ID, via XEmbed. + ((and (equal "-parent-id" arg) command-line-args-left) + (setq parent-id (pop command-line-args-left)) + (if (zerop (length parent-id)) (setq parent-id nil))) - ;; -window-system: Open a new X frame. - ((equal "-window-system" arg) - (setq dontkill t) - (setq tty-name 'window-system)) + ;; -window-system: Open a new X frame. + ((equal "-window-system" arg) + (setq dontkill t) + (setq tty-name 'window-system)) - ;; -resume: Resume a suspended tty frame. - ((equal "-resume" arg) - (lexical-let ((terminal (process-get proc 'terminal))) - (setq dontkill t) - (push (lambda () - (when (eq (terminal-live-p terminal) t) - (resume-tty terminal))) - commands))) - - ;; -suspend: Suspend the client's frame. (In case we - ;; get out of sync, and a C-z sends a SIGTSTP to - ;; emacsclient.) - ((equal "-suspend" arg) - (lexical-let ((terminal (process-get proc 'terminal))) - (setq dontkill t) - (push (lambda () - (when (eq (terminal-live-p terminal) t) - (suspend-tty terminal))) - commands))) - - ;; -ignore COMMENT: Noop; useful for debugging emacsclient. - ;; (The given comment appears in the server log.) - ((and (equal "-ignore" arg) command-line-args-left + ;; -resume: Resume a suspended tty frame. + ((equal "-resume" arg) + (let ((terminal (process-get proc 'terminal))) (setq dontkill t) - (pop command-line-args-left))) + (push (lambda () + (when (eq (terminal-live-p terminal) t) + (resume-tty terminal))) + commands))) - ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client. - ((and (equal "-tty" arg) - (cdr command-line-args-left)) - (setq tty-name (pop command-line-args-left) - tty-type (pop command-line-args-left) - dontkill (or dontkill - (not use-current-frame)))) + ;; -suspend: Suspend the client's frame. (In case we + ;; get out of sync, and a C-z sends a SIGTSTP to + ;; emacsclient.) + ((equal "-suspend" arg) + (let ((terminal (process-get proc 'terminal))) + (setq dontkill t) + (push (lambda () + (when (eq (terminal-live-p terminal) t) + (suspend-tty terminal))) + commands))) - ;; -position LINE[:COLUMN]: Set point to the given - ;; position in the next file. - ((and (equal "-position" arg) - command-line-args-left - (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" - (car command-line-args-left))) - (setq arg (pop command-line-args-left)) - (setq filepos - (cons (string-to-number (match-string 1 arg)) - (string-to-number (or (match-string 2 arg) ""))))) + ;; -ignore COMMENT: Noop; useful for debugging emacsclient. + ;; (The given comment appears in the server log.) + ((and (equal "-ignore" arg) command-line-args-left + (setq dontkill t) + (pop command-line-args-left))) - ;; -file FILENAME: Load the given file. - ((and (equal "-file" arg) - command-line-args-left) - (let ((file (pop command-line-args-left))) - (if coding-system - (setq file (decode-coding-string file coding-system))) - (setq file (expand-file-name file dir)) - (push (cons file filepos) files) - (server-log (format "New file: %s %s" - file (or filepos "")) proc)) - (setq filepos nil)) + ;; -tty DEVICE-NAME TYPE: Open a new tty frame at the client. + ((and (equal "-tty" arg) + (cdr command-line-args-left)) + (setq tty-name (pop command-line-args-left) + tty-type (pop command-line-args-left) + dontkill (or dontkill + (not use-current-frame)))) - ;; -eval EXPR: Evaluate a Lisp expression. - ((and (equal "-eval" arg) - command-line-args-left) - (if use-current-frame - (setq use-current-frame 'always)) - (lexical-let ((expr (pop command-line-args-left))) - (if coding-system - (setq expr (decode-coding-string expr coding-system))) - (push (lambda () (server-eval-and-print expr proc)) - commands) - (setq filepos nil))) + ;; -position LINE[:COLUMN]: Set point to the given + ;; position in the next file. + ((and (equal "-position" arg) + command-line-args-left + (string-match "\\+\\([0-9]+\\)\\(?::\\([0-9]+\\)\\)?" + (car command-line-args-left))) + (setq arg (pop command-line-args-left)) + (setq filepos + (cons (string-to-number (match-string 1 arg)) + (string-to-number (or (match-string 2 arg) ""))))) - ;; -env NAME=VALUE: An environment variable. - ((and (equal "-env" arg) command-line-args-left) - (let ((var (pop command-line-args-left))) - ;; XXX Variables should be encoded as in getenv/setenv. - (process-put proc 'env - (cons var (process-get proc 'env))))) - - ;; -dir DIRNAME: The cwd of the emacsclient process. - ((and (equal "-dir" arg) command-line-args-left) - (setq dir (pop command-line-args-left)) + ;; -file FILENAME: Load the given file. + ((and (equal "-file" arg) + command-line-args-left) + (let ((file (pop command-line-args-left))) (if coding-system - (setq dir (decode-coding-string dir coding-system))) - (setq dir (command-line-normalize-file-name dir))) + (setq file (decode-coding-string file coding-system))) + (setq file (expand-file-name file dir)) + (push (cons file filepos) files) + (server-log (format "New file: %s %s" + file (or filepos "")) proc)) + (setq filepos nil)) - ;; Unknown command. - (t (error "Unknown command: %s" arg)))) + ;; -eval EXPR: Evaluate a Lisp expression. + ((and (equal "-eval" arg) + command-line-args-left) + (if use-current-frame + (setq use-current-frame 'always)) + (let ((expr (pop command-line-args-left))) + (if coding-system + (setq expr (decode-coding-string expr coding-system))) + (push (lambda () (server-eval-and-print expr proc)) + commands) + (setq filepos nil))) + + ;; -env NAME=VALUE: An environment variable. + ((and (equal "-env" arg) command-line-args-left) + (let ((var (pop command-line-args-left))) + ;; XXX Variables should be encoded as in getenv/setenv. + (process-put proc 'env + (cons var (process-get proc 'env))))) + + ;; -dir DIRNAME: The cwd of the emacsclient process. + ((and (equal "-dir" arg) command-line-args-left) + (setq dir (pop command-line-args-left)) + (if coding-system + (setq dir (decode-coding-string dir coding-system))) + (setq dir (command-line-normalize-file-name dir))) + + ;; Unknown command. + (t (error "Unknown command: %s" arg)))) (setq frame (cond @@ -1079,23 +1079,15 @@ The following commands are accepted by the client: (process-put proc 'continuation - (lexical-let ((proc proc) - (files files) - (nowait nowait) - (commands commands) - (dontkill dontkill) - (frame frame) - (dir dir) - (tty-name tty-name)) - (lambda () - (with-current-buffer (get-buffer-create server-buffer) - ;; Use the same cwd as the emacsclient, if possible, so - ;; relative file names work correctly, even in `eval'. - (let ((default-directory - (if (and dir (file-directory-p dir)) - dir default-directory))) - (server-execute proc files nowait commands - dontkill frame tty-name)))))) + (lambda () + (with-current-buffer (get-buffer-create server-buffer) + ;; Use the same cwd as the emacsclient, if possible, so + ;; relative file names work correctly, even in `eval'. + (let ((default-directory + (if (and dir (file-directory-p dir)) + dir default-directory))) + (server-execute proc files nowait commands + dontkill frame tty-name))))) (when (or frame files) (server-goto-toplevel proc)) @@ -1372,12 +1364,12 @@ If invoked with a prefix argument, or if there is no server process running, starts server process and that is all. Invoked by \\[server-edit]." (interactive "P") (cond - ((or arg - (not server-process) - (memq (process-status server-process) '(signal exit))) - (server-mode 1)) - (server-clients (apply 'server-switch-buffer (server-done))) - (t (message "No server editing buffers exist")))) + ((or arg + (not server-process) + (memq (process-status server-process) '(signal exit))) + (server-mode 1)) + (server-clients (apply 'server-switch-buffer (server-done))) + (t (message "No server editing buffers exist")))) (defun server-switch-buffer (&optional next-buffer killed-one filepos) "Switch to another buffer, preferably one that has a client. From d779e73c22ae9fedcf6edc6ec286f19cf2e3d89a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 10 Feb 2011 18:37:03 -0500 Subject: [PATCH 11/45] * lisp/emacs-lisp/bytecomp.el (byte-compile-catch) (byte-compile-unwind-protect, byte-compile-track-mouse) (byte-compile-condition-case, byte-compile-save-window-excursion): Provide a :fun-body alternative, so that info can be propagated from the surrounding context, as is the case for lexical scoping. * lisp/emacs-lisp/cconv.el (cconv-mutated, cconv-captured) (cconv-captured+mutated, cconv-lambda-candidates): Fix up declaration. (cconv-freevars): Minor cleanup. Fix handling of the error var in condition-case. --- lisp/ChangeLog | 13 + lisp/emacs-lisp/bytecomp.el | 123 +-- lisp/emacs-lisp/cconv.el | 1438 ++++++++++++++++++----------------- 3 files changed, 805 insertions(+), 769 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c137860013b..7c920b2eadc 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2011-02-10 Stefan Monnier + + * emacs-lisp/cconv.el (cconv-mutated, cconv-captured) + (cconv-captured+mutated, cconv-lambda-candidates): Fix up declaration. + (cconv-freevars): Minor cleanup. Fix handling of the error var in + condition-case. + + * emacs-lisp/bytecomp.el (byte-compile-catch) + (byte-compile-unwind-protect, byte-compile-track-mouse) + (byte-compile-condition-case, byte-compile-save-window-excursion): + Provide a :fun-body alternative, so that info can be propagated from the + surrounding context, as is the case for lexical scoping. + 2011-02-10 Igor Kuzmin * emacs-lisp/cconv.el: New file. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index b258524b45f..e14ecc608c7 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2706,11 +2706,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." byte-compile-bound-variables)) (bytecomp-body (cdr (cdr bytecomp-fun))) (bytecomp-doc (if (stringp (car bytecomp-body)) - (prog1 (car bytecomp-body) - ;; Discard the doc string - ;; unless it is the last element of the body. - (if (cdr bytecomp-body) - (setq bytecomp-body (cdr bytecomp-body)))))) + (prog1 (car bytecomp-body) + ;; Discard the doc string + ;; unless it is the last element of the body. + (if (cdr bytecomp-body) + (setq bytecomp-body (cdr bytecomp-body)))))) (bytecomp-int (assq 'interactive bytecomp-body))) ;; Process the interactive spec. (when bytecomp-int @@ -4076,76 +4076,79 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." (defun byte-compile-catch (form) (byte-compile-form (car (cdr form))) - (byte-compile-push-constant - (byte-compile-top-level (cons 'progn (cdr (cdr form))) for-effect)) + (pcase (cddr form) + (`(:fun-body ,f) + (byte-compile-form `(list 'funcall ,f))) + (body + (byte-compile-push-constant + (byte-compile-top-level (cons 'progn body) for-effect)))) (byte-compile-out 'byte-catch 0)) (defun byte-compile-unwind-protect (form) - (byte-compile-push-constant - (byte-compile-top-level-body (cdr (cdr form)) t)) + (pcase (cddr form) + (`(:fun-body ,f) + (byte-compile-form `(list (list 'funcall ,f)))) + (handlers + (byte-compile-push-constant + (byte-compile-top-level-body handlers t)))) (byte-compile-out 'byte-unwind-protect 0) (byte-compile-form-do-effect (car (cdr form))) (byte-compile-out 'byte-unbind 1)) (defun byte-compile-track-mouse (form) (byte-compile-form - ;; Use quote rather that #' here, because we don't want to go - ;; through the body again, which would lead to an infinite recursion: - ;; "byte-compile-track-mouse" (0xbffc98e4) - ;; "byte-compile-form" (0xbffc9c54) - ;; "byte-compile-top-level" (0xbffc9fd4) - ;; "byte-compile-lambda" (0xbffca364) - ;; "byte-compile-closure" (0xbffca6d4) - ;; "byte-compile-function-form" (0xbffcaa44) - ;; "byte-compile-form" (0xbffcadc0) - ;; "mapc" (0xbffcaf74) - ;; "byte-compile-funcall" (0xbffcb2e4) - ;; "byte-compile-form" (0xbffcb654) - ;; "byte-compile-track-mouse" (0xbffcb9d4) - `(funcall '(lambda nil - (track-mouse ,@(byte-compile-top-level-body (cdr form))))))) + (pcase form + (`(,_ :fun-body ,f) `(eval (list 'track-mouse (list 'funcall ,f)))) + (_ `(eval '(track-mouse ,@(byte-compile-top-level-body (cdr form)))))))) (defun byte-compile-condition-case (form) (let* ((var (nth 1 form)) (byte-compile-bound-variables (if var (cons var byte-compile-bound-variables) - byte-compile-bound-variables))) + byte-compile-bound-variables)) + (fun-bodies (eq var :fun-body))) (byte-compile-set-symbol-position 'condition-case) (unless (symbolp var) (byte-compile-warn "`%s' is not a variable-name or nil (in condition-case)" var)) + (if fun-bodies (setq var (make-symbol "err"))) (byte-compile-push-constant var) - (byte-compile-push-constant (byte-compile-top-level - (nth 2 form) for-effect)) - (let ((clauses (cdr (cdr (cdr form)))) - compiled-clauses) - (while clauses - (let* ((clause (car clauses)) - (condition (car clause))) - (cond ((not (or (symbolp condition) - (and (listp condition) - (let ((syms condition) (ok t)) - (while syms - (if (not (symbolp (car syms))) - (setq ok nil)) - (setq syms (cdr syms))) - ok)))) - (byte-compile-warn - "`%s' is not a condition name or list of such (in condition-case)" - (prin1-to-string condition))) -;; ((not (or (eq condition 't) -;; (and (stringp (get condition 'error-message)) -;; (consp (get condition 'error-conditions))))) -;; (byte-compile-warn -;; "`%s' is not a known condition name (in condition-case)" -;; condition)) - ) - (push (cons condition - (byte-compile-top-level-body - (cdr clause) for-effect)) - compiled-clauses)) - (setq clauses (cdr clauses))) - (byte-compile-push-constant (nreverse compiled-clauses))) + (if fun-bodies + (byte-compile-form `(list 'funcall ,(nth 2 form))) + (byte-compile-push-constant + (byte-compile-top-level (nth 2 form) for-effect))) + (let ((compiled-clauses + (mapcar + (lambda (clause) + (let ((condition (car clause))) + (cond ((not (or (symbolp condition) + (and (listp condition) + (let ((ok t)) + (dolist (sym condition) + (if (not (symbolp sym)) + (setq ok nil))) + ok)))) + (byte-compile-warn + "`%S' is not a condition name or list of such (in condition-case)" + condition)) + ;; (not (or (eq condition 't) + ;; (and (stringp (get condition 'error-message)) + ;; (consp (get condition + ;; 'error-conditions))))) + ;; (byte-compile-warn + ;; "`%s' is not a known condition name + ;; (in condition-case)" + ;; condition)) + ) + (if fun-bodies + `(list ',condition (list 'funcall ,(cadr clause) ',var)) + (cons condition + (byte-compile-top-level-body + (cdr clause) for-effect))))) + (cdr (cdr (cdr form)))))) + (if fun-bodies + (byte-compile-form `(list ,@compiled-clauses)) + (byte-compile-push-constant compiled-clauses))) (byte-compile-out 'byte-condition-case 0))) @@ -4168,8 +4171,12 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." (byte-compile-out 'byte-unbind 1)) (defun byte-compile-save-window-excursion (form) - (byte-compile-push-constant - (byte-compile-top-level-body (cdr form) for-effect)) + (pcase (cdr form) + (`(:fun-body ,f) + (byte-compile-form `(list (list 'funcall ,f)))) + (body + (byte-compile-push-constant + (byte-compile-top-level-body body for-effect)))) (byte-compile-out 'byte-save-window-excursion 0)) (defun byte-compile-with-output-to-temp-buffer (form) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index ddcc7882d82..60bc906b60c 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -1,77 +1,90 @@ -;;; -*- lexical-binding: t -*- -;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. +;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t -*- -;; licence stuff will be added later(I don't know yet what to write here) +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Igor Kuzmin +;; Maintainer: FSF +;; Keywords: lisp +;; Package: emacs + +;; 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 3 of the License, 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. If not, see . ;;; Commentary: ;; This takes a piece of Elisp code, and eliminates all free variables from ;; lambda expressions. The user entry points are cconv-closure-convert and ;; cconv-closure-convert-toplevel(for toplevel forms). -;; All macros should be expanded. -;; -;; Here is a brief explanation how this code works. -;; Firstly, we analyse the tree by calling cconv-analyse-form. -;; This function finds all mutated variables, all functions that are suitable +;; All macros should be expanded beforehand. +;; +;; Here is a brief explanation how this code works. +;; Firstly, we analyse the tree by calling cconv-analyse-form. +;; This function finds all mutated variables, all functions that are suitable ;; for lambda lifting and all variables captured by closure. It passes the tree ;; once, returning a list of three lists. -;; -;; Then we calculate the intersection of first and third lists returned by -;; cconv-analyse form to find all mutated variables that are captured by -;; closure. +;; +;; Then we calculate the intersection of first and third lists returned by +;; cconv-analyse form to find all mutated variables that are captured by +;; closure. -;; Armed with this data, we call cconv-closure-convert-rec, that rewrites the -;; tree recursivly, lifting lambdas where possible, building closures where it +;; Armed with this data, we call cconv-closure-convert-rec, that rewrites the +;; tree recursivly, lifting lambdas where possible, building closures where it ;; is needed and eliminating mutable variables used in closure. ;; ;; We do following replacements : ;; (lambda (v1 ...) ... fv1 fv2 ...) => (lambda (v1 ... fv1 fv2 ) ... fv1 fv2 .) ;; if the function is suitable for lambda lifting (if all calls are known) ;; -;; (function (lambda (v1 ...) ... fv ...)) => +;; (lambda (v1 ...) ... fv ...) => ;; (curry (lambda (env v1 ...) ... env ...) env) ;; if the function has only 1 free variable ;; -;; and finally -;; (function (lambda (v1 ...) ... fv1 fv2 ...)) => +;; and finally +;; (lambda (v1 ...) ... fv1 fv2 ...) => ;; (curry (lambda (env v1 ..) .. (aref env 0) (aref env 1) ..) (vector fv1 fv2)) -;; if the function has 2 or more free variables +;; if the function has 2 or more free variables. ;; ;; If the function has no free variables, we don't do anything. -;; -;; If the variable is mutable(updated by setq), and it is used in closure -;; we wrap it's definition with list: (list var) and we also replace -;; var => (car var) wherever this variable is used, and also -;; (setq var value) => (setcar var value) where it is updated. -;; -;; If defun argument is closure mutable, we letbind it and wrap it's -;; definition with list. +;; +;; If a variable is mutated (updated by setq), and it is used in a closure +;; we wrap it's definition with list: (list val) and we also replace +;; var => (car var) wherever this variable is used, and also +;; (setq var value) => (setcar var value) where it is updated. +;; +;; If defun argument is closure mutable, we letbind it and wrap it's +;; definition with list. ;; (defun foo (... mutable-arg ...) ...) => ;; (defun foo (... m-arg ...) (let ((m-arg (list m-arg))) ...)) ;; -;; -;; -;; -;; ;;; Code: -(require 'pcase) (eval-when-compile (require 'cl)) (defconst cconv-liftwhen 3 - "Try to do lambda lifting if the number of arguments + free variables + "Try to do lambda lifting if the number of arguments + free variables is less than this number.") -(defvar cconv-mutated +(defvar cconv-mutated nil "List of mutated variables in current form") -(defvar cconv-captured +(defvar cconv-captured nil "List of closure captured variables in current form") -(defvar cconv-captured+mutated +(defvar cconv-captured+mutated nil "An intersection between cconv-mutated and cconv-captured lists.") -(defvar cconv-lambda-candidates +(defvar cconv-lambda-candidates nil "List of candidates for lambda lifting") - (defun cconv-freevars (form &optional fvrs) "Find all free variables of given form. Arguments: @@ -83,101 +96,104 @@ Returns a list of free variables." ;; If a leaf in the tree is a symbol, but it is not a global variable, not a ;; keyword, not 'nil or 't we consider this leaf as a variable. ;; Free variables are the variables that are not declared above in this tree. - ;; For example free variables of (lambda (a1 a2 ..) body-forms) are + ;; For example free variables of (lambda (a1 a2 ..) body-forms) are ;; free variables of body-forms excluding a1, a2 .. - ;; Free variables of (let ((v1 ..) (v2) ..)) body-forms) are + ;; Free variables of (let ((v1 ..) (v2) ..)) body-forms) are ;; free variables of body-forms excluding v1, v2 ... - ;; and so on. + ;; and so on. - ;; a list of free variables already found(FVRS) is passed in parameter + ;; A list of free variables already found(FVRS) is passed in parameter ;; to try to use cons or push where possible, and to minimize the usage - ;; of append + ;; of append. - ;; This function can contain duplicates(because we use 'append instead + ;; This function can return duplicates (because we use 'append instead ;; of union of two sets - for performance reasons). (pcase form - (`(let ,varsvalues . ,body-forms) ; let special form - (let ((fvrs-1 '())) - (dolist (exp body-forms) - (setq fvrs-1 (cconv-freevars exp fvrs-1))) - (dolist (elm varsvalues) - (if (listp elm) - (setq fvrs-1 (delq (car elm) fvrs-1)) - (setq fvrs-1 (delq elm fvrs-1)))) - (setq fvrs (append fvrs fvrs-1)) - (dolist (exp varsvalues) - (when (listp exp) (setq fvrs (cconv-freevars (cadr exp) fvrs)))) - fvrs)) + (`(let ,varsvalues . ,body-forms) ; let special form + (let ((fvrs-1 '())) + (dolist (exp body-forms) + (setq fvrs-1 (cconv-freevars exp fvrs-1))) + (dolist (elm varsvalues) + (setq fvrs-1 (delq (if (consp elm) (car elm) elm) fvrs-1))) + (setq fvrs (nconc fvrs-1 fvrs)) + (dolist (exp varsvalues) + (when (consp exp) (setq fvrs (cconv-freevars (cadr exp) fvrs)))) + fvrs)) - (`(let* ,varsvalues . ,body-forms) ; let* special form - (let ((vrs '()) - (fvrs-1 '())) - (dolist (exp varsvalues) - (if (listp exp) - (progn - (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1)) - (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) - (push (car exp) vrs)) - (progn - (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) - (push exp vrs)))) - (dolist (exp body-forms) - (setq fvrs-1 (cconv-freevars exp fvrs-1))) - (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) - (append fvrs fvrs-1))) + (`(let* ,varsvalues . ,body-forms) ; let* special form + (let ((vrs '()) + (fvrs-1 '())) + (dolist (exp varsvalues) + (if (consp exp) + (progn + (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1)) + (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) + (push (car exp) vrs)) + (progn + (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) + (push exp vrs)))) + (dolist (exp body-forms) + (setq fvrs-1 (cconv-freevars exp fvrs-1))) + (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) + (append fvrs fvrs-1))) - (`((lambda . ,_) . ,_) ; first element is lambda expression - (dolist (exp `((function ,(car form)) . ,(cdr form))) - (setq fvrs (cconv-freevars exp fvrs))) fvrs) + (`((lambda . ,_) . ,_) ; first element is lambda expression + (dolist (exp `((function ,(car form)) . ,(cdr form))) + (setq fvrs (cconv-freevars exp fvrs))) fvrs) - (`(cond . ,cond-forms) ; cond special form - (dolist (exp1 cond-forms) - (dolist (exp2 exp1) - (setq fvrs (cconv-freevars exp2 fvrs)))) fvrs) + (`(cond . ,cond-forms) ; cond special form + (dolist (exp1 cond-forms) + (dolist (exp2 exp1) + (setq fvrs (cconv-freevars exp2 fvrs)))) fvrs) - (`(quote . ,_) fvrs) ; quote form + (`(quote . ,_) fvrs) ; quote form - (`(function . ((lambda ,vars . ,body-forms))) - (let ((functionform (cadr form)) (fvrs-1 '())) - (dolist (exp body-forms) - (setq fvrs-1 (cconv-freevars exp fvrs-1))) - (dolist (elm vars) (setq fvrs-1 (delq elm fvrs-1))) - (append fvrs fvrs-1))) ; function form + (`(function . ((lambda ,vars . ,body-forms))) + (let ((functionform (cadr form)) (fvrs-1 '())) + (dolist (exp body-forms) + (setq fvrs-1 (cconv-freevars exp fvrs-1))) + (dolist (elm vars) (setq fvrs-1 (delq elm fvrs-1))) + (append fvrs fvrs-1))) ; function form - (`(function . ,_) fvrs) ; same as quote + (`(function . ,_) fvrs) ; same as quote ;condition-case - (`(condition-case ,var ,protected-form . ,conditions-bodies) - (let ((fvrs-1 '())) - (setq fvrs-1 (cconv-freevars protected-form '())) - (dolist (exp conditions-bodies) - (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1))) - (setq fvrs-1 (delq var fvrs-1)) - (append fvrs fvrs-1))) + (`(condition-case ,var ,protected-form . ,conditions-bodies) + (let ((fvrs-1 '())) + (dolist (exp conditions-bodies) + (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1))) + (setq fvrs-1 (delq var fvrs-1)) + (setq fvrs-1 (cconv-freevars protected-form fvrs-1)) + (append fvrs fvrs-1))) - (`(,(and sym (or `defun `defconst `defvar)) . ,_) - ;; we call cconv-freevars only for functions(lambdas) - ;; defun, defconst, defvar are not allowed to be inside - ;; a function(lambda) - (error "Invalid form: %s inside a function" sym)) + (`(,(and sym (or `defun `defconst `defvar)) . ,_) + ;; we call cconv-freevars only for functions(lambdas) + ;; defun, defconst, defvar are not allowed to be inside + ;; a function(lambda) + (error "Invalid form: %s inside a function" sym)) - (`(,_ . ,body-forms) ; first element is a function or whatever - (dolist (exp body-forms) - (setq fvrs (cconv-freevars exp fvrs))) fvrs) + (`(,_ . ,body-forms) ; first element is a function or whatever + (dolist (exp body-forms) + (setq fvrs (cconv-freevars exp fvrs))) fvrs) - (_ (if (or (not (symbolp form)) ; form is not a list - (special-variable-p form) - (memq form '(nil t)) - (keywordp form)) - fvrs - (cons form fvrs))))) + (_ (if (or (not (symbolp form)) ; form is not a list + (special-variable-p form) + ;; byte-compile-bound-variables normally holds both the + ;; dynamic and lexical vars, but the bytecomp.el should + ;; only call us at the top-level so there shouldn't be + ;; any lexical vars in it here. + (memq form byte-compile-bound-variables) + (memq form '(nil t)) + (keywordp form)) + fvrs + (cons form fvrs))))) ;;;###autoload (defun cconv-closure-convert (form &optional toplevel) ;; cconv-closure-convert-rec has a lot of parameters that are - ;; whether useless for user, whether they should contain - ;; specific data like a list of closure mutables or the list + ;; whether useless for user, whether they should contain + ;; specific data like a list of closure mutables or the list ;; of lambdas suitable for lifting. - ;; + ;; ;; That's why this function exists. "Main entry point for non-toplevel forms. -- FORM is a piece of Elisp code after macroexpansion. @@ -187,705 +203,705 @@ Returns a form where all lambdas don't have any free variables." (let ((cconv-mutated '()) (cconv-lambda-candidates '()) (cconv-captured '()) - (cconv-captured+mutated '())) - ;; Analyse form - fill these variables with new information - (cconv-analyse-form form '() nil) - ;; Calculate an intersection of cconv-mutated and cconv-captured - (dolist (mvr cconv-mutated) - (when (memq mvr cconv-captured) ; - (push mvr cconv-captured+mutated))) - (cconv-closure-convert-rec - form ; the tree - '() ; - '() ; fvrs initially empty - '() ; envs initially empty + (cconv-captured+mutated '())) + ;; Analyse form - fill these variables with new information + (cconv-analyse-form form '() nil) + ;; Calculate an intersection of cconv-mutated and cconv-captured + (dolist (mvr cconv-mutated) + (when (memq mvr cconv-captured) ; + (push mvr cconv-captured+mutated))) + (cconv-closure-convert-rec + form ; the tree + '() ; + '() ; fvrs initially empty + '() ; envs initially empty '() - toplevel))) ; true if the tree is a toplevel form + toplevel))) ; true if the tree is a toplevel form ;;;###autoload -(defun cconv-closure-convert-toplevel (form) +(defun cconv-closure-convert-toplevel (form) "Entry point for toplevel forms. -- FORM is a piece of Elisp code after macroexpansion. Returns a form where all lambdas don't have any free variables." - ;; we distinguish toplevel forms to treat def(un|var|const) correctly. + ;; we distinguish toplevel forms to treat def(un|var|const) correctly. (cconv-closure-convert form t)) -(defun cconv-closure-convert-rec +(defun cconv-closure-convert-rec (form emvrs fvrs envs lmenvs defs-are-legal) - ;; This function actually rewrites the tree. + ;; This function actually rewrites the tree. "Eliminates all free variables of all lambdas in given forms. Arguments: -- FORM is a piece of Elisp code after macroexpansion. -- LMENVS is a list of environments used for lambda-lifting. Initially empty. -- EMVRS is a list that contains mutated variables that are visible within current environment. --- ENVS is an environment(list of free variables) of current closure. -Initially empty. --- FVRS is a list of variables to substitute in each context. -Initially empty. +-- ENVS is an environment(list of free variables) of current closure. +Initially empty. +-- FVRS is a list of variables to substitute in each context. +Initially empty. -- DEFS-ARE-LEGAL is a boolean variable, true if def(un|var|const) can be used in this form(e.g. toplevel form) Returns a form where all lambdas don't have any free variables." - ;; What's the difference between fvrs and envs? + ;; What's the difference between fvrs and envs? ;; Suppose that we have the code ;; (lambda (..) fvr (let ((fvr 1)) (+ fvr 1))) - ;; only the first occurrence of fvr should be replaced by - ;; (aref env ...). + ;; only the first occurrence of fvr should be replaced by + ;; (aref env ...). ;; So initially envs and fvrs are the same thing, but when we descend to ;; the 'let, we delete fvr from fvrs. Why we don't delete fvr from envs? ;; Because in envs the order of variables is important. We use this list - ;; to find the number of a specific variable in the environment vector, - ;; so we never touch it(unless we enter to the other closure). -;;(if (listp form) (print (car form)) form) - (pcase form - (`(,(and letsym (or `let* `let)) ,varsvalues . ,body-forms) + ;; to find the number of a specific variable in the environment vector, + ;; so we never touch it(unless we enter to the other closure). + ;;(if (listp form) (print (car form)) form) + (pcase form + (`(,(and letsym (or `let* `let)) ,varsvalues . ,body-forms) ; let and let* special forms - (let ((body-forms-new '()) - (varsvalues-new '()) - ;; next for variables needed for delayed push - ;; because we should process - ;; before we change any arguments - (lmenvs-new '()) ;needed only in case of let - (emvrs-new '()) ;needed only in case of let - (emvr-push) ;needed only in case of let* - (lmenv-push)) ;needed only in case of let* + (let ((body-forms-new '()) + (varsvalues-new '()) + ;; next for variables needed for delayed push + ;; because we should process + ;; before we change any arguments + (lmenvs-new '()) ;needed only in case of let + (emvrs-new '()) ;needed only in case of let + (emvr-push) ;needed only in case of let* + (lmenv-push)) ;needed only in case of let* - (dolist (elm varsvalues) ;begin of dolist over varsvalues - (let (var value elm-new iscandidate ismutated) - (if (listp elm) ; (let (v1) ...) => (let ((v1 nil)) ...) - (progn - (setq var (car elm)) - (setq value (cadr elm))) - (setq var elm)) + (dolist (elm varsvalues) ;begin of dolist over varsvalues + (let (var value elm-new iscandidate ismutated) + (if (listp elm) ; (let (v1) ...) => (let ((v1 nil)) ...) + (progn + (setq var (car elm)) + (setq value (cadr elm))) + (setq var elm)) - ;; Check if var is a candidate for lambda lifting - (let ((lcandid cconv-lambda-candidates)) - (while (and lcandid (not iscandidate)) - (when (and (eq (caar lcandid) var) - (eq (caddar lcandid) elm) - (eq (cadr (cddar lcandid)) form)) - (setq iscandidate t)) - (setq lcandid (cdr lcandid)))) + ;; Check if var is a candidate for lambda lifting + (let ((lcandid cconv-lambda-candidates)) + (while (and lcandid (not iscandidate)) + (when (and (eq (caar lcandid) var) + (eq (caddar lcandid) elm) + (eq (cadr (cddar lcandid)) form)) + (setq iscandidate t)) + (setq lcandid (cdr lcandid)))) - ; declared variable is a candidate - ; for lambda lifting - (if iscandidate - (let* ((func (cadr elm)) ; function(lambda) itself + ; declared variable is a candidate + ; for lambda lifting + (if iscandidate + (let* ((func (cadr elm)) ; function(lambda) itself ; free variables - (fv (delete-dups (cconv-freevars func '()))) - (funcvars (append fv (cadadr func))) ;function args - (funcbodies (cddadr func)) ; function bodies - (funcbodies-new '())) + (fv (delete-dups (cconv-freevars func '()))) + (funcvars (append fv (cadadr func))) ;function args + (funcbodies (cddadr func)) ; function bodies + (funcbodies-new '())) ; lambda lifting condition - (if (or (not fv) (< cconv-liftwhen (length funcvars))) + (if (or (not fv) (< cconv-liftwhen (length funcvars))) ; do not lift - (setq - elm-new - `(,var - ,(cconv-closure-convert-rec - func emvrs fvrs envs lmenvs nil))) + (setq + elm-new + `(,var + ,(cconv-closure-convert-rec + func emvrs fvrs envs lmenvs nil))) ; lift - (progn - (dolist (elm2 funcbodies) - (push ; convert function bodies - (cconv-closure-convert-rec - elm2 emvrs nil envs lmenvs nil) - funcbodies-new)) - (if (eq letsym 'let*) - (setq lmenv-push (cons var fv)) - (push (cons var fv) lmenvs-new)) + (progn + (dolist (elm2 funcbodies) + (push ; convert function bodies + (cconv-closure-convert-rec + elm2 emvrs nil envs lmenvs nil) + funcbodies-new)) + (if (eq letsym 'let*) + (setq lmenv-push (cons var fv)) + (push (cons var fv) lmenvs-new)) ; push lifted function - (setq elm-new - `(,var - (function . - ((lambda ,funcvars . - ,(reverse funcbodies-new))))))))) - - ;declared variable is not a function - (progn - ;; Check if var is mutated - (let ((lmutated cconv-captured+mutated)) - (while (and lmutated (not ismutated)) - (when (and (eq (caar lmutated) var) - (eq (caddar lmutated) elm) - (eq (cadr (cddar lmutated)) form)) - (setq ismutated t)) - (setq lmutated (cdr lmutated)))) - (if ismutated - (progn ; declared variable is mutated - (setq elm-new - `(,var (list ,(cconv-closure-convert-rec - value emvrs - fvrs envs lmenvs nil)))) - (if (eq letsym 'let*) - (setq emvr-push var) - (push var emvrs-new))) - (progn - (setq - elm-new - `(,var ; else - ,(cconv-closure-convert-rec - value emvrs fvrs envs lmenvs nil))))))) + (setq elm-new + `(,var + (function . + ((lambda ,funcvars . + ,(reverse funcbodies-new))))))))) - ;; this piece of code below letbinds free - ;; variables of a lambda lifted function - ;; if they are redefined in this let - ;; example: - ;; (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1)) - ;; Here we can not pass y as parameter because it is - ;; redefined. We add a (closed-y y) declaration. - ;; We do that even if the function is not used inside - ;; this let(*). The reason why we ignore this case is - ;; that we can't "look forward" to see if the function - ;; is called there or not. To treat well this case we - ;; need to traverse the tree one more time to collect this - ;; data, and I think that it's not worth it. + ;declared variable is not a function + (progn + ;; Check if var is mutated + (let ((lmutated cconv-captured+mutated)) + (while (and lmutated (not ismutated)) + (when (and (eq (caar lmutated) var) + (eq (caddar lmutated) elm) + (eq (cadr (cddar lmutated)) form)) + (setq ismutated t)) + (setq lmutated (cdr lmutated)))) + (if ismutated + (progn ; declared variable is mutated + (setq elm-new + `(,var (list ,(cconv-closure-convert-rec + value emvrs + fvrs envs lmenvs nil)))) + (if (eq letsym 'let*) + (setq emvr-push var) + (push var emvrs-new))) + (progn + (setq + elm-new + `(,var ; else + ,(cconv-closure-convert-rec + value emvrs fvrs envs lmenvs nil))))))) - (when (eq letsym 'let*) - (let ((closedsym '()) - (new-lmenv '()) - (old-lmenv '())) - (dolist (lmenv lmenvs) - (when (memq var (cdr lmenv)) - (setq closedsym - (make-symbol - (concat "closed-" (symbol-name var)))) - (setq new-lmenv (list (car lmenv))) - (dolist (frv (cdr lmenv)) (if (eq frv var) - (push closedsym new-lmenv) - (push frv new-lmenv))) - (setq new-lmenv (reverse new-lmenv)) - (setq old-lmenv lmenv))) - (when new-lmenv - (setq lmenvs (remq old-lmenv lmenvs)) - (push new-lmenv lmenvs) - (push `(,closedsym ,var) varsvalues-new)))) - ;; we push the element after redefined free variables - ;; are processes. this is important to avoid the bug - ;; when free variable and the function have the same - ;; name - (push elm-new varsvalues-new) + ;; this piece of code below letbinds free + ;; variables of a lambda lifted function + ;; if they are redefined in this let + ;; example: + ;; (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1)) + ;; Here we can not pass y as parameter because it is + ;; redefined. We add a (closed-y y) declaration. + ;; We do that even if the function is not used inside + ;; this let(*). The reason why we ignore this case is + ;; that we can't "look forward" to see if the function + ;; is called there or not. To treat well this case we + ;; need to traverse the tree one more time to collect this + ;; data, and I think that it's not worth it. - (when (eq letsym 'let*) ; update fvrs - (setq fvrs (remq var fvrs)) - (setq emvrs (remq var emvrs)) ; remove if redefined - (when emvr-push - (push emvr-push emvrs) - (setq emvr-push nil)) - (let (lmenvs-1) ; remove var from lmenvs if redefined - (dolist (iter lmenvs) - (when (not (assq var lmenvs)) - (push iter lmenvs-1))) - (setq lmenvs lmenvs-1)) - (when lmenv-push - (push lmenv-push lmenvs) - (setq lmenv-push nil))) - )) ; end of dolist over varsvalues - (when (eq letsym 'let) + (when (eq letsym 'let*) + (let ((closedsym '()) + (new-lmenv '()) + (old-lmenv '())) + (dolist (lmenv lmenvs) + (when (memq var (cdr lmenv)) + (setq closedsym + (make-symbol + (concat "closed-" (symbol-name var)))) + (setq new-lmenv (list (car lmenv))) + (dolist (frv (cdr lmenv)) (if (eq frv var) + (push closedsym new-lmenv) + (push frv new-lmenv))) + (setq new-lmenv (reverse new-lmenv)) + (setq old-lmenv lmenv))) + (when new-lmenv + (setq lmenvs (remq old-lmenv lmenvs)) + (push new-lmenv lmenvs) + (push `(,closedsym ,var) varsvalues-new)))) + ;; we push the element after redefined free variables + ;; are processes. this is important to avoid the bug + ;; when free variable and the function have the same + ;; name + (push elm-new varsvalues-new) - (let (var fvrs-1 emvrs-1 lmenvs-1) - ;; Here we update emvrs, fvrs and lmenvs lists - (dolist (vr fvrs) + (when (eq letsym 'let*) ; update fvrs + (setq fvrs (remq var fvrs)) + (setq emvrs (remq var emvrs)) ; remove if redefined + (when emvr-push + (push emvr-push emvrs) + (setq emvr-push nil)) + (let (lmenvs-1) ; remove var from lmenvs if redefined + (dolist (iter lmenvs) + (when (not (assq var lmenvs)) + (push iter lmenvs-1))) + (setq lmenvs lmenvs-1)) + (when lmenv-push + (push lmenv-push lmenvs) + (setq lmenv-push nil))) + )) ; end of dolist over varsvalues + (when (eq letsym 'let) + + (let (var fvrs-1 emvrs-1 lmenvs-1) + ;; Here we update emvrs, fvrs and lmenvs lists + (dolist (vr fvrs) ; safely remove - (when (not (assq vr varsvalues-new)) (push vr fvrs-1))) - (setq fvrs fvrs-1) - (dolist (vr emvrs) + (when (not (assq vr varsvalues-new)) (push vr fvrs-1))) + (setq fvrs fvrs-1) + (dolist (vr emvrs) ; safely remove - (when (not (assq vr varsvalues-new)) (push vr emvrs-1))) - (setq emvrs emvrs-1) + (when (not (assq vr varsvalues-new)) (push vr emvrs-1))) + (setq emvrs emvrs-1) ; push new - (setq emvrs (append emvrs emvrs-new)) - (dolist (vr lmenvs) - (when (not (assq (car vr) varsvalues-new)) - (push vr lmenvs-1))) - (setq lmenvs (append lmenvs lmenvs-new))) + (setq emvrs (append emvrs emvrs-new)) + (dolist (vr lmenvs) + (when (not (assq (car vr) varsvalues-new)) + (push vr lmenvs-1))) + (setq lmenvs (append lmenvs lmenvs-new))) - ;; Here we do the same letbinding as for let* above - ;; to avoid situation when a free variable of a lambda lifted - ;; function got redefined. - - (let ((new-lmenv) - (var nil) - (closedsym nil) - (letbinds '()) - (fvrs-new)) ; list of (closed-var var) - (dolist (elm varsvalues) - (if (listp elm) - (setq var (car elm)) - (setq var elm)) + ;; Here we do the same letbinding as for let* above + ;; to avoid situation when a free variable of a lambda lifted + ;; function got redefined. - (let ((lmenvs-1 lmenvs)) ; just to avoid manipulating - (dolist (lmenv lmenvs-1) ; the counter inside the loop - (when (memq var (cdr lmenv)) - (setq closedsym (make-symbol - (concat "closed-" - (symbol-name var)))) + (let ((new-lmenv) + (var nil) + (closedsym nil) + (letbinds '()) + (fvrs-new)) ; list of (closed-var var) + (dolist (elm varsvalues) + (if (listp elm) + (setq var (car elm)) + (setq var elm)) - (setq new-lmenv (list (car lmenv))) - (dolist (frv (cdr lmenv)) (if (eq frv var) - (push closedsym new-lmenv) - (push frv new-lmenv))) - (setq new-lmenv (reverse new-lmenv)) - (setq lmenvs (remq lmenv lmenvs)) - (push new-lmenv lmenvs) - (push `(,closedsym ,var) letbinds) - )))) - (setq varsvalues-new (append varsvalues-new letbinds)))) + (let ((lmenvs-1 lmenvs)) ; just to avoid manipulating + (dolist (lmenv lmenvs-1) ; the counter inside the loop + (when (memq var (cdr lmenv)) + (setq closedsym (make-symbol + (concat "closed-" + (symbol-name var)))) - (dolist (elm body-forms) ; convert body forms - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) - body-forms-new)) - `(,letsym ,(reverse varsvalues-new) . ,(reverse body-forms-new)))) + (setq new-lmenv (list (car lmenv))) + (dolist (frv (cdr lmenv)) (if (eq frv var) + (push closedsym new-lmenv) + (push frv new-lmenv))) + (setq new-lmenv (reverse new-lmenv)) + (setq lmenvs (remq lmenv lmenvs)) + (push new-lmenv lmenvs) + (push `(,closedsym ,var) letbinds) + )))) + (setq varsvalues-new (append varsvalues-new letbinds)))) + + (dolist (elm body-forms) ; convert body forms + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + body-forms-new)) + `(,letsym ,(reverse varsvalues-new) . ,(reverse body-forms-new)))) ;end of let let* forms - ; first element is lambda expression - (`(,(and `(lambda . ,_) fun) . ,other-body-forms) - - (let ((other-body-forms-new '())) - (dolist (elm other-body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) - other-body-forms-new)) - (cons - (cadr - (cconv-closure-convert-rec - (list 'function fun) emvrs fvrs envs lmenvs nil)) - (reverse other-body-forms-new)))) + ; first element is lambda expression + (`(,(and `(lambda . ,_) fun) . ,other-body-forms) - (`(cond . ,cond-forms) ; cond special form - (let ((cond-forms-new '())) - (dolist (elm cond-forms) - (push (let ((elm-new '())) - (dolist (elm-2 elm) - (push - (cconv-closure-convert-rec - elm-2 emvrs fvrs envs lmenvs nil) - elm-new)) - (reverse elm-new)) - cond-forms-new)) - (cons 'cond - (reverse cond-forms-new)))) + (let ((other-body-forms-new '())) + (dolist (elm other-body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + other-body-forms-new)) + (cons + (cadr + (cconv-closure-convert-rec + (list 'function fun) emvrs fvrs envs lmenvs nil)) + (reverse other-body-forms-new)))) - (`(quote . ,_) form) ; quote form - - (`(function . ((lambda ,vars . ,body-forms))) ; function form - (let (fvrs-new) ; we remove vars from fvrs - (dolist (elm fvrs) ;i use such a tricky way to avoid side effects - (when (not (memq elm vars)) - (push elm fvrs-new))) - (setq fvrs fvrs-new)) - (let* ((fv (delete-dups (cconv-freevars form '()))) - (leave fvrs) ; leave = non nil if we should leave env unchanged - (body-forms-new '()) - (letbind '()) - (mv nil) - (envector nil)) - (when fv - ;; Here we form our environment vector. - ;; If outer closure contains all - ;; free variables of this function(and nothing else) - ;; then we use the same environment vector as for outer closure, - ;; i.e. we leave the environment vector unchanged - ;; otherwise we build a new environmet vector - (if (eq (length envs) (length fv)) - (let ((fv-temp fv)) - (while (and fv-temp leave) - (when (not (memq (car fv-temp) fvrs)) (setq leave nil)) - (setq fv-temp (cdr fv-temp)))) - (setq leave nil)) - - (if (not leave) - (progn - (dolist (elm fv) - (push - (cconv-closure-convert-rec - elm (remq elm emvrs) fvrs envs lmenvs nil) - envector)) ; process vars for closure vector - (setq envector (reverse envector)) - (setq envs fv)) - (setq envector `(env))) ; leave unchanged - (setq fvrs fv)) ; update substitution list + (`(cond . ,cond-forms) ; cond special form + (let ((cond-forms-new '())) + (dolist (elm cond-forms) + (push (let ((elm-new '())) + (dolist (elm-2 elm) + (push + (cconv-closure-convert-rec + elm-2 emvrs fvrs envs lmenvs nil) + elm-new)) + (reverse elm-new)) + cond-forms-new)) + (cons 'cond + (reverse cond-forms-new)))) - ;; the difference between envs and fvrs is explained - ;; in comment in the beginning of the function - (dolist (elm cconv-captured+mutated) ; find mutated arguments - (setq mv (car elm)) ; used in inner closures - (when (and (memq mv vars) (eq form (caddr elm))) - (progn (push mv emvrs) - (push `(,mv (list ,mv)) letbind)))) - (dolist (elm body-forms) ; convert function body - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) - body-forms-new)) - - (setq body-forms-new - (if letbind `((let ,letbind . ,(reverse body-forms-new))) - (reverse body-forms-new))) - - (cond + (`(quote . ,_) form) ; quote form + + (`(function . ((lambda ,vars . ,body-forms))) ; function form + (let (fvrs-new) ; we remove vars from fvrs + (dolist (elm fvrs) ;i use such a tricky way to avoid side effects + (when (not (memq elm vars)) + (push elm fvrs-new))) + (setq fvrs fvrs-new)) + (let* ((fv (delete-dups (cconv-freevars form '()))) + (leave fvrs) ; leave = non nil if we should leave env unchanged + (body-forms-new '()) + (letbind '()) + (mv nil) + (envector nil)) + (when fv + ;; Here we form our environment vector. + ;; If outer closure contains all + ;; free variables of this function(and nothing else) + ;; then we use the same environment vector as for outer closure, + ;; i.e. we leave the environment vector unchanged + ;; otherwise we build a new environmet vector + (if (eq (length envs) (length fv)) + (let ((fv-temp fv)) + (while (and fv-temp leave) + (when (not (memq (car fv-temp) fvrs)) (setq leave nil)) + (setq fv-temp (cdr fv-temp)))) + (setq leave nil)) + + (if (not leave) + (progn + (dolist (elm fv) + (push + (cconv-closure-convert-rec + elm (remq elm emvrs) fvrs envs lmenvs nil) + envector)) ; process vars for closure vector + (setq envector (reverse envector)) + (setq envs fv)) + (setq envector `(env))) ; leave unchanged + (setq fvrs fv)) ; update substitution list + + ;; the difference between envs and fvrs is explained + ;; in comment in the beginning of the function + (dolist (elm cconv-captured+mutated) ; find mutated arguments + (setq mv (car elm)) ; used in inner closures + (when (and (memq mv vars) (eq form (caddr elm))) + (progn (push mv emvrs) + (push `(,mv (list ,mv)) letbind)))) + (dolist (elm body-forms) ; convert function body + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + body-forms-new)) + + (setq body-forms-new + (if letbind `((let ,letbind . ,(reverse body-forms-new))) + (reverse body-forms-new))) + + (cond ;if no freevars - do nothing - ((null envector) - `(function (lambda ,vars . ,body-forms-new))) - ; 1 free variable - do not build vector - ((null (cdr envector)) - `(curry - (function (lambda (env . ,vars) . ,body-forms-new)) - ,(car envector))) - ; >=2 free variables - build vector - (t - `(curry - (function (lambda (env . ,vars) . ,body-forms-new)) - (vector . ,envector)))))) + ((null envector) + `(function (lambda ,vars . ,body-forms-new))) + ; 1 free variable - do not build vector + ((null (cdr envector)) + `(curry + (function (lambda (env . ,vars) . ,body-forms-new)) + ,(car envector))) + ; >=2 free variables - build vector + (t + `(curry + (function (lambda (env . ,vars) . ,body-forms-new)) + (vector . ,envector)))))) - (`(function . ,_) form) ; same as quote + (`(function . ,_) form) ; same as quote ;defconst, defvar - (`(,(and sym (or `defconst `defvar)) ,definedsymbol . ,body-forms) + (`(,(and sym (or `defconst `defvar)) ,definedsymbol . ,body-forms) - (if defs-are-legal - (let ((body-forms-new '())) - (dolist (elm body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) - body-forms-new)) - (setq body-forms-new (reverse body-forms-new)) - `(,sym ,definedsymbol . ,body-forms-new)) - (error "Invalid form: %s inside a function" sym))) + (if defs-are-legal + (let ((body-forms-new '())) + (dolist (elm body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + body-forms-new)) + (setq body-forms-new (reverse body-forms-new)) + `(,sym ,definedsymbol . ,body-forms-new)) + (error "Invalid form: %s inside a function" sym))) - ;defun, defmacro, defsubst - (`(,(and sym (or `defun `defmacro `defsubst)) - ,func ,vars . ,body-forms) - (if defs-are-legal - (let ((body-new '()) ; the whole body - (body-forms-new '()) ; body w\o docstring and interactive - (letbind '())) + ;defun, defmacro + (`(,(and sym (or `defun `defmacro)) + ,func ,vars . ,body-forms) + (if defs-are-legal + (let ((body-new '()) ; the whole body + (body-forms-new '()) ; body w\o docstring and interactive + (letbind '())) ; find mutable arguments - (let ((lmutated cconv-captured+mutated) ismutated) - (dolist (elm vars) - (setq ismutated nil) - (while (and lmutated (not ismutated)) - (when (and (eq (caar lmutated) elm) - (eq (cadar lmutated) form)) - (setq ismutated t)) - (setq lmutated (cdr lmutated))) - (when ismutated - (push elm letbind) - (push elm emvrs)))) - ;transform body-forms - (when (stringp (car body-forms)) ; treat docstring well - (push (car body-forms) body-new) - (setq body-forms (cdr body-forms))) - (when (and (listp (car body-forms)) ; treat (interactive) well - (eq (caar body-forms) 'interactive)) - (push - (cconv-closure-convert-rec - (car body-forms) - emvrs fvrs envs lmenvs nil) body-new) - (setq body-forms (cdr body-forms))) - - (dolist (elm body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) - body-forms-new)) - (setq body-forms-new (reverse body-forms-new)) + (let ((lmutated cconv-captured+mutated) ismutated) + (dolist (elm vars) + (setq ismutated nil) + (while (and lmutated (not ismutated)) + (when (and (eq (caar lmutated) elm) + (eq (cadar lmutated) form)) + (setq ismutated t)) + (setq lmutated (cdr lmutated))) + (when ismutated + (push elm letbind) + (push elm emvrs)))) + ;transform body-forms + (when (stringp (car body-forms)) ; treat docstring well + (push (car body-forms) body-new) + (setq body-forms (cdr body-forms))) + (when (and (listp (car body-forms)) ; treat (interactive) well + (eq (caar body-forms) 'interactive)) + (push + (cconv-closure-convert-rec + (car body-forms) + emvrs fvrs envs lmenvs nil) body-new) + (setq body-forms (cdr body-forms))) - (if letbind + (dolist (elm body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + body-forms-new)) + (setq body-forms-new (reverse body-forms-new)) + + (if letbind ; letbind mutable arguments - (let ((varsvalues-new '())) - (dolist (elm letbind) (push `(,elm (list ,elm)) - varsvalues-new)) - (push `(let ,(reverse varsvalues-new) . - ,body-forms-new) body-new) - (setq body-new (reverse body-new))) - (setq body-new (append (reverse body-new) body-forms-new))) + (let ((varsvalues-new '())) + (dolist (elm letbind) (push `(,elm (list ,elm)) + varsvalues-new)) + (push `(let ,(reverse varsvalues-new) . + ,body-forms-new) body-new) + (setq body-new (reverse body-new))) + (setq body-new (append (reverse body-new) body-forms-new))) - `(,sym ,func ,vars . ,body-new)) + `(,sym ,func ,vars . ,body-new)) - (error "Invalid form: defun inside a function"))) + (error "Invalid form: defun inside a function"))) ;condition-case - (`(condition-case ,var ,protected-form . ,conditions-bodies) - (let ((conditions-bodies-new '())) - (setq fvrs (remq var fvrs)) - (dolist (elm conditions-bodies) - (push (let ((elm-new '())) - (dolist (elm-2 (cdr elm)) - (push - (cconv-closure-convert-rec - elm-2 emvrs fvrs envs lmenvs nil) - elm-new)) - (cons (car elm) (reverse elm-new))) - conditions-bodies-new)) - `(condition-case - ,var - ,(cconv-closure-convert-rec - protected-form emvrs fvrs envs lmenvs nil) - . ,(reverse conditions-bodies-new)))) + (`(condition-case ,var ,protected-form . ,conditions-bodies) + (let ((conditions-bodies-new '())) + (setq fvrs (remq var fvrs)) + (dolist (elm conditions-bodies) + (push (let ((elm-new '())) + (dolist (elm-2 (cdr elm)) + (push + (cconv-closure-convert-rec + elm-2 emvrs fvrs envs lmenvs nil) + elm-new)) + (cons (car elm) (reverse elm-new))) + conditions-bodies-new)) + `(condition-case + ,var + ,(cconv-closure-convert-rec + protected-form emvrs fvrs envs lmenvs nil) + . ,(reverse conditions-bodies-new)))) - (`(setq . ,forms) ; setq special form - (let (prognlist sym sym-new value) - (while forms - (setq sym (car forms)) - (setq sym-new (cconv-closure-convert-rec - sym - (remq sym emvrs) fvrs envs lmenvs nil)) - (setq value - (cconv-closure-convert-rec - (cadr forms) emvrs fvrs envs lmenvs nil)) - (if (memq sym emvrs) - (push `(setcar ,sym-new ,value) prognlist) - (if (symbolp sym-new) - (push `(setq ,sym-new ,value) prognlist) - (push `(set ,sym-new ,value) prognlist))) - (setq forms (cddr forms))) - (if (cdr prognlist) - `(progn . ,(reverse prognlist)) - (car prognlist)))) + (`(setq . ,forms) ; setq special form + (let (prognlist sym sym-new value) + (while forms + (setq sym (car forms)) + (setq sym-new (cconv-closure-convert-rec + sym + (remq sym emvrs) fvrs envs lmenvs nil)) + (setq value + (cconv-closure-convert-rec + (cadr forms) emvrs fvrs envs lmenvs nil)) + (if (memq sym emvrs) + (push `(setcar ,sym-new ,value) prognlist) + (if (symbolp sym-new) + (push `(setq ,sym-new ,value) prognlist) + (push `(set ,sym-new ,value) prognlist))) + (setq forms (cddr forms))) + (if (cdr prognlist) + `(progn . ,(reverse prognlist)) + (car prognlist)))) - (`(,(and (or `funcall `apply) callsym) ,fun . ,args) - ; funcall is not a special form - ; but we treat it separately - ; for the needs of lambda lifting - (let ((fv (cdr (assq fun lmenvs)))) - (if fv - (let ((args-new '()) - (processed-fv '())) - ;; All args (free variables and actual arguments) - ;; should be processed, because they can be fvrs - ;; (free variables of another closure) - (dolist (fvr fv) - (push (cconv-closure-convert-rec - fvr (remq fvr emvrs) - fvrs envs lmenvs nil) - processed-fv)) - (setq processed-fv (reverse processed-fv)) - (dolist (elm args) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) - args-new)) - (setq args-new (append processed-fv (reverse args-new))) - (setq fun (cconv-closure-convert-rec - fun emvrs fvrs envs lmenvs nil)) - `(,callsym ,fun . ,args-new)) - (let ((cdr-new '())) - (dolist (elm (cdr form)) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) - cdr-new)) - `(,callsym . ,(reverse cdr-new)))))) - - (`(,func . ,body-forms) ; first element is function or whatever - ; function-like forms are: - ; or, and, if, progn, prog1, prog2, - ; while, until - (let ((body-forms-new '())) - (dolist (elm body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs defs-are-legal) - body-forms-new)) - (setq body-forms-new (reverse body-forms-new)) - `(,func . ,body-forms-new))) + (`(,(and (or `funcall `apply) callsym) ,fun . ,args) + ; funcall is not a special form + ; but we treat it separately + ; for the needs of lambda lifting + (let ((fv (cdr (assq fun lmenvs)))) + (if fv + (let ((args-new '()) + (processed-fv '())) + ;; All args (free variables and actual arguments) + ;; should be processed, because they can be fvrs + ;; (free variables of another closure) + (dolist (fvr fv) + (push (cconv-closure-convert-rec + fvr (remq fvr emvrs) + fvrs envs lmenvs nil) + processed-fv)) + (setq processed-fv (reverse processed-fv)) + (dolist (elm args) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + args-new)) + (setq args-new (append processed-fv (reverse args-new))) + (setq fun (cconv-closure-convert-rec + fun emvrs fvrs envs lmenvs nil)) + `(,callsym ,fun . ,args-new)) + (let ((cdr-new '())) + (dolist (elm (cdr form)) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs nil) + cdr-new)) + `(,callsym . ,(reverse cdr-new)))))) - (_ - (if (memq form fvrs) ;form is a free variable - (let* ((numero (position form envs)) - (var '())) - (assert numero) - (if (null (cdr envs)) - (setq var 'env) - ;replace form => + (`(,func . ,body-forms) ; first element is function or whatever + ; function-like forms are: + ; or, and, if, progn, prog1, prog2, + ; while, until + (let ((body-forms-new '())) + (dolist (elm body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs defs-are-legal) + body-forms-new)) + (setq body-forms-new (reverse body-forms-new)) + `(,func . ,body-forms-new))) + + (_ + (if (memq form fvrs) ;form is a free variable + (let* ((numero (position form envs)) + (var '())) + (assert numero) + (if (null (cdr envs)) + (setq var 'env) + ;replace form => ;(aref env #) - (setq var `(aref env ,numero))) - (if (memq form emvrs) ; form => (car (aref env #)) if mutable - `(car ,var) - var)) - (if (memq form emvrs) ; if form is a mutable variable - `(car ,form) ; replace form => (car form) - form))))) + (setq var `(aref env ,numero))) + (if (memq form emvrs) ; form => (car (aref env #)) if mutable + `(car ,var) + var)) + (if (memq form emvrs) ; if form is a mutable variable + `(car ,form) ; replace form => (car form) + form))))) (defun cconv-analyse-form (form vars inclosure) - "Find mutated variables and variables captured by closure. Analyse -lambdas if they are suitable for lambda lifting. + "Find mutated variables and variables captured by closure. Analyse +lambdas if they are suitable for lambda lifting. -- FORM is a piece of Elisp code after macroexpansion. -- MLCVRS is a structure that contains captured and mutated variables. - (first MLCVRS) is a list of mutated variables, (second MLCVRS) is a -list of candidates for lambda lifting and (third MLCVRS) is a list of + (first MLCVRS) is a list of mutated variables, (second MLCVRS) is a +list of candidates for lambda lifting and (third MLCVRS) is a list of variables captured by closure. It should be (nil nil nil) initially. --- VARS is a list of local variables visible in current environment +-- VARS is a list of local variables visible in current environment (initially empty). --- INCLOSURE is a boolean variable, true if we are in closure. +-- INCLOSURE is a boolean variable, true if we are in closure. Initially false" (pcase form ; let special form - (`(,(and (or `let* `let) letsym) ,varsvalues . ,body-forms) + (`(,(and (or `let* `let) letsym) ,varsvalues . ,body-forms) - (when (eq letsym 'let) - (dolist (elm varsvalues) ; analyse values - (when (listp elm) - (cconv-analyse-form (cadr elm) vars inclosure)))) + (when (eq letsym 'let) + (dolist (elm varsvalues) ; analyse values + (when (listp elm) + (cconv-analyse-form (cadr elm) vars inclosure)))) - (let ((v nil) - (var nil) - (value nil) - (varstruct nil)) - (dolist (elm varsvalues) - (if (listp elm) - (progn - (setq var (car elm)) - (setq value (cadr elm))) - (progn - (setq var elm) ; treat the form (let (x) ...) well - (setq value nil))) - - (when (eq letsym 'let*) ; analyse value - (cconv-analyse-form value vars inclosure)) - - (let (vars-new) ; remove the old var - (dolist (vr vars) - (when (not (eq (car vr) var)) - (push vr vars-new))) - (setq vars vars-new)) + (let ((v nil) + (var nil) + (value nil) + (varstruct nil)) + (dolist (elm varsvalues) + (if (listp elm) + (progn + (setq var (car elm)) + (setq value (cadr elm))) + (progn + (setq var elm) ; treat the form (let (x) ...) well + (setq value nil))) - (setq varstruct (list var inclosure elm form)) - (push varstruct vars) ; push a new one - - (when (and (listp value) - (eq (car value) 'function) - (eq (caadr value) 'lambda)) + (when (eq letsym 'let*) ; analyse value + (cconv-analyse-form value vars inclosure)) + + (let (vars-new) ; remove the old var + (dolist (vr vars) + (when (not (eq (car vr) var)) + (push vr vars-new))) + (setq vars vars-new)) + + (setq varstruct (list var inclosure elm form)) + (push varstruct vars) ; push a new one + + (when (and (listp value) + (eq (car value) 'function) + (eq (caadr value) 'lambda)) ; if var is a function ; push it to lambda list - (push varstruct cconv-lambda-candidates)))) + (push varstruct cconv-lambda-candidates)))) - (dolist (elm body-forms) ; analyse body forms - (cconv-analyse-form elm vars inclosure)) - nil) + (dolist (elm body-forms) ; analyse body forms + (cconv-analyse-form elm vars inclosure)) + nil) ; defun special form - (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms) - (let ((v nil)) - (dolist (vr vrs) - (push (list vr form) vars))) ;push vrs to vars - (dolist (elm body-forms) ; analyse body forms - (cconv-analyse-form elm vars inclosure)) - nil) + (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms) + (let ((v nil)) + (dolist (vr vrs) + (push (list vr form) vars))) ;push vrs to vars + (dolist (elm body-forms) ; analyse body forms + (cconv-analyse-form elm vars inclosure)) + nil) - (`(function . ((lambda ,vrs . ,body-forms))) - (if inclosure ;we are in closure - (setq inclosure (+ inclosure 1)) - (setq inclosure 1)) - (let (vars-new) ; update vars - (dolist (vr vars) ; we do that in such a tricky way - (when (not (memq (car vr) vrs)) ; to avoid side effects - (push vr vars-new))) - (dolist (vr vrs) - (push (list vr inclosure form) vars-new)) - (setq vars vars-new)) + (`(function . ((lambda ,vrs . ,body-forms))) + (if inclosure ;we are in closure + (setq inclosure (+ inclosure 1)) + (setq inclosure 1)) + (let (vars-new) ; update vars + (dolist (vr vars) ; we do that in such a tricky way + (when (not (memq (car vr) vrs)) ; to avoid side effects + (push vr vars-new))) + (dolist (vr vrs) + (push (list vr inclosure form) vars-new)) + (setq vars vars-new)) - (dolist (elm body-forms) - (cconv-analyse-form elm vars inclosure)) - nil) + (dolist (elm body-forms) + (cconv-analyse-form elm vars inclosure)) + nil) - (`(setq . ,forms) ; setq - ; if a local variable (member of vars) - ; is modified by setq - ; then it is a mutated variable - (while forms - (let ((v (assq (car forms) vars))) ; v = non nil if visible - (when v - (push v cconv-mutated) - ;; delete from candidate list for lambda lifting - (setq cconv-lambda-candidates (delq v cconv-lambda-candidates)) - (when inclosure - ;; test if v is declared as argument for lambda - (let* ((thirdv (third v)) - (isarg (if (listp thirdv) - (eq (car thirdv) 'function) nil))) - (if isarg - (when (> inclosure (cadr v)) ; when we are in closure - (push v cconv-captured)) ; push it to captured vars - ;; FIXME more detailed comments needed - (push v cconv-captured)))))) - (cconv-analyse-form (cadr forms) vars inclosure) - (setq forms (cddr forms))) - nil) + (`(setq . ,forms) ; setq + ; if a local variable (member of vars) + ; is modified by setq + ; then it is a mutated variable + (while forms + (let ((v (assq (car forms) vars))) ; v = non nil if visible + (when v + (push v cconv-mutated) + ;; delete from candidate list for lambda lifting + (setq cconv-lambda-candidates (delq v cconv-lambda-candidates)) + (when inclosure + ;; test if v is declared as argument for lambda + (let* ((thirdv (third v)) + (isarg (if (listp thirdv) + (eq (car thirdv) 'function) nil))) + (if isarg + (when (> inclosure (cadr v)) ; when we are in closure + (push v cconv-captured)) ; push it to captured vars + ;; FIXME more detailed comments needed + (push v cconv-captured)))))) + (cconv-analyse-form (cadr forms) vars inclosure) + (setq forms (cddr forms))) + nil) - (`((lambda . ,_) . ,_) ; first element is lambda expression - (dolist (exp `((function ,(car form)) . ,(cdr form))) - (cconv-analyse-form exp vars inclosure)) - nil) + (`((lambda . ,_) . ,_) ; first element is lambda expression + (dolist (exp `((function ,(car form)) . ,(cdr form))) + (cconv-analyse-form exp vars inclosure)) + nil) - (`(cond . ,cond-forms) ; cond special form - (dolist (exp1 cond-forms) - (dolist (exp2 exp1) - (cconv-analyse-form exp2 vars inclosure))) - nil) + (`(cond . ,cond-forms) ; cond special form + (dolist (exp1 cond-forms) + (dolist (exp2 exp1) + (cconv-analyse-form exp2 vars inclosure))) + nil) - (`(quote . ,_) nil) ; quote form + (`(quote . ,_) nil) ; quote form - (`(function . ,_) nil) ; same as quote + (`(function . ,_) nil) ; same as quote - (`(condition-case ,var ,protected-form . ,conditions-bodies) + (`(condition-case ,var ,protected-form . ,conditions-bodies) ;condition-case - (cconv-analyse-form protected-form vars inclosure) - (dolist (exp conditions-bodies) - (cconv-analyse-form (cadr exp) vars inclosure)) - nil) + (cconv-analyse-form protected-form vars inclosure) + (dolist (exp conditions-bodies) + (cconv-analyse-form (cadr exp) vars inclosure)) + nil) - (`(,(or `defconst `defvar `defsubst) ,value) - (cconv-analyse-form value vars inclosure)) + (`(,(or `defconst `defvar) ,value) + (cconv-analyse-form value vars inclosure)) - (`(,(or `funcall `apply) ,fun . ,args) - ;; Here we ignore fun because - ;; funcall and apply are the only two - ;; functions where we can pass a candidate - ;; for lambda lifting as argument. - ;; So, if we see fun elsewhere, we'll - ;; delete it from lambda candidate list. + (`(,(or `funcall `apply) ,fun . ,args) + ;; Here we ignore fun because + ;; funcall and apply are the only two + ;; functions where we can pass a candidate + ;; for lambda lifting as argument. + ;; So, if we see fun elsewhere, we'll + ;; delete it from lambda candidate list. - ;; If this funcall and the definition of fun - ;; are in different closures - we delete fun from - ;; canidate list, because it is too complicated - ;; to manage free variables in this case. - (let ((lv (assq fun cconv-lambda-candidates))) - (when lv - (when (not (eq (cadr lv) inclosure)) - (setq cconv-lambda-candidates - (delq lv cconv-lambda-candidates))))) - - (dolist (elm args) - (cconv-analyse-form elm vars inclosure)) - nil) - - (`(,_ . ,body-forms) ; first element is a function or whatever - (dolist (exp body-forms) - (cconv-analyse-form exp vars inclosure)) - nil) + ;; If this funcall and the definition of fun + ;; are in different closures - we delete fun from + ;; canidate list, because it is too complicated + ;; to manage free variables in this case. + (let ((lv (assq fun cconv-lambda-candidates))) + (when lv + (when (not (eq (cadr lv) inclosure)) + (setq cconv-lambda-candidates + (delq lv cconv-lambda-candidates))))) - (_ - (when (and (symbolp form) - (not (memq form '(nil t))) - (not (keywordp form)) - (not (special-variable-p form))) - (let ((dv (assq form vars))) ; dv = declared and visible - (when dv - (when inclosure - ;; test if v is declared as argument of lambda - (let* ((thirddv (third dv)) - (isarg (if (listp thirddv) - (eq (car thirddv) 'function) nil))) - (if isarg - ;; FIXME add detailed comments - (when (> inclosure (cadr dv)) ; capturing condition - (push dv cconv-captured)) - (push dv cconv-captured)))) - ; delete lambda - (setq cconv-lambda-candidates ; if it is found here - (delq dv cconv-lambda-candidates))))) - nil))) + (dolist (elm args) + (cconv-analyse-form elm vars inclosure)) + nil) + + (`(,_ . ,body-forms) ; first element is a function or whatever + (dolist (exp body-forms) + (cconv-analyse-form exp vars inclosure)) + nil) + + (_ + (when (and (symbolp form) + (not (memq form '(nil t))) + (not (keywordp form)) + (not (special-variable-p form))) + (let ((dv (assq form vars))) ; dv = declared and visible + (when dv + (when inclosure + ;; test if v is declared as argument of lambda + (let* ((thirddv (third dv)) + (isarg (if (listp thirddv) + (eq (car thirddv) 'function) nil))) + (if isarg + ;; FIXME add detailed comments + (when (> inclosure (cadr dv)) ; capturing condition + (push dv cconv-captured)) + (push dv cconv-captured)))) + ; delete lambda + (setq cconv-lambda-candidates ; if it is found here + (delq dv cconv-lambda-candidates))))) + nil))) (provide 'cconv) ;;; cconv.el ends here From 43e67019dfc4fb7d3474e0fbedcfec60f2300521 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 11 Feb 2011 14:48:54 -0500 Subject: [PATCH 12/45] Make cconv-analyse understand the need for closures. * lisp/emacs-lisp/byte-lexbind.el (byte-compile-lforminfo-analyze): Understand the :fun-body case for catch, save-window-excursion, and condition-case. (byte-compile-maybe-push-heap-environment): No need when nclosures is zero and byte-compile-current-num-closures is -1. * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Fix `fun' that was not renamed to `bytecomp-fun'. * lisp/emacs-lisp/cconv.el (cconv-not-lexical-var-p): New function. (cconv-freevars): Use it. (cconv-closure-convert-rec): Avoid `position'. (cconv-analyse-function): New function. (cconv-analyse-form): Use it. `inclosure' can't be nil any more. Check lexical vars at let-binding time rather than when referenced. For defuns to be in an empty environment and lambdas to take lexical args. Pay attention to the need to build closures in catch, unwind-protect, save-window-excursion, condition-case, and track-mouse. Fix defconst/defvar handling. --- lisp/ChangeLog | 22 +++ lisp/emacs-lisp/byte-lexbind.el | 18 +- lisp/emacs-lisp/bytecomp.el | 4 +- lisp/emacs-lisp/cconv.el | 336 +++++++++++++++----------------- lisp/emacs-lisp/macroexp.el | 13 ++ 5 files changed, 201 insertions(+), 192 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7c920b2eadc..6a47a2626a5 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,25 @@ +2011-02-11 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-lambda): Fix `fun' that was not + renamed to `bytecomp-fun'. + + * emacs-lisp/byte-lexbind.el (byte-compile-lforminfo-analyze): + Understand the :fun-body case for catch, save-window-excursion, and + condition-case. + (byte-compile-maybe-push-heap-environment): No need when nclosures is + zero and byte-compile-current-num-closures is -1. + + * emacs-lisp/cconv.el (cconv-not-lexical-var-p): New function. + (cconv-freevars): Use it. + (cconv-closure-convert-rec): Avoid `position'. + (cconv-analyse-function): New function. + (cconv-analyse-form): Use it. `inclosure' can't be nil any more. + Check lexical vars at let-binding time rather than when referenced. + For defuns to be in an empty environment and lambdas to take lexical args. + Pay attention to the need to build closures in catch, unwind-protect, + save-window-excursion, condition-case, and track-mouse. + Fix defconst/defvar handling. + 2011-02-10 Stefan Monnier * emacs-lisp/cconv.el (cconv-mutated, cconv-captured) diff --git a/lisp/emacs-lisp/byte-lexbind.el b/lisp/emacs-lisp/byte-lexbind.el index df463c17549..313c4b6ad0f 100644 --- a/lisp/emacs-lisp/byte-lexbind.el +++ b/lisp/emacs-lisp/byte-lexbind.el @@ -1,6 +1,6 @@ ;;; byte-lexbind.el --- Lexical binding support for byte-compiler ;; -;; Copyright (C) 2001, 2002, 2010 Free Software Foundation, Inc. +;; Copyright (C) 2001, 2002, 2010, 2011 Free Software Foundation, Inc. ;; ;; Author: Miles Bader ;; Keywords: lisp, compiler, lexical binding @@ -202,24 +202,25 @@ LFORMINFO." (byte-compile-lvarinfo-note-set vinfo) (byte-compile-lforminfo-note-closure lforminfo vinfo closure-flag))))))) - ((eq fun 'catch) + ((and (eq fun 'catch) (not (eq :fun-body (nth 2 form)))) ;; tag (byte-compile-lforminfo-analyze lforminfo (cadr form) - ignore closure-flag) + ignore closure-flag) ;; `catch' uses a closure for the body (byte-compile-lforminfo-analyze-forms lforminfo form 2 ignore (or closure-flag - (and (not byte-compile-use-downward-closures) - (byte-compile-lforminfo-make-closure-flag))))) + (and (not byte-compile-use-downward-closures) + (byte-compile-lforminfo-make-closure-flag))))) ((eq fun 'cond) (byte-compile-lforminfo-analyze-clauses lforminfo (cdr form) 0 ignore closure-flag)) ((eq fun 'condition-case) ;; `condition-case' separates its body/handlers into ;; separate closures. - (unless (or closure-flag byte-compile-use-downward-closures) + (unless (or (eq (nth 1 form) :fun-body) + closure-flag byte-compile-use-downward-closures) ;; condition case is implemented by calling a function (setq closure-flag (byte-compile-lforminfo-make-closure-flag))) ;; value form @@ -281,7 +282,8 @@ LFORMINFO." ((eq fun 'quote) ;; do nothing ) - ((eq fun 'save-window-excursion) + ((and (eq fun 'save-window-excursion) + (not (eq :fun-body (nth 1 form)))) ;; `save-window-excursion' currently uses a funny implementation ;; that requires its body forms be put into a closure (it should ;; be fixed to work more like `save-excursion' etc., do). @@ -579,6 +581,7 @@ proper scope)." (let ((nclosures (and lforminfo (byte-compile-lforminfo-num-closures lforminfo)))) (if (or (null lforminfo) + (zerop nclosures) (= nclosures byte-compile-current-num-closures)) ;; No need to push a heap environment. nil @@ -692,5 +695,4 @@ binding slots have been popped." (provide 'byte-lexbind) -;;; arch-tag: b8f1dff6-9edb-4430-a96f-323d42a681a9 ;;; byte-lexbind.el ends here diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e14ecc608c7..f37d7489e9a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2745,7 +2745,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; containing the args and any closed-over variables. (and lexical-binding (byte-compile-make-lambda-lexenv - fun + bytecomp-fun byte-compile-lexical-environment))) (is-closure ;; This is true if we should be making a closure instead of @@ -2804,7 +2804,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (let ((code (byte-compile-lambda form add-lambda))) (if (byte-compile-closure-code-p code) (byte-compile-make-closure code) - ;; A simple lambda is just a constant + ;; A simple lambda is just a constant. (byte-compile-constant code)))) (defun byte-compile-constants-vector () diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 60bc906b60c..af42a2864c9 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -1,4 +1,4 @@ -;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t -*- +;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: nil -*- ;; Copyright (C) 2011 Free Software Foundation, Inc. @@ -82,8 +82,19 @@ is less than this number.") (defvar cconv-captured+mutated nil "An intersection between cconv-mutated and cconv-captured lists.") (defvar cconv-lambda-candidates nil - "List of candidates for lambda lifting") + "List of candidates for lambda lifting. +Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).") +(defun cconv-not-lexical-var-p (var) + (or (not (symbolp var)) ; form is not a list + (special-variable-p var) + ;; byte-compile-bound-variables normally holds both the + ;; dynamic and lexical vars, but the bytecomp.el should + ;; only call us at the top-level so there shouldn't be + ;; any lexical vars in it here. + (memq var byte-compile-bound-variables) + (memq var '(nil t)) + (keywordp var))) (defun cconv-freevars (form &optional fvrs) "Find all free variables of given form. @@ -166,24 +177,17 @@ Returns a list of free variables." (append fvrs fvrs-1))) (`(,(and sym (or `defun `defconst `defvar)) . ,_) - ;; we call cconv-freevars only for functions(lambdas) + ;; We call cconv-freevars only for functions(lambdas) ;; defun, defconst, defvar are not allowed to be inside - ;; a function(lambda) + ;; a function (lambda). + ;; FIXME: should be a byte-compile-report-error! (error "Invalid form: %s inside a function" sym)) - (`(,_ . ,body-forms) ; first element is a function or whatever + (`(,_ . ,body-forms) ; First element is (like) a function. (dolist (exp body-forms) (setq fvrs (cconv-freevars exp fvrs))) fvrs) - (_ (if (or (not (symbolp form)) ; form is not a list - (special-variable-p form) - ;; byte-compile-bound-variables normally holds both the - ;; dynamic and lexical vars, but the bytecomp.el should - ;; only call us at the top-level so there shouldn't be - ;; any lexical vars in it here. - (memq form byte-compile-bound-variables) - (memq form '(nil t)) - (keywordp form)) + (_ (if (cconv-not-lexical-var-p form) fvrs (cons form fvrs))))) @@ -200,12 +204,13 @@ Returns a list of free variables." -- TOPLEVEL(optional) is a boolean variable, true if we are at the root of AST Returns a form where all lambdas don't have any free variables." + (message "Entering cconv-closure-convert...") (let ((cconv-mutated '()) (cconv-lambda-candidates '()) (cconv-captured '()) (cconv-captured+mutated '())) ;; Analyse form - fill these variables with new information - (cconv-analyse-form form '() nil) + (cconv-analyse-form form '() 0) ;; Calculate an intersection of cconv-mutated and cconv-captured (dolist (mvr cconv-mutated) (when (memq mvr cconv-captured) ; @@ -271,7 +276,7 @@ Returns a form where all lambdas don't have any free variables." (dolist (elm varsvalues) ;begin of dolist over varsvalues (let (var value elm-new iscandidate ismutated) - (if (listp elm) ; (let (v1) ...) => (let ((v1 nil)) ...) + (if (consp elm) ; (let (v1) ...) => (let ((v1 nil)) ...) (progn (setq var (car elm)) (setq value (cadr elm))) @@ -430,9 +435,7 @@ Returns a form where all lambdas don't have any free variables." (letbinds '()) (fvrs-new)) ; list of (closed-var var) (dolist (elm varsvalues) - (if (listp elm) - (setq var (car elm)) - (setq var elm)) + (setq var (if (consp elm) (car elm) elm)) (let ((lmenvs-1 lmenvs)) ; just to avoid manipulating (dolist (lmenv lmenvs-1) ; the counter inside the loop @@ -490,7 +493,7 @@ Returns a form where all lambdas don't have any free variables." (`(quote . ,_) form) ; quote form (`(function . ((lambda ,vars . ,body-forms))) ; function form - (let (fvrs-new) ; we remove vars from fvrs + (let (fvrs-new) ; we remove vars from fvrs (dolist (elm fvrs) ;i use such a tricky way to avoid side effects (when (not (memq elm vars)) (push elm fvrs-new))) @@ -577,7 +580,7 @@ Returns a form where all lambdas don't have any free variables." (`(,(and sym (or `defun `defmacro)) ,func ,vars . ,body-forms) (if defs-are-legal - (let ((body-new '()) ; the whole body + (let ((body-new '()) ; the whole body (body-forms-new '()) ; body w\o docstring and interactive (letbind '())) ; find mutable arguments @@ -592,12 +595,11 @@ Returns a form where all lambdas don't have any free variables." (when ismutated (push elm letbind) (push elm emvrs)))) - ;transform body-forms + ;transform body-forms (when (stringp (car body-forms)) ; treat docstring well (push (car body-forms) body-new) (setq body-forms (cdr body-forms))) - (when (and (listp (car body-forms)) ; treat (interactive) well - (eq (caar body-forms) 'interactive)) + (when (eq (car-safe (car body-forms)) 'interactive) (push (cconv-closure-convert-rec (car body-forms) @@ -707,201 +709,171 @@ Returns a form where all lambdas don't have any free variables." `(,func . ,body-forms-new))) (_ - (if (memq form fvrs) ;form is a free variable - (let* ((numero (position form envs)) - (var '())) - (assert numero) - (if (null (cdr envs)) - (setq var 'env) + (let ((free (memq form fvrs))) + (if free ;form is a free variable + (let* ((numero (- (length fvrs) (length free))) + (var '())) + (assert numero) + (if (null (cdr envs)) + (setq var 'env) ;replace form => ;(aref env #) - (setq var `(aref env ,numero))) - (if (memq form emvrs) ; form => (car (aref env #)) if mutable - `(car ,var) - var)) - (if (memq form emvrs) ; if form is a mutable variable - `(car ,form) ; replace form => (car form) - form))))) + (setq var `(aref env ,numero))) + (if (memq form emvrs) ; form => (car (aref env #)) if mutable + `(car ,var) + var)) + (if (memq form emvrs) ; if form is a mutable variable + `(car ,form) ; replace form => (car form) + form)))))) -(defun cconv-analyse-form (form vars inclosure) +(defun cconv-analyse-function (args body env parentform inclosure) + (dolist (arg args) + (cond + ((cconv-not-lexical-var-p arg) + (byte-compile-report-error + (format "Argument %S is not a lexical variable" arg))) + ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... + (t (push (list arg inclosure parentform) env)))) ;Push vrs to vars. + (dolist (form body) ;Analyse body forms. + (cconv-analyse-form form env inclosure))) +(defun cconv-analyse-form (form env inclosure) "Find mutated variables and variables captured by closure. Analyse lambdas if they are suitable for lambda lifting. -- FORM is a piece of Elisp code after macroexpansion. --- MLCVRS is a structure that contains captured and mutated variables. - (first MLCVRS) is a list of mutated variables, (second MLCVRS) is a -list of candidates for lambda lifting and (third MLCVRS) is a list of -variables captured by closure. It should be (nil nil nil) initially. --- VARS is a list of local variables visible in current environment - (initially empty). --- INCLOSURE is a boolean variable, true if we are in closure. -Initially false" +-- ENV is a list of variables visible in current lexical environment. + Each entry has the form (VAR INCLOSURE BINDER PARENTFORM) + for let-bound vars and (VAR INCLOSURE PARENTFORM) for function arguments. +-- INCLOSURE is the nesting level within lambdas." (pcase form ; let special form - (`(,(and (or `let* `let) letsym) ,varsvalues . ,body-forms) + (`(,(and (or `let* `let) letsym) ,binders . ,body-forms) - (when (eq letsym 'let) - (dolist (elm varsvalues) ; analyse values - (when (listp elm) - (cconv-analyse-form (cadr elm) vars inclosure)))) - - (let ((v nil) + (let ((orig-env env) (var nil) - (value nil) - (varstruct nil)) - (dolist (elm varsvalues) - (if (listp elm) + (value nil)) + (dolist (binder binders) + (if (not (consp binder)) (progn - (setq var (car elm)) - (setq value (cadr elm))) - (progn - (setq var elm) ; treat the form (let (x) ...) well - (setq value nil))) + (setq var binder) ; treat the form (let (x) ...) well + (setq value nil)) + (setq var (car binder)) + (setq value (cadr binder)) - (when (eq letsym 'let*) ; analyse value - (cconv-analyse-form value vars inclosure)) + (cconv-analyse-form value (if (eq letsym 'let*) env orig-env) + inclosure)) - (let (vars-new) ; remove the old var - (dolist (vr vars) - (when (not (eq (car vr) var)) - (push vr vars-new))) - (setq vars vars-new)) + (unless (cconv-not-lexical-var-p var) + (let ((varstruct (list var inclosure binder form))) + (push varstruct env) ; Push a new one. - (setq varstruct (list var inclosure elm form)) - (push varstruct vars) ; push a new one + (pcase value + (`(function (lambda . ,_)) + ;; If var is a function push it to lambda list. + (push varstruct cconv-lambda-candidates))))))) - (when (and (listp value) - (eq (car value) 'function) - (eq (caadr value) 'lambda)) - ; if var is a function - ; push it to lambda list - (push varstruct cconv-lambda-candidates)))) + (dolist (form body-forms) ; Analyse body forms. + (cconv-analyse-form form env inclosure))) - (dolist (elm body-forms) ; analyse body forms - (cconv-analyse-form elm vars inclosure)) - nil) ; defun special form (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms) - (let ((v nil)) - (dolist (vr vrs) - (push (list vr form) vars))) ;push vrs to vars - (dolist (elm body-forms) ; analyse body forms - (cconv-analyse-form elm vars inclosure)) - nil) + (when env + (byte-compile-log-warning + (format "Function %S will ignore its context %S" + func (mapcar #'car env)) + t :warning)) + (cconv-analyse-function vrs body-forms nil form 0)) - (`(function . ((lambda ,vrs . ,body-forms))) - (if inclosure ;we are in closure - (setq inclosure (+ inclosure 1)) - (setq inclosure 1)) - (let (vars-new) ; update vars - (dolist (vr vars) ; we do that in such a tricky way - (when (not (memq (car vr) vrs)) ; to avoid side effects - (push vr vars-new))) - (dolist (vr vrs) - (push (list vr inclosure form) vars-new)) - (setq vars vars-new)) - - (dolist (elm body-forms) - (cconv-analyse-form elm vars inclosure)) - nil) - - (`(setq . ,forms) ; setq - ; if a local variable (member of vars) - ; is modified by setq - ; then it is a mutated variable + (`(function (lambda ,vrs . ,body-forms)) + (cconv-analyse-function vrs body-forms env form (1+ inclosure))) + + (`(setq . ,forms) + ;; If a local variable (member of env) is modified by setq then + ;; it is a mutated variable. (while forms - (let ((v (assq (car forms) vars))) ; v = non nil if visible + (let ((v (assq (car forms) env))) ; v = non nil if visible (when v (push v cconv-mutated) - ;; delete from candidate list for lambda lifting + ;; Delete from candidate list for lambda lifting. (setq cconv-lambda-candidates (delq v cconv-lambda-candidates)) - (when inclosure - ;; test if v is declared as argument for lambda - (let* ((thirdv (third v)) - (isarg (if (listp thirdv) - (eq (car thirdv) 'function) nil))) - (if isarg - (when (> inclosure (cadr v)) ; when we are in closure - (push v cconv-captured)) ; push it to captured vars - ;; FIXME more detailed comments needed - (push v cconv-captured)))))) - (cconv-analyse-form (cadr forms) vars inclosure) - (setq forms (cddr forms))) - nil) + (unless (eq inclosure (cadr v)) ;Bound in a different closure level. + (push v cconv-captured)))) + (cconv-analyse-form (cadr forms) env inclosure) + (setq forms (cddr forms)))) - (`((lambda . ,_) . ,_) ; first element is lambda expression + (`((lambda . ,_) . ,_) ; first element is lambda expression (dolist (exp `((function ,(car form)) . ,(cdr form))) - (cconv-analyse-form exp vars inclosure)) - nil) + (cconv-analyse-form exp env inclosure))) (`(cond . ,cond-forms) ; cond special form - (dolist (exp1 cond-forms) - (dolist (exp2 exp1) - (cconv-analyse-form exp2 vars inclosure))) - nil) + (dolist (forms cond-forms) + (dolist (form forms) + (cconv-analyse-form form env inclosure)))) (`(quote . ,_) nil) ; quote form - (`(function . ,_) nil) ; same as quote - (`(condition-case ,var ,protected-form . ,conditions-bodies) - ;condition-case - (cconv-analyse-form protected-form vars inclosure) - (dolist (exp conditions-bodies) - (cconv-analyse-form (cadr exp) vars inclosure)) - nil) + (`(condition-case ,var ,protected-form . ,handlers) + ;; FIXME: The bytecode for condition-case forces us to wrap the + ;; form and handlers in closures (for handlers, it's probably + ;; unavoidable, but not for the protected form). + (setq inclosure (1+ inclosure)) + (cconv-analyse-form protected-form env inclosure) + (push (list var inclosure form) env) + (dolist (handler handlers) + (dolist (form (cdr handler)) + (cconv-analyse-form form env inclosure)))) - (`(,(or `defconst `defvar) ,value) - (cconv-analyse-form value vars inclosure)) + ;; FIXME: The bytecode for catch forces us to wrap the body. + (`(,(or `catch `unwind-protect) ,form . ,body) + (cconv-analyse-form form env inclosure) + (setq inclosure (1+ inclosure)) + (dolist (form body) + (cconv-analyse-form form env inclosure))) + + ;; FIXME: The bytecode for save-window-excursion and the lack of + ;; bytecode for track-mouse forces us to wrap the body. + (`(,(or `save-window-excursion `track-mouse) . ,body) + (setq inclosure (1+ inclosure)) + (dolist (form body) + (cconv-analyse-form form env inclosure))) + + (`(,(or `defconst `defvar) ,var ,value . ,_) + (push var byte-compile-bound-variables) + (cconv-analyse-form value env inclosure)) (`(,(or `funcall `apply) ,fun . ,args) - ;; Here we ignore fun because - ;; funcall and apply are the only two - ;; functions where we can pass a candidate - ;; for lambda lifting as argument. - ;; So, if we see fun elsewhere, we'll - ;; delete it from lambda candidate list. + ;; Here we ignore fun because funcall and apply are the only two + ;; functions where we can pass a candidate for lambda lifting as + ;; argument. So, if we see fun elsewhere, we'll delete it from + ;; lambda candidate list. + (if (symbolp fun) + (let ((lv (assq fun cconv-lambda-candidates))) + (when lv + (unless (eq (cadr lv) inclosure) + (push lv cconv-captured) + ;; If this funcall and the definition of fun are in + ;; different closures - we delete fun from candidate + ;; list, because it is too complicated to manage free + ;; variables in this case. + (setq cconv-lambda-candidates + (delq lv cconv-lambda-candidates))))) + (cconv-analyse-form fun env inclosure)) + (dolist (form args) + (cconv-analyse-form form env inclosure))) - ;; If this funcall and the definition of fun - ;; are in different closures - we delete fun from - ;; canidate list, because it is too complicated - ;; to manage free variables in this case. - (let ((lv (assq fun cconv-lambda-candidates))) - (when lv - (when (not (eq (cadr lv) inclosure)) - (setq cconv-lambda-candidates - (delq lv cconv-lambda-candidates))))) + (`(,_ . ,body-forms) ; First element is a function or whatever. + (dolist (form body-forms) + (cconv-analyse-form form env inclosure))) - (dolist (elm args) - (cconv-analyse-form elm vars inclosure)) - nil) - - (`(,_ . ,body-forms) ; first element is a function or whatever - (dolist (exp body-forms) - (cconv-analyse-form exp vars inclosure)) - nil) - - (_ - (when (and (symbolp form) - (not (memq form '(nil t))) - (not (keywordp form)) - (not (special-variable-p form))) - (let ((dv (assq form vars))) ; dv = declared and visible - (when dv - (when inclosure - ;; test if v is declared as argument of lambda - (let* ((thirddv (third dv)) - (isarg (if (listp thirddv) - (eq (car thirddv) 'function) nil))) - (if isarg - ;; FIXME add detailed comments - (when (> inclosure (cadr dv)) ; capturing condition - (push dv cconv-captured)) - (push dv cconv-captured)))) - ; delete lambda - (setq cconv-lambda-candidates ; if it is found here - (delq dv cconv-lambda-candidates))))) - nil))) + ((pred symbolp) + (let ((dv (assq form env))) ; dv = declared and visible + (when dv + (unless (eq inclosure (cadr dv)) ; capturing condition + (push dv cconv-captured)) + ;; Delete lambda if it is found here, since it escapes. + (setq cconv-lambda-candidates + (delq dv cconv-lambda-candidates))))))) (provide 'cconv) ;;; cconv.el ends here diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index af8047256e2..bccc60a24e0 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -29,6 +29,8 @@ ;;; Code: +(eval-when-compile (require 'cl)) + ;; Bound by the top-level `macroexpand-all', and modified to include any ;; macros defined by `defmacro'. (defvar macroexpand-all-environment nil) @@ -164,6 +166,17 @@ Assumes the caller has bound `macroexpand-all-environment'." (cons (macroexpand-all-1 (list 'function f)) (macroexpand-all-forms args))))) + ;; Macro expand compiler macros. + ;; FIXME: Don't depend on CL. + (`(,(and (pred symbolp) fun + (guard (and (eq (get fun 'byte-compile) + 'cl-byte-compile-compiler-macro) + (functionp 'compiler-macroexpand)))) + . ,_) + (let ((newform (compiler-macroexpand form))) + (if (eq form newform) + (macroexpand-all-forms form 1) + (macroexpand-all-1 newform)))) (`(,_ . ,_) ;; For every other list, we just expand each argument (for ;; setq/setq-default this works alright because the variable names From 295fb2ac59b66c0e2470325a42c8e58c135ed044 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 11 Feb 2011 17:30:02 -0500 Subject: [PATCH 13/45] Let cconv use :fun-body in special forms that need it. * lisp/emacs-lisp/cconv.el (cconv-closure-convert): Drop `toplevel' arg. (cconv-closure-convert-toplevel): Remove. (cconv-lookup-let): New fun. (cconv-closure-convert-rec): Don't bother with defs-are-legal. Use :fun-body to handle special forms that require closing their forms. * lisp/emacs-lisp/bytecomp.el (byte-compile-file-form, byte-compile): Use cconv-closure-convert instead of cconv-closure-convert-toplevel. (byte-compile-lambda, byte-compile-make-closure): * lisp/emacs-lisp/byte-lexbind.el (byte-compile-maybe-push-heap-environment): Make sure cconv did its job. * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Check stack-depth before using it. * lisp/dired.el (dired-desktop-buffer-misc-data): Don't use a dynamic var as function argument. --- lisp/ChangeLog | 20 ++ lisp/dired.el | 11 +- lisp/emacs-lisp/byte-lexbind.el | 1 + lisp/emacs-lisp/byte-opt.el | 11 +- lisp/emacs-lisp/bytecomp.el | 10 +- lisp/emacs-lisp/cconv.el | 341 +++++++++++++++----------------- lisp/mpc.el | 3 +- 7 files changed, 198 insertions(+), 199 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6a47a2626a5..c3451d9b269 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,23 @@ +2011-02-11 Stefan Monnier + + * emacs-lisp/cconv.el (cconv-closure-convert): Drop `toplevel' arg. + (cconv-closure-convert-toplevel): Remove. + (cconv-lookup-let): New fun. + (cconv-closure-convert-rec): Don't bother with defs-are-legal. + Use :fun-body to handle special forms that require closing their forms. + + * emacs-lisp/bytecomp.el (byte-compile-file-form, byte-compile): + Use cconv-closure-convert instead of cconv-closure-convert-toplevel. + (byte-compile-lambda, byte-compile-make-closure): + * emacs-lisp/byte-lexbind.el (byte-compile-maybe-push-heap-environment): + Make sure cconv did its job. + + * emacs-lisp/byte-opt.el (byte-optimize-lapcode): Check stack-depth + before using it. + + * dired.el (dired-desktop-buffer-misc-data): Don't use a dynamic var as + function argument. + 2011-02-11 Stefan Monnier * emacs-lisp/bytecomp.el (byte-compile-lambda): Fix `fun' that was not diff --git a/lisp/dired.el b/lisp/dired.el index f98ad641fe3..92cbdd32c8d 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1,5 +1,4 @@ -;;; -*- lexical-binding: t -*- -;;; dired.el --- directory-browsing commands +;;; dired.el --- directory-browsing commands -*- lexical-binding: t -*- ;; Copyright (C) 1985-1986, 1992-1997, 2000-2011 ;; Free Software Foundation, Inc. @@ -3507,21 +3506,21 @@ Ask means pop up a menu for the user to select one of copy, move or link." (eval-when-compile (require 'desktop)) -(defun dired-desktop-buffer-misc-data (desktop-dirname) +(defun dired-desktop-buffer-misc-data (dirname) "Auxiliary information to be saved in desktop file." (cons ;; Value of `dired-directory'. (if (consp dired-directory) ;; Directory name followed by list of files. - (cons (desktop-file-name (car dired-directory) desktop-dirname) + (cons (desktop-file-name (car dired-directory) dirname) (cdr dired-directory)) ;; Directory name, optionally with shell wildcard. - (desktop-file-name dired-directory desktop-dirname)) + (desktop-file-name dired-directory dirname)) ;; Subdirectories in `dired-subdir-alist'. (cdr (nreverse (mapcar - (function (lambda (f) (desktop-file-name (car f) desktop-dirname))) + (function (lambda (f) (desktop-file-name (car f) dirname))) dired-subdir-alist))))) (defun dired-restore-desktop-buffer (desktop-buffer-file-name diff --git a/lisp/emacs-lisp/byte-lexbind.el b/lisp/emacs-lisp/byte-lexbind.el index 313c4b6ad0f..06353e2eea8 100644 --- a/lisp/emacs-lisp/byte-lexbind.el +++ b/lisp/emacs-lisp/byte-lexbind.el @@ -585,6 +585,7 @@ proper scope)." (= nclosures byte-compile-current-num-closures)) ;; No need to push a heap environment. nil + (error "Should have been handled by cconv") ;; 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 diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 02107b0e11f..97ed6a01c2f 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1863,7 +1863,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; ;; stack-ref-N --> dup ; where N is TOS ;; - ((and (eq (car lap0) 'byte-stack-ref) + ((and stack-depth (eq (car lap0) 'byte-stack-ref) (= (cdr lap0) (1- stack-depth))) (setcar lap0 'byte-dup) (setcdr lap0 nil) @@ -2093,7 +2093,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos ;; stack-set-M [discard/discardN ...] --> discardN ;; - ((and (eq (car lap0) 'byte-stack-set) + ((and stack-depth ;Make sure we know the stack depth. + (eq (car lap0) 'byte-stack-set) (memq (car lap1) '(byte-discard byte-discardN)) (progn ;; See if enough discard operations follow to expose or @@ -2161,7 +2162,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; dup return --> return ;; stack-set-N return --> return ; where N is TOS-1 ;; - ((and (eq (car lap1) 'byte-return) + ((and stack-depth ;Make sure we know the stack depth. + (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))))) @@ -2174,7 +2176,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; ;; dup stack-set-N return --> return ; where N is TOS ;; - ((and (eq (car lap0) 'byte-dup) + ((and stack-depth ;Make sure we know the stack depth. + (eq (car lap0) 'byte-dup) (eq (car lap1) 'byte-stack-set) (eq (car (car (cdr (cdr rest)))) 'byte-return) (= (cdr lap1) (1- stack-depth))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f37d7489e9a..33940ec160e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -134,7 +134,7 @@ ;; `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)) +(eval-when-compile (require 'byte-lexbind nil 'noerror)) ;; The feature of compiling in a specific target Emacs version ;; has been turned off because compile time options are a bad idea. @@ -2240,7 +2240,7 @@ list that represents a doc string reference. bytecomp-handler) (setq form (macroexpand-all form byte-compile-macro-environment)) (if lexical-binding - (setq form (cconv-closure-convert-toplevel form))) + (setq form (cconv-closure-convert form))) (cond ((not (consp form)) (byte-compile-keep-pending form)) ((and (symbolp (car form)) @@ -2592,7 +2592,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (macroexpand-all fun byte-compile-initial-macro-environment)) (if lexical-binding - (setq fun (cconv-closure-convert-toplevel fun))) + (setq fun (cconv-closure-convert fun))) ;; get rid of the `function' quote added by the `lambda' macro (setq fun (cadr fun)) (setq fun (if macro @@ -2753,7 +2753,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; containing lexical environment are closed over). (and lexical-binding (byte-compile-closure-initial-lexenv-p - byte-compile-lexical-environment))) + byte-compile-lexical-environment) + (error "Should have been handled by cconv"))) (byte-compile-current-heap-environment nil) (byte-compile-current-num-closures 0) (compiled @@ -2791,6 +2792,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (eq (car-safe code) 'closure)) (defun byte-compile-make-closure (code) + (error "Should have been handled by cconv") ;; A real closure requires that the constant be curried with an ;; environment vector to make a closure object. (if for-effect diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index af42a2864c9..efb9d061b5c 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -87,7 +87,9 @@ Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).") (defun cconv-not-lexical-var-p (var) (or (not (symbolp var)) ; form is not a list - (special-variable-p var) + (if (eval-when-compile (fboundp 'special-variable-p)) + (special-variable-p var) + (boundp var)) ;; byte-compile-bound-variables normally holds both the ;; dynamic and lexical vars, but the bytecomp.el should ;; only call us at the top-level so there shouldn't be @@ -192,14 +194,8 @@ Returns a list of free variables." (cons form fvrs))))) ;;;###autoload -(defun cconv-closure-convert (form &optional toplevel) - ;; cconv-closure-convert-rec has a lot of parameters that are - ;; whether useless for user, whether they should contain - ;; specific data like a list of closure mutables or the list - ;; of lambdas suitable for lifting. - ;; - ;; That's why this function exists. - "Main entry point for non-toplevel forms. +(defun cconv-closure-convert (form) + "Main entry point for closure conversion. -- FORM is a piece of Elisp code after macroexpansion. -- TOPLEVEL(optional) is a boolean variable, true if we are at the root of AST @@ -221,19 +217,21 @@ Returns a form where all lambdas don't have any free variables." '() ; fvrs initially empty '() ; envs initially empty '() - toplevel))) ; true if the tree is a toplevel form + ))) -;;;###autoload -(defun cconv-closure-convert-toplevel (form) - "Entry point for toplevel forms. --- FORM is a piece of Elisp code after macroexpansion. +(defun cconv-lookup-let (table var binder form) + (let ((res nil)) + (dolist (elem table) + (when (and (eq (nth 2 elem) binder) + (eq (nth 3 elem) form)) + (assert (eq (car elem) var)) + (setq res elem))) + res)) -Returns a form where all lambdas don't have any free variables." - ;; we distinguish toplevel forms to treat def(un|var|const) correctly. - (cconv-closure-convert form t)) +(defconst cconv--dummy-var (make-symbol "ignored")) (defun cconv-closure-convert-rec - (form emvrs fvrs envs lmenvs defs-are-legal) + (form emvrs fvrs envs lmenvs) ;; This function actually rewrites the tree. "Eliminates all free variables of all lambdas in given forms. Arguments: @@ -245,8 +243,6 @@ within current environment. Initially empty. -- FVRS is a list of variables to substitute in each context. Initially empty. --- DEFS-ARE-LEGAL is a boolean variable, true if def(un|var|const) -can be used in this form(e.g. toplevel form) Returns a form where all lambdas don't have any free variables." ;; What's the difference between fvrs and envs? @@ -261,11 +257,11 @@ Returns a form where all lambdas don't have any free variables." ;; so we never touch it(unless we enter to the other closure). ;;(if (listp form) (print (car form)) form) (pcase form - (`(,(and letsym (or `let* `let)) ,varsvalues . ,body-forms) + (`(,(and letsym (or `let* `let)) ,binders . ,body-forms) ; let and let* special forms (let ((body-forms-new '()) - (varsvalues-new '()) + (binders-new '()) ;; next for variables needed for delayed push ;; because we should process ;; before we change any arguments @@ -274,83 +270,58 @@ Returns a form where all lambdas don't have any free variables." (emvr-push) ;needed only in case of let* (lmenv-push)) ;needed only in case of let* - (dolist (elm varsvalues) ;begin of dolist over varsvalues - (let (var value elm-new iscandidate ismutated) - (if (consp elm) ; (let (v1) ...) => (let ((v1 nil)) ...) - (progn - (setq var (car elm)) - (setq value (cadr elm))) - (setq var elm)) + (dolist (binder binders) + (let* ((value nil) + (var (if (not (consp binder)) + binder + (setq value (cadr binder)) + (car binder))) + (new-val + (cond + ;; Check if var is a candidate for lambda lifting. + ((cconv-lookup-let cconv-lambda-candidates var binder form) - ;; Check if var is a candidate for lambda lifting - (let ((lcandid cconv-lambda-candidates)) - (while (and lcandid (not iscandidate)) - (when (and (eq (caar lcandid) var) - (eq (caddar lcandid) elm) - (eq (cadr (cddar lcandid)) form)) - (setq iscandidate t)) - (setq lcandid (cdr lcandid)))) - - ; declared variable is a candidate - ; for lambda lifting - (if iscandidate - (let* ((func (cadr elm)) ; function(lambda) itself - ; free variables - (fv (delete-dups (cconv-freevars func '()))) - (funcvars (append fv (cadadr func))) ;function args - (funcbodies (cddadr func)) ; function bodies - (funcbodies-new '())) + (let* ((fv (delete-dups (cconv-freevars value '()))) + (funargs (cadr (cadr value))) + (funcvars (append fv funargs)) + (funcbodies (cddadr value)) ; function bodies + (funcbodies-new '())) ; lambda lifting condition - (if (or (not fv) (< cconv-liftwhen (length funcvars))) + (if (or (not fv) (< cconv-liftwhen (length funcvars))) ; do not lift - (setq - elm-new - `(,var - ,(cconv-closure-convert-rec - func emvrs fvrs envs lmenvs nil))) + (cconv-closure-convert-rec + value emvrs fvrs envs lmenvs) ; lift - (progn - (dolist (elm2 funcbodies) - (push ; convert function bodies - (cconv-closure-convert-rec - elm2 emvrs nil envs lmenvs nil) - funcbodies-new)) - (if (eq letsym 'let*) - (setq lmenv-push (cons var fv)) - (push (cons var fv) lmenvs-new)) + (progn + (dolist (elm2 funcbodies) + (push ; convert function bodies + (cconv-closure-convert-rec + elm2 emvrs nil envs lmenvs) + funcbodies-new)) + (if (eq letsym 'let*) + (setq lmenv-push (cons var fv)) + (push (cons var fv) lmenvs-new)) ; push lifted function - (setq elm-new - `(,var - (function . - ((lambda ,funcvars . - ,(reverse funcbodies-new))))))))) + `(function . + ((lambda ,funcvars . + ,(reverse funcbodies-new)))))))) - ;declared variable is not a function - (progn - ;; Check if var is mutated - (let ((lmutated cconv-captured+mutated)) - (while (and lmutated (not ismutated)) - (when (and (eq (caar lmutated) var) - (eq (caddar lmutated) elm) - (eq (cadr (cddar lmutated)) form)) - (setq ismutated t)) - (setq lmutated (cdr lmutated)))) - (if ismutated - (progn ; declared variable is mutated - (setq elm-new - `(,var (list ,(cconv-closure-convert-rec - value emvrs - fvrs envs lmenvs nil)))) + ;; Check if it needs to be turned into a "ref-cell". + ((cconv-lookup-let cconv-captured+mutated var binder form) + ;; Declared variable is mutated and captured. + (prog1 + `(list ,(cconv-closure-convert-rec + value emvrs + fvrs envs lmenvs)) (if (eq letsym 'let*) (setq emvr-push var) - (push var emvrs-new))) - (progn - (setq - elm-new - `(,var ; else - ,(cconv-closure-convert-rec - value emvrs fvrs envs lmenvs nil))))))) + (push var emvrs-new)))) + + ;; Normal default case. + (t + (cconv-closure-convert-rec + value emvrs fvrs envs lmenvs))))) ;; this piece of code below letbinds free ;; variables of a lambda lifted function @@ -384,12 +355,12 @@ Returns a form where all lambdas don't have any free variables." (when new-lmenv (setq lmenvs (remq old-lmenv lmenvs)) (push new-lmenv lmenvs) - (push `(,closedsym ,var) varsvalues-new)))) + (push `(,closedsym ,var) binders-new)))) ;; we push the element after redefined free variables ;; are processes. this is important to avoid the bug ;; when free variable and the function have the same ;; name - (push elm-new varsvalues-new) + (push (list var new-val) binders-new) (when (eq letsym 'let*) ; update fvrs (setq fvrs (remq var fvrs)) @@ -405,23 +376,23 @@ Returns a form where all lambdas don't have any free variables." (when lmenv-push (push lmenv-push lmenvs) (setq lmenv-push nil))) - )) ; end of dolist over varsvalues + )) ; end of dolist over binders (when (eq letsym 'let) (let (var fvrs-1 emvrs-1 lmenvs-1) ;; Here we update emvrs, fvrs and lmenvs lists (dolist (vr fvrs) ; safely remove - (when (not (assq vr varsvalues-new)) (push vr fvrs-1))) + (when (not (assq vr binders-new)) (push vr fvrs-1))) (setq fvrs fvrs-1) (dolist (vr emvrs) ; safely remove - (when (not (assq vr varsvalues-new)) (push vr emvrs-1))) + (when (not (assq vr binders-new)) (push vr emvrs-1))) (setq emvrs emvrs-1) ; push new (setq emvrs (append emvrs emvrs-new)) (dolist (vr lmenvs) - (when (not (assq (car vr) varsvalues-new)) + (when (not (assq (car vr) binders-new)) (push vr lmenvs-1))) (setq lmenvs (append lmenvs lmenvs-new))) @@ -432,10 +403,9 @@ Returns a form where all lambdas don't have any free variables." (let ((new-lmenv) (var nil) (closedsym nil) - (letbinds '()) - (fvrs-new)) ; list of (closed-var var) - (dolist (elm varsvalues) - (setq var (if (consp elm) (car elm) elm)) + (letbinds '())) + (dolist (binder binders) + (setq var (if (consp binder) (car binder) binder)) (let ((lmenvs-1 lmenvs)) ; just to avoid manipulating (dolist (lmenv lmenvs-1) ; the counter inside the loop @@ -453,13 +423,13 @@ Returns a form where all lambdas don't have any free variables." (push new-lmenv lmenvs) (push `(,closedsym ,var) letbinds) )))) - (setq varsvalues-new (append varsvalues-new letbinds)))) + (setq binders-new (append binders-new letbinds)))) (dolist (elm body-forms) ; convert body forms (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) + elm emvrs fvrs envs lmenvs) body-forms-new)) - `(,letsym ,(reverse varsvalues-new) . ,(reverse body-forms-new)))) + `(,letsym ,(reverse binders-new) . ,(reverse body-forms-new)))) ;end of let let* forms ; first element is lambda expression @@ -468,13 +438,12 @@ Returns a form where all lambdas don't have any free variables." (let ((other-body-forms-new '())) (dolist (elm other-body-forms) (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) + elm emvrs fvrs envs lmenvs) other-body-forms-new)) - (cons - (cadr - (cconv-closure-convert-rec - (list 'function fun) emvrs fvrs envs lmenvs nil)) - (reverse other-body-forms-new)))) + `(funcall + ,(cconv-closure-convert-rec + (list 'function fun) emvrs fvrs envs lmenvs) + ,@(nreverse other-body-forms-new)))) (`(cond . ,cond-forms) ; cond special form (let ((cond-forms-new '())) @@ -483,7 +452,7 @@ Returns a form where all lambdas don't have any free variables." (dolist (elm-2 elm) (push (cconv-closure-convert-rec - elm-2 emvrs fvrs envs lmenvs nil) + elm-2 emvrs fvrs envs lmenvs) elm-new)) (reverse elm-new)) cond-forms-new)) @@ -523,7 +492,7 @@ Returns a form where all lambdas don't have any free variables." (dolist (elm fv) (push (cconv-closure-convert-rec - elm (remq elm emvrs) fvrs envs lmenvs nil) + elm (remq elm emvrs) fvrs envs lmenvs) envector)) ; process vars for closure vector (setq envector (reverse envector)) (setq envs fv)) @@ -539,7 +508,7 @@ Returns a form where all lambdas don't have any free variables." (push `(,mv (list ,mv)) letbind)))) (dolist (elm body-forms) ; convert function body (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) + elm emvrs fvrs envs lmenvs) body-forms-new)) (setq body-forms-new @@ -566,83 +535,89 @@ Returns a form where all lambdas don't have any free variables." ;defconst, defvar (`(,(and sym (or `defconst `defvar)) ,definedsymbol . ,body-forms) - (if defs-are-legal - (let ((body-forms-new '())) - (dolist (elm body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) - body-forms-new)) - (setq body-forms-new (reverse body-forms-new)) - `(,sym ,definedsymbol . ,body-forms-new)) - (error "Invalid form: %s inside a function" sym))) + (let ((body-forms-new '())) + (dolist (elm body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs) + body-forms-new)) + (setq body-forms-new (reverse body-forms-new)) + `(,sym ,definedsymbol . ,body-forms-new))) ;defun, defmacro (`(,(and sym (or `defun `defmacro)) ,func ,vars . ,body-forms) - (if defs-are-legal - (let ((body-new '()) ; the whole body - (body-forms-new '()) ; body w\o docstring and interactive - (letbind '())) + (let ((body-new '()) ; the whole body + (body-forms-new '()) ; body w\o docstring and interactive + (letbind '())) ; find mutable arguments - (let ((lmutated cconv-captured+mutated) ismutated) - (dolist (elm vars) - (setq ismutated nil) - (while (and lmutated (not ismutated)) - (when (and (eq (caar lmutated) elm) - (eq (cadar lmutated) form)) - (setq ismutated t)) - (setq lmutated (cdr lmutated))) - (when ismutated - (push elm letbind) - (push elm emvrs)))) + (let ((lmutated cconv-captured+mutated) ismutated) + (dolist (elm vars) + (setq ismutated nil) + (while (and lmutated (not ismutated)) + (when (and (eq (caar lmutated) elm) + (eq (cadar lmutated) form)) + (setq ismutated t)) + (setq lmutated (cdr lmutated))) + (when ismutated + (push elm letbind) + (push elm emvrs)))) ;transform body-forms - (when (stringp (car body-forms)) ; treat docstring well - (push (car body-forms) body-new) - (setq body-forms (cdr body-forms))) - (when (eq (car-safe (car body-forms)) 'interactive) - (push - (cconv-closure-convert-rec - (car body-forms) - emvrs fvrs envs lmenvs nil) body-new) - (setq body-forms (cdr body-forms))) + (when (stringp (car body-forms)) ; treat docstring well + (push (car body-forms) body-new) + (setq body-forms (cdr body-forms))) + (when (eq (car-safe (car body-forms)) 'interactive) + (push (cconv-closure-convert-rec + (car body-forms) + emvrs fvrs envs lmenvs) + body-new) + (setq body-forms (cdr body-forms))) - (dolist (elm body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) - body-forms-new)) - (setq body-forms-new (reverse body-forms-new)) + (dolist (elm body-forms) + (push (cconv-closure-convert-rec + elm emvrs fvrs envs lmenvs) + body-forms-new)) + (setq body-forms-new (reverse body-forms-new)) - (if letbind + (if letbind ; letbind mutable arguments - (let ((varsvalues-new '())) - (dolist (elm letbind) (push `(,elm (list ,elm)) - varsvalues-new)) - (push `(let ,(reverse varsvalues-new) . - ,body-forms-new) body-new) - (setq body-new (reverse body-new))) - (setq body-new (append (reverse body-new) body-forms-new))) + (let ((binders-new '())) + (dolist (elm letbind) (push `(,elm (list ,elm)) + binders-new)) + (push `(let ,(reverse binders-new) . + ,body-forms-new) body-new) + (setq body-new (reverse body-new))) + (setq body-new (append (reverse body-new) body-forms-new))) - `(,sym ,func ,vars . ,body-new)) + `(,sym ,func ,vars . ,body-new))) - (error "Invalid form: defun inside a function"))) ;condition-case - (`(condition-case ,var ,protected-form . ,conditions-bodies) - (let ((conditions-bodies-new '())) + (`(condition-case ,var ,protected-form . ,handlers) + (let ((handlers-new '()) + (newform (cconv-closure-convert-rec + `(function (lambda () ,protected-form)) + emvrs fvrs envs lmenvs))) (setq fvrs (remq var fvrs)) - (dolist (elm conditions-bodies) - (push (let ((elm-new '())) - (dolist (elm-2 (cdr elm)) - (push - (cconv-closure-convert-rec - elm-2 emvrs fvrs envs lmenvs nil) - elm-new)) - (cons (car elm) (reverse elm-new))) - conditions-bodies-new)) - `(condition-case - ,var - ,(cconv-closure-convert-rec - protected-form emvrs fvrs envs lmenvs nil) - . ,(reverse conditions-bodies-new)))) + (dolist (handler handlers) + (push (list (car handler) + (cconv-closure-convert-rec + `(function (lambda (,(or var cconv--dummy-var)) + ,@(cdr handler))) + emvrs fvrs envs lmenvs)) + handlers-new)) + `(condition-case :fun-body ,newform + ,@(nreverse handlers-new)))) + + (`(,(and head (or `catch `unwind-protect)) ,form . ,body) + `(,head ,(cconv-closure-convert-rec form emvrs fvrs envs lmenvs) + :fun-body + ,(cconv-closure-convert-rec `(function (lambda () ,@body)) + emvrs fvrs envs lmenvs))) + + (`(,(and head (or `save-window-excursion `track-mouse)) . ,body) + `(,head + :fun-body + ,(cconv-closure-convert-rec `(function (lambda () ,@body)) + emvrs fvrs envs lmenvs))) (`(setq . ,forms) ; setq special form (let (prognlist sym sym-new value) @@ -650,10 +625,10 @@ Returns a form where all lambdas don't have any free variables." (setq sym (car forms)) (setq sym-new (cconv-closure-convert-rec sym - (remq sym emvrs) fvrs envs lmenvs nil)) + (remq sym emvrs) fvrs envs lmenvs)) (setq value (cconv-closure-convert-rec - (cadr forms) emvrs fvrs envs lmenvs nil)) + (cadr forms) emvrs fvrs envs lmenvs)) (if (memq sym emvrs) (push `(setcar ,sym-new ,value) prognlist) (if (symbolp sym-new) @@ -678,21 +653,21 @@ Returns a form where all lambdas don't have any free variables." (dolist (fvr fv) (push (cconv-closure-convert-rec fvr (remq fvr emvrs) - fvrs envs lmenvs nil) + fvrs envs lmenvs) processed-fv)) (setq processed-fv (reverse processed-fv)) (dolist (elm args) (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) + elm emvrs fvrs envs lmenvs) args-new)) (setq args-new (append processed-fv (reverse args-new))) (setq fun (cconv-closure-convert-rec - fun emvrs fvrs envs lmenvs nil)) + fun emvrs fvrs envs lmenvs)) `(,callsym ,fun . ,args-new)) (let ((cdr-new '())) (dolist (elm (cdr form)) (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs nil) + elm emvrs fvrs envs lmenvs) cdr-new)) `(,callsym . ,(reverse cdr-new)))))) @@ -703,7 +678,7 @@ Returns a form where all lambdas don't have any free variables." (let ((body-forms-new '())) (dolist (elm body-forms) (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs defs-are-legal) + elm emvrs fvrs envs lmenvs) body-forms-new)) (setq body-forms-new (reverse body-forms-new)) `(,func . ,body-forms-new))) diff --git a/lisp/mpc.el b/lisp/mpc.el index 4f21a162c08..548fd17d038 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -1,5 +1,4 @@ -;;; -*- lexical-binding: t -*- -;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8 -*- +;;; mpc.el --- A client for the Music Player Daemon -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 2006-2011 Free Software Foundation, Inc. From ce5b520a3758e22c6516e0d864d8c1a3512bf457 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 12 Feb 2011 00:53:30 -0500 Subject: [PATCH 14/45] * lisp/emacs-lisp/byte-lexbind.el: Delete. * lisp/emacs-lisp/bytecomp.el (byte-compile-current-heap-environment) (byte-compile-current-num-closures): Remove vars. (byte-vec-ref, byte-vec-set): Remove byte codes. (byte-compile-arglist-vars, byte-compile-make-lambda-lexenv): Move from byte-lexbind.el. (byte-compile-lambda): Never build a closure. (byte-compile-closure-code-p, byte-compile-make-closure): Remove. (byte-compile-closure): Simplify. (byte-compile-top-level): Don't mess with heap environments. (byte-compile-dynamic-variable-bind): Always maintain byte-compile-bound-variables. (byte-compile-variable-ref, byte-compile-variable-set): Always just use the stack for lexical vars. (byte-compile-push-binding-init): Simplify. (byte-compile-not-lexical-var-p): New function, moved from cconv.el. (byte-compile-bind, byte-compile-unbind): New functions, moved and simplified from byte-lexbind.el. (byte-compile-let, byte-compile-let*): Simplify. (byte-compile-condition-case): Don't add :fun-body to the bound vars. (byte-compile-defmacro): Simplify. * lisp/emacs-lisp/byte-opt.el (byte-compile-side-effect-free-ops) (byte-optimize-lapcode): Remove byte-vec-ref and byte-vec-set. * lisp/emacs-lisp/cconv.el (cconv-not-lexical-var-p): Remove. (cconv-freevars, cconv-analyse-function, cconv-analyse-form): Use byte-compile-not-lexical-var-p instead. * src/bytecode.c (Bvec_ref, Bvec_set): Remove. (exec_byte_code): Don't handle them. * lisp/help-fns.el (describe-function-1): Fix paren typo. --- lisp/ChangeLog | 34 ++ lisp/emacs-lisp/byte-lexbind.el | 699 -------------------------------- lisp/emacs-lisp/byte-opt.el | 4 +- lisp/emacs-lisp/bytecomp.el | 553 ++++++++++--------------- lisp/emacs-lisp/cconv.el | 19 +- lisp/help-fns.el | 34 +- src/ChangeLog | 5 + src/bytecode.c | 23 -- 8 files changed, 283 insertions(+), 1088 deletions(-) delete mode 100644 lisp/emacs-lisp/byte-lexbind.el diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c3451d9b269..b972f17909a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,37 @@ +2011-02-12 Stefan Monnier + + * emacs-lisp/byte-lexbind.el: Delete. + + * emacs-lisp/bytecomp.el (byte-compile-current-heap-environment) + (byte-compile-current-num-closures): Remove vars. + (byte-vec-ref, byte-vec-set): Remove byte codes. + (byte-compile-arglist-vars, byte-compile-make-lambda-lexenv): Move from + byte-lexbind.el. + (byte-compile-lambda): Never build a closure. + (byte-compile-closure-code-p, byte-compile-make-closure): Remove. + (byte-compile-closure): Simplify. + (byte-compile-top-level): Don't mess with heap environments. + (byte-compile-dynamic-variable-bind): Always maintain + byte-compile-bound-variables. + (byte-compile-variable-ref, byte-compile-variable-set): Always just use + the stack for lexical vars. + (byte-compile-push-binding-init): Simplify. + (byte-compile-not-lexical-var-p): New function, moved from cconv.el. + (byte-compile-bind, byte-compile-unbind): New functions, moved and + simplified from byte-lexbind.el. + (byte-compile-let, byte-compile-let*): Simplify. + (byte-compile-condition-case): Don't add :fun-body to the bound vars. + (byte-compile-defmacro): Simplify. + + * emacs-lisp/cconv.el (cconv-not-lexical-var-p): Remove. + (cconv-freevars, cconv-analyse-function, cconv-analyse-form): + Use byte-compile-not-lexical-var-p instead. + + * help-fns.el (describe-function-1): Fix paren typo. + + * emacs-lisp/byte-opt.el (byte-compile-side-effect-free-ops) + (byte-optimize-lapcode): Remove byte-vec-ref and byte-vec-set. + 2011-02-11 Stefan Monnier * emacs-lisp/cconv.el (cconv-closure-convert): Drop `toplevel' arg. diff --git a/lisp/emacs-lisp/byte-lexbind.el b/lisp/emacs-lisp/byte-lexbind.el deleted file mode 100644 index 06353e2eea8..00000000000 --- a/lisp/emacs-lisp/byte-lexbind.el +++ /dev/null @@ -1,699 +0,0 @@ -;;; byte-lexbind.el --- Lexical binding support for byte-compiler -;; -;; Copyright (C) 2001, 2002, 2010, 2011 Free Software Foundation, Inc. -;; -;; Author: Miles Bader -;; 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 3, 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 (special-variable-p 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 (special-variable-p 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))))))) - ((and (eq fun 'catch) (not (eq :fun-body (nth 2 form)))) - ;; 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 (eq (nth 1 form) :fun-body) - closure-flag byte-compile-use-downward-closures) - ;; condition case is implemented by calling a function - (setq closure-flag (byte-compile-lforminfo-make-closure-flag))) - ;; value form - (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 - ) - ((and (eq fun 'save-window-excursion) - (not (eq :fun-body (nth 1 form)))) - ;; `save-window-excursion' currently uses a funny implementation - ;; that requires its body forms be put into a closure (it should - ;; be fixed to work more like `save-excursion' etc., do). - (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) - (zerop nclosures) - (= nclosures byte-compile-current-num-closures)) - ;; No need to push a heap environment. - nil - (error "Should have been handled by cconv") - ;; 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) - -;;; byte-lexbind.el ends here diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 97ed6a01c2f..71960ad54dc 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1483,7 +1483,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-vec-ref) + byte-member byte-assq byte-quo byte-rem) byte-compile-side-effect-and-error-free-ops)) ;; This crock is because of the way DEFVAR_BOOL variables work. @@ -1671,7 +1671,7 @@ 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 byte-stack-set byte-vec-set))) + (memq (car lap1) '(byte-varset byte-varbind byte-stack-set))) (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1) (setq keep-going t rest (cdr rest) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 33940ec160e..e9beb0c5792 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -126,47 +126,11 @@ ;; 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 nil 'noerror)) - ;; 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." @@ -439,24 +403,15 @@ 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 t) (setq debug-on-error 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 "List of all variables encountered during compilation of this form.") (defvar byte-compile-bound-variables nil - "List of variables bound in the context of the current form. + "List of dynamic variables bound in the context of the current form. This list lives partly on the stack.") (defvar byte-compile-const-variables nil "List of variables declared as constants during compilation of this file.") @@ -512,10 +467,6 @@ 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 @@ -734,8 +685,6 @@ otherwise pop it") (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 @@ -824,68 +773,71 @@ CONST2 may be evaulated multiple times." (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)) - ((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 - (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)))))) + (cond + ((not (symbolp op)) + (error "Non-symbolic opcode `%s'" op)) + ((eq op 'TAG) + (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 opcode + (if (eq op 'byte-discardN-preserve-tos) + ;; byte-discardN-preserve-tos is a pseudo op, which + ;; is actually the same as byte-discardN + ;; with a modified argument. + byte-discardN + (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))) @@ -1694,7 +1646,7 @@ that already has a `.elc' file." "Non-nil to prevent byte-compiling of Emacs Lisp code. This is normally set in local file variables at the end of the elisp file: -;; Local Variables:\n;; no-byte-compile: t\n;; End: ") +\;; Local Variables:\n;; no-byte-compile: t\n;; End: ") ;Backslash for compile-main. ;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp) (defun byte-recompile-file (bytecomp-filename &optional bytecomp-force bytecomp-arg load) @@ -2682,7 +2634,23 @@ 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") +(defun byte-compile-arglist-vars (arglist) + "Return a list of the variables in the lambda argument list ARGLIST." + (remq '&rest (remq '&optional arglist))) + +(defun byte-compile-make-lambda-lexenv (form) + "Return a new lexical environment for a lambda expression FORM." + ;; See if this is a closure or not + (let ((args (byte-compile-arglist-vars (cadr form)))) + (let ((lexenv nil)) + ;; Fill in the initial stack contents + (let ((stackpos 0)) + ;; Add entries for each argument + (dolist (arg args) + (push (cons arg stackpos) lexenv) + (setq stackpos (1+ stackpos))) + ;; Return the new lexical environment + lexenv)))) ;; Byte-compile a lambda-expression and return a valid function. ;; The value is usually a compiled function but may be the original @@ -2700,10 +2668,9 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-check-lambda-list (nth 1 bytecomp-fun)) (let* ((bytecomp-arglist (nth 1 bytecomp-fun)) (byte-compile-bound-variables - (nconc (and (byte-compile-warning-enabled-p 'free-vars) - (delq '&rest - (delq '&optional (copy-sequence bytecomp-arglist)))) - byte-compile-bound-variables)) + (append (and (not lexical-binding) + (byte-compile-arglist-vars bytecomp-arglist)) + byte-compile-bound-variables)) (bytecomp-body (cdr (cdr bytecomp-fun))) (bytecomp-doc (if (stringp (car bytecomp-body)) (prog1 (car bytecomp-body) @@ -2742,42 +2709,27 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; Process the body. (let* ((byte-compile-lexical-environment ;; If doing lexical binding, push a new lexical environment - ;; containing the args and any closed-over variables. + ;; containing just the args (since lambda expressions + ;; should be closed by now). (and lexical-binding - (byte-compile-make-lambda-lexenv - bytecomp-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) - (error "Should have been handled by cconv"))) - (byte-compile-current-heap-environment nil) - (byte-compile-current-num-closures 0) + (byte-compile-make-lambda-lexenv bytecomp-fun))) (compiled (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda))) ;; Build the actual byte-coded function. (if (eq 'byte-code (car-safe compiled)) - (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)) + (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)))) (setq compiled (nconc (if bytecomp-int (list bytecomp-int)) (cond ((eq (car-safe compiled) 'progn) (cdr compiled)) @@ -2788,26 +2740,10 @@ 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) - (error "Should have been handled by cconv") - ;; 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)))) + ;; 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. @@ -2867,34 +2803,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; 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)))) + (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))))) + (byte-compile-out-tag (byte-compile-make-tag)))) ;; Now compile FORM (byte-compile-form form for-effect) (byte-compile-out-toplevel for-effect output-type)))) @@ -3044,7 +2957,7 @@ That command is designed for interactive use only" bytecomp-fn)) (if (memq bytecomp-fn '(custom-declare-group custom-declare-variable custom-declare-face)) - (byte-compile-nogroup-warn form)) + (byte-compile-nogroup-warn form)) (byte-compile-callargs-warn form)) (if (and bytecomp-handler ;; Make sure that function exists. This is important @@ -3107,40 +3020,16 @@ If BINDING is non-nil, VAR is being bound." (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)) + (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))) + (byte-compile-stack-ref (cdr lex-binding)) ;; VAR is dynamically bound (unless (or (not (byte-compile-warning-enabled-p 'free-vars)) (boundp var) @@ -3156,14 +3045,7 @@ If BINDING is non-nil, VAR is being bound." (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))) + (byte-compile-stack-set (cdr lex-binding)) ;; VAR is dynamically bound (unless (or (not (byte-compile-warning-enabled-p 'free-vars)) (boundp var) @@ -3795,9 +3677,7 @@ that suppresses all warnings during execution of BODY." ,condition (list 'boundp 'default-boundp))) ;; Maybe add to the bound list. (byte-compile-bound-variables - (if bound-list - (append bound-list byte-compile-bound-variables) - byte-compile-bound-variables))) + (append bound-list byte-compile-bound-variables))) (unwind-protect ;; If things not being bound at all is ok, so must them being obsolete. ;; Note that we add to the existing lists since Tramp (ab)uses @@ -3910,14 +3790,7 @@ that suppresses all warnings during execution of BODY." (defun byte-compile-while (form) (let ((endtag (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)) + (looptag (byte-compile-make-tag))) (byte-compile-out-tag looptag) (byte-compile-form (car (cdr form))) (byte-compile-goto-if nil for-effect endtag) @@ -3933,109 +3806,131 @@ that suppresses all warnings during execution of BODY." ;; 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) +(defun byte-compile-push-binding-init (clause) "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)) +Return the offset in the form (VAR . OFFSET)." + (let* ((var (if (consp clause) (car clause) clause))) + ;; 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. + (prog1 (cons var byte-compile-depth) (if (consp clause) - (byte-compile-form (cadr clause) unused) - (byte-compile-push-constant nil)))) - init-lexenv) + (byte-compile-form (cadr clause)) + (byte-compile-push-constant nil))))) + +(defun byte-compile-not-lexical-var-p (var) + (or (not (symbolp var)) ; form is not a list + (if (eval-when-compile (fboundp 'special-variable-p)) + (special-variable-p var) + (boundp var)) + (memq var byte-compile-bound-variables) + (memq var '(nil t)) + (keywordp var))) + +(defun byte-compile-bind (var init-lexenv) + "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. +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. + (cond ((not (byte-compile-not-lexical-var-p var)) + ;; VAR is a simple stack-allocated lexical variable + (push (assq var init-lexenv) + byte-compile-lexical-environment) + nil) + ((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) + (t + ;; 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))) + +(defun byte-compile-unbind (clauses init-lexenv + &optional 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. 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)) + (dolist (clause clauses) + (unless (assq (if (consp clause) (car clause) clause) + byte-compile-lexical-environment) + (setq num-dynamic-bindings (1+ num-dynamic-bindings)))) + (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))) (defun byte-compile-let (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) + ;; First compute the binding values in the old scope. + (let ((varlist (car (cdr form))) + (init-lexenv nil)) + (dolist (var varlist) + (push (byte-compile-push-binding-init var) init-lexenv)) + ;; Now do the bindings, execute the body, and undo the bindings. + (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope + (varlist (reverse (car (cdr form)))) + (byte-compile-lexical-environment byte-compile-lexical-environment)) + (dolist (var varlist) + (let ((var (if (consp var) (car var) var))) + (cond ((null lexical-binding) ;; If there are no lexical bindings, we can do things simply. (byte-compile-dynamic-variable-bind var)) - ((byte-compile-bind var init-lexenv lforminfo) + ((byte-compile-bind var init-lexenv) (pop init-lexenv))))) - ;; Emit the body + ;; 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)))))) + ;; Unbind the variables. + (if lexical-binding + ;; Unbind both lexical and dynamic variables. + (byte-compile-unbind varlist init-lexenv t) + ;; Unbind dynamic variables. + (byte-compile-out 'byte-unbind (length varlist)))))) (defun byte-compile-let* (form) "Generate code for the `let*' form FORM." - (let ((clauses (cadr form)) - (lforminfo (and lexical-binding (byte-compile-compute-lforminfo form))) + (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope + (clauses (cadr 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))) + + (byte-compile-lexical-environment byte-compile-lexical-environment)) ;; 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) + (dolist (var clauses) + (push (byte-compile-push-binding-init var) init-lexenv) + (let ((var (if (consp var) (car var) var))) + (cond ((null lexical-binding) ;; If there are no lexical bindings, we can do things simply. (byte-compile-dynamic-variable-bind var)) - ((byte-compile-bind var init-lexenv lforminfo) + ((byte-compile-bind var init-lexenv) (pop init-lexenv))))) ;; Emit the body (byte-compile-body-do-effect (cdr (cdr form))) ;; Unbind the variables - (if lforminfo + (if lexical-binding ;; Unbind both lexical and dynamic variables - (byte-compile-unbind clauses init-lexenv lforminfo preserve-body-value) + (byte-compile-unbind clauses init-lexenv t) ;; Unbind dynamic variables (byte-compile-out 'byte-unbind (length clauses))))) @@ -4105,10 +4000,11 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." (defun byte-compile-condition-case (form) (let* ((var (nth 1 form)) - (byte-compile-bound-variables - (if var (cons var byte-compile-bound-variables) - byte-compile-bound-variables)) - (fun-bodies (eq var :fun-body))) + (fun-bodies (eq var :fun-body)) + (byte-compile-bound-variables + (if (and var (not fun-bodies)) + (cons var byte-compile-bound-variables) + byte-compile-bound-variables))) (byte-compile-set-symbol-position 'condition-case) (unless (symbolp var) (byte-compile-warn @@ -4215,12 +4111,7 @@ if LFORMINFO is nil (meaning all bindings are dynamic)." (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-push-constant (cons 'macro code)) (byte-compile-out 'byte-fset) (byte-compile-discard)) (byte-compile-constant (nth 1 form))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index efb9d061b5c..10464047cd3 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -85,19 +85,6 @@ is less than this number.") "List of candidates for lambda lifting. Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).") -(defun cconv-not-lexical-var-p (var) - (or (not (symbolp var)) ; form is not a list - (if (eval-when-compile (fboundp 'special-variable-p)) - (special-variable-p var) - (boundp var)) - ;; byte-compile-bound-variables normally holds both the - ;; dynamic and lexical vars, but the bytecomp.el should - ;; only call us at the top-level so there shouldn't be - ;; any lexical vars in it here. - (memq var byte-compile-bound-variables) - (memq var '(nil t)) - (keywordp var))) - (defun cconv-freevars (form &optional fvrs) "Find all free variables of given form. Arguments: @@ -189,7 +176,7 @@ Returns a list of free variables." (dolist (exp body-forms) (setq fvrs (cconv-freevars exp fvrs))) fvrs) - (_ (if (cconv-not-lexical-var-p form) + (_ (if (byte-compile-not-lexical-var-p form) fvrs (cons form fvrs))))) @@ -704,7 +691,7 @@ Returns a form where all lambdas don't have any free variables." (defun cconv-analyse-function (args body env parentform inclosure) (dolist (arg args) (cond - ((cconv-not-lexical-var-p arg) + ((byte-compile-not-lexical-var-p arg) (byte-compile-report-error (format "Argument %S is not a lexical variable" arg))) ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... @@ -738,7 +725,7 @@ lambdas if they are suitable for lambda lifting. (cconv-analyse-form value (if (eq letsym 'let*) env orig-env) inclosure)) - (unless (cconv-not-lexical-var-p var) + (unless (byte-compile-not-lexical-var-p var) (let ((varstruct (list var inclosure binder form))) (push varstruct env) ; Push a new one. diff --git a/lisp/help-fns.el b/lisp/help-fns.el index ed266c71a59..172a74d8c80 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -529,23 +529,23 @@ suitable file is found, return nil." (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/src/ChangeLog b/src/ChangeLog index f7a3fcc8b1b..6674fb31ca5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-02-12 Stefan Monnier + + * bytecode.c (Bvec_ref, Bvec_set): Remove. + (exec_byte_code): Don't handle them. + 2010-12-27 Stefan Monnier * eval.c (Fdefvar): Record specialness before computing initial value. diff --git a/src/bytecode.c b/src/bytecode.c index 96d2aa273f2..9bf6ae45ce9 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -231,8 +231,6 @@ extern Lisp_Object Qand_optional, Qand_rest; /* 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 @@ -1722,27 +1720,6 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, 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, make_number (index)); - - if (op == Bvec_ref) - PUSH (XVECTOR (vec)->contents[index]); - else - XVECTOR (vec)->contents[index] = POP; - } - break; case BdiscardN: op = FETCH; if (op & 0x80) From b38b1ec071ee9752da53f2485902165fe728e8fa Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 17 Feb 2011 16:19:13 -0500 Subject: [PATCH 15/45] Various compiler bug-fixes. MPC seems to run correctly now. * lisp/files.el (lexical-binding): Add a safe-local-variable property. * lisp/emacs-lisp/byte-opt.el (byte-inline-lapcode): Check how many elements are added to the stack. (byte-compile-splice-in-already-compiled-code): Don't touch lexical nor byte-compile-depth now that byte-inline-lapcode does it for us. (byte-compile-inline-expand): Don't inline dynbind byte code into lexbind code, since it has to be done differently. * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-warn): Correctly extract arglist from `closure's. (byte-compile-cl-warn): Compiler-macros are run earlier now. (byte-compile-top-level): Bind byte-compile-lexical-environment to nil, except for lambdas. (byte-compile-form): Don't run the compiler-macro expander here. (byte-compile-let): Merge with byte-compile-let*. Don't preserve-body-value if the body's value was discarded. * lisp/emacs-lisp/cconv.el (cconv--set-diff, cconv--set-diff-map) (cconv--map-diff, cconv--map-diff-elem, cconv--map-diff-set): New funs. (cconv--env-var): New constant. (cconv-closure-convert-rec): Use it and use them. Fix a typo that ended up forgetting to remove entries from lmenvs in `let'. For `lambda' use the outer `fvrs' when building the closure and don't forget to remove `vars' from the `emvrs' and `lmenvs' of the body. * lisp/emacs-lisp/cl-macs.el (cl-byte-compile-block): Disable optimization in lexbind, because it needs a different implementation. * src/bytecode.c (exec_byte_code): Fix handling of &rest. * src/eval.c (Vinternal_interpreter_environment): Remove. (syms_of_eval): Do declare Vinternal_interpreter_environment as a global lisp var, but unintern it to hide it. (Fcommandp): * src/data.c (Finteractive_form): Understand `closure's. --- lisp/ChangeLog | 31 +++++++ lisp/doc-view.el | 4 +- lisp/emacs-lisp/byte-opt.el | 63 ++++++++------ lisp/emacs-lisp/bytecomp.el | 149 ++++++++++++++------------------- lisp/emacs-lisp/cconv.el | 142 +++++++++++++++++++------------ lisp/emacs-lisp/cl-loaddefs.el | 2 +- lisp/emacs-lisp/cl-macs.el | 8 +- lisp/emacs-lisp/pcase.el | 3 +- lisp/files.el | 25 +++--- lisp/help-fns.el | 2 +- src/ChangeLog | 10 +++ src/bytecode.c | 4 +- src/data.c | 2 + src/eval.c | 34 ++++---- src/lisp.h | 2 +- 15 files changed, 280 insertions(+), 201 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b972f17909a..142deda9505 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,34 @@ +2011-02-17 Stefan Monnier + + * files.el (lexical-binding): Add a safe-local-variable property. + + * emacs-lisp/cl-macs.el (cl-byte-compile-block): Disable optimization + in lexbind, because it needs a different implementation. + + * emacs-lisp/cconv.el (cconv--set-diff, cconv--set-diff-map) + (cconv--map-diff, cconv--map-diff-elem, cconv--map-diff-set): New funs. + (cconv--env-var): New constant. + (cconv-closure-convert-rec): Use it and use them. Fix a typo that + ended up forgetting to remove entries from lmenvs in `let'. + For `lambda' use the outer `fvrs' when building the closure and don't + forget to remove `vars' from the `emvrs' and `lmenvs' of the body. + + * emacs-lisp/bytecomp.el (byte-compile-arglist-warn): + Correctly extract arglist from `closure's. + (byte-compile-cl-warn): Compiler-macros are run earlier now. + (byte-compile-top-level): Bind byte-compile-lexical-environment to nil, + except for lambdas. + (byte-compile-form): Don't run the compiler-macro expander here. + (byte-compile-let): Merge with byte-compile-let*. + Don't preserve-body-value if the body's value was discarded. + + * emacs-lisp/byte-opt.el (byte-inline-lapcode): Check how many elements + are added to the stack. + (byte-compile-splice-in-already-compiled-code): Don't touch lexical nor + byte-compile-depth now that byte-inline-lapcode does it for us. + (byte-compile-inline-expand): Don't inline dynbind byte code into + lexbind code, since it has to be done differently. + 2011-02-12 Stefan Monnier * emacs-lisp/byte-lexbind.el: Delete. diff --git a/lisp/doc-view.el b/lisp/doc-view.el index 4f8c338409b..7bead624cc7 100644 --- a/lisp/doc-view.el +++ b/lisp/doc-view.el @@ -1,5 +1,5 @@ -;;; -*- lexical-binding: t -*- -;;; doc-view.el --- View PDF/PostScript/DVI files in Emacs +;;; doc-view.el --- View PDF/PostScript/DVI files in Emacs -*- lexical-binding: t -*- + ;; Copyright (C) 2007-2011 Free Software Foundation, Inc. ;; diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 71960ad54dc..12df3251267 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -248,7 +248,18 @@ ;; are no collisions, and that byte-compile-tag-number is reasonable ;; after this is spliced in. The provided list is destroyed. (defun byte-inline-lapcode (lap) - (setq byte-compile-output (nconc (nreverse lap) byte-compile-output))) + ;; "Replay" the operations: we used to just do + ;; (setq byte-compile-output (nconc (nreverse lap) byte-compile-output)) + ;; but that fails to update byte-compile-depth, so we had to assume + ;; that `lap' ends up adding exactly 1 element to the stack. This + ;; happens to be true for byte-code generated by bytecomp.el without + ;; lexical-binding, but it's not true in general, and it's not true for + ;; code output by bytecomp.el with lexical-binding. + (dolist (op lap) + (cond + ((eq (car op) 'TAG) (byte-compile-out-tag op)) + ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op))) + (t (byte-compile-out (car op) (cdr op)))))) (defun byte-compile-inline-expand (form) (let* ((name (car form)) @@ -266,25 +277,32 @@ (cdr (assq name byte-compile-function-environment))))) (if (and (consp fn) (eq (car fn) 'autoload)) (error "File `%s' didn't define `%s'" (nth 1 fn) name)) - (if (and (symbolp fn) (not (eq fn t))) - (byte-compile-inline-expand (cons fn (cdr form))) - (if (byte-code-function-p fn) - (let (string) - (fetch-bytecode fn) - (setq string (aref fn 1)) - ;; Isn't it an error for `string' not to be unibyte?? --stef - (if (fboundp 'string-as-unibyte) - (setq string (string-as-unibyte string))) - ;; `byte-compile-splice-in-already-compiled-code' - ;; takes care of inlining the body. - (cons `(lambda ,(aref fn 0) - (byte-code ,string ,(aref fn 2) ,(aref fn 3))) - (cdr form))) - (if (eq (car-safe fn) 'lambda) - (macroexpand-all (cons fn (cdr form)) - byte-compile-macro-environment) - ;; Give up on inlining. - form)))))) + (cond + ((and (symbolp fn) (not (eq fn t))) ;A function alias. + (byte-compile-inline-expand (cons fn (cdr form)))) + ((and (byte-code-function-p fn) + ;; FIXME: This works to inline old-style-byte-codes into + ;; old-style-byte-codes, but not mixed cases (not sure + ;; about new-style into new-style). + (not lexical-binding) + (not (and (>= (length fn) 7) + (aref fn 6)))) ;6 = COMPILED_PUSH_ARGS + ;; (message "Inlining %S byte-code" name) + (fetch-bytecode fn) + (let ((string (aref fn 1))) + ;; Isn't it an error for `string' not to be unibyte?? --stef + (if (fboundp 'string-as-unibyte) + (setq string (string-as-unibyte string))) + ;; `byte-compile-splice-in-already-compiled-code' + ;; takes care of inlining the body. + (cons `(lambda ,(aref fn 0) + (byte-code ,string ,(aref fn 2) ,(aref fn 3))) + (cdr form)))) + ((eq (car-safe fn) 'lambda) + (macroexpand-all (cons fn (cdr form)) + byte-compile-macro-environment)) + (t ;; Give up on inlining. + form))))) ;; ((lambda ...) ...) (defun byte-compile-unfold-lambda (form &optional name) @@ -1298,10 +1316,7 @@ (if (not (memq byte-optimize '(t lap))) (byte-compile-normal-call form) (byte-inline-lapcode - (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t)) - (setq byte-compile-maxdepth (max (+ byte-compile-depth (nth 3 form)) - byte-compile-maxdepth)) - (setq byte-compile-depth (1+ byte-compile-depth)))) + (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t)))) (put 'byte-code 'byte-compile 'byte-compile-splice-in-already-compiled-code) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e9beb0c5792..d3ac50a671a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -752,9 +752,10 @@ BYTES and PC are updated after evaluating all the arguments." (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)))) + `(progn (assert (<= 0 ,(car 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. @@ -817,7 +818,7 @@ CONST2 may be evaulated multiple times." ;; 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 + ;; byte-discardN is weird 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))) @@ -1330,11 +1331,11 @@ extra args." (eq 'lambda (car-safe (cdr-safe old))) (setq old (cdr old))) (let ((sig1 (byte-compile-arglist-signature - (if (eq 'lambda (car-safe old)) - (nth 1 old) - (if (byte-code-function-p old) - (aref old 0) - '(&rest def))))) + (pcase old + (`(lambda ,args . ,_) args) + (`(closure ,_ ,_ ,args . ,_) args) + ((pred byte-code-function-p) (aref old 0)) + (t '(&rest def))))) (sig2 (byte-compile-arglist-signature (nth 2 form)))) (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) (byte-compile-set-symbol-position (nth 1 form)) @@ -1402,14 +1403,7 @@ extra args." ;; but such warnings are never useful, ;; so don't warn about them. macroexpand cl-macroexpand-all - cl-compiling-file))) - ;; Avoid warnings for things which are safe because they - ;; have suitable compiler macros, but those aren't - ;; expanded at this stage. There should probably be more - ;; here than caaar and friends. - (not (and (eq (get func 'byte-compile) - 'cl-byte-compile-compiler-macro) - (string-match "\\`c[ad]+r\\'" (symbol-name func))))) + cl-compiling-file)))) (byte-compile-warn "function `%s' from cl package called at runtime" func))) form) @@ -2701,8 +2695,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if (eq (car-safe form) 'list) (byte-compile-top-level (nth 1 bytecomp-int)) (setq bytecomp-int (list 'interactive - (byte-compile-top-level - (nth 1 bytecomp-int))))))) + (byte-compile-top-level + (nth 1 bytecomp-int))))))) ((cdr bytecomp-int) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string bytecomp-int))))) @@ -2788,6 +2782,9 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-tag-number 0) (byte-compile-depth 0) (byte-compile-maxdepth 0) + (byte-compile-lexical-environment + (when (eq output-type 'lambda) + byte-compile-lexical-environment)) (byte-compile-output nil)) (if (memq byte-optimize '(t source)) (setq form (byte-optimize-form form for-effect))) @@ -2798,14 +2795,13 @@ If FORM is a lambda or a macro, byte-compile it as a function." (stringp (nth 1 form)) (vectorp (nth 2 form)) (natnump (nth 3 form))) form - ;; Set up things for a lexically-bound function + ;; 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) - (setq byte-compile-depth (1+ byte-compile-depth))) + ;; accordingly. + (setq byte-compile-depth (length byte-compile-lexical-environment)) ;; If there are args, output a tag to record the initial - ;; stack-depth for the optimizer + ;; stack-depth for the optimizer. (when (> byte-compile-depth 0) (byte-compile-out-tag (byte-compile-make-tag)))) ;; Now compile FORM @@ -2964,9 +2960,10 @@ That command is designed for interactive use only" bytecomp-fn)) ;; for CL compiler macros since the symbol may be ;; `cl-byte-compile-compiler-macro' but if CL isn't ;; loaded, this function doesn't exist. - (or (not (memq bytecomp-handler - '(cl-byte-compile-compiler-macro))) - (functionp bytecomp-handler))) + (and (not (eq bytecomp-handler + ;; Already handled by macroexpand-all. + 'cl-byte-compile-compiler-macro)) + (functionp bytecomp-handler))) (funcall bytecomp-handler form) (byte-compile-normal-call form)) (if (byte-compile-warning-enabled-p 'cl-functions) @@ -3612,7 +3609,7 @@ discarding." (byte-defop-compiler-1 while) (byte-defop-compiler-1 funcall) (byte-defop-compiler-1 let) -(byte-defop-compiler-1 let*) +(byte-defop-compiler-1 let* byte-compile-let) (defun byte-compile-progn (form) (byte-compile-body-do-effect (cdr form))) @@ -3819,10 +3816,8 @@ Return the offset in the form (VAR . OFFSET)." (byte-compile-push-constant nil))))) (defun byte-compile-not-lexical-var-p (var) - (or (not (symbolp var)) ; form is not a list - (if (eval-when-compile (fboundp 'special-variable-p)) - (special-variable-p var) - (boundp var)) + (or (not (symbolp var)) + (special-variable-p var) (memq var byte-compile-bound-variables) (memq var '(nil t)) (keywordp var))) @@ -3833,9 +3828,8 @@ INIT-LEXENV should be a lexical-environment alist describing the positions of the init value that have been pushed on the stack. 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. + ;; juggle things on the stack, to move them to TOS for + ;; dynamic binding. (cond ((not (byte-compile-not-lexical-var-p var)) ;; VAR is a simple stack-allocated lexical variable (push (assq var init-lexenv) @@ -3883,56 +3877,41 @@ binding slots have been popped." (defun byte-compile-let (form) "Generate code for the `let' form FORM." - ;; First compute the binding values in the old scope. - (let ((varlist (car (cdr form))) - (init-lexenv nil)) - (dolist (var varlist) - (push (byte-compile-push-binding-init var) init-lexenv)) - ;; Now do the bindings, execute the body, and undo the bindings. - (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope - (varlist (reverse (car (cdr form)))) + (let ((clauses (cadr form)) + (init-lexenv nil)) + (when (eq (car form) 'let) + ;; First compute the binding values in the old scope. + (dolist (var clauses) + (push (byte-compile-push-binding-init var) init-lexenv))) + ;; New scope. + (let ((byte-compile-bound-variables byte-compile-bound-variables) (byte-compile-lexical-environment byte-compile-lexical-environment)) - (dolist (var varlist) - (let ((var (if (consp var) (car var) var))) - (cond ((null lexical-binding) - ;; If there are no lexical bindings, we can do things simply. - (byte-compile-dynamic-variable-bind var)) - ((byte-compile-bind var init-lexenv) - (pop init-lexenv))))) + ;; Bind the variables. + ;; For `let', do it in reverse order, because it makes no + ;; semantic difference, but it is a lot more efficient since the + ;; values are now in reverse order on the stack. + (dolist (var (if (eq (car form) 'let) (reverse clauses) clauses)) + (unless (eq (car form) 'let) + (push (byte-compile-push-binding-init var) init-lexenv)) + (let ((var (if (consp var) (car var) var))) + (cond ((null lexical-binding) + ;; If there are no lexical bindings, we can do things simply. + (byte-compile-dynamic-variable-bind var)) + ((byte-compile-bind var init-lexenv) + (pop init-lexenv))))) ;; Emit the body. - (byte-compile-body-do-effect (cdr (cdr form))) - ;; Unbind the variables. - (if lexical-binding - ;; Unbind both lexical and dynamic variables. - (byte-compile-unbind varlist init-lexenv t) - ;; Unbind dynamic variables. - (byte-compile-out 'byte-unbind (length varlist)))))) - -(defun byte-compile-let* (form) - "Generate code for the `let*' form FORM." - (let ((byte-compile-bound-variables byte-compile-bound-variables) ;new scope - (clauses (cadr form)) - (init-lexenv nil) - ;; bind these to restrict the scope of any changes - - (byte-compile-lexical-environment byte-compile-lexical-environment)) - ;; Bind the variables - (dolist (var clauses) - (push (byte-compile-push-binding-init var) init-lexenv) - (let ((var (if (consp var) (car var) var))) - (cond ((null lexical-binding) - ;; If there are no lexical bindings, we can do things simply. - (byte-compile-dynamic-variable-bind var)) - ((byte-compile-bind var init-lexenv) - (pop init-lexenv))))) - ;; Emit the body - (byte-compile-body-do-effect (cdr (cdr form))) - ;; Unbind the variables - (if lexical-binding - ;; Unbind both lexical and dynamic variables - (byte-compile-unbind clauses init-lexenv t) - ;; Unbind dynamic variables - (byte-compile-out 'byte-unbind (length clauses))))) + (let ((init-stack-depth byte-compile-depth)) + (byte-compile-body-do-effect (cdr (cdr form))) + ;; Unbind the variables. + (if lexical-binding + ;; Unbind both lexical and dynamic variables. + (progn + (assert (or (eq byte-compile-depth init-stack-depth) + (eq byte-compile-depth (1+ init-stack-depth)))) + (byte-compile-unbind clauses init-lexenv (> byte-compile-depth + init-stack-depth))) + ;; Unbind dynamic variables. + (byte-compile-out 'byte-unbind (length clauses))))))) @@ -4254,8 +4233,8 @@ binding slots have been popped." (progn ;; ## remove this someday (and byte-compile-depth - (not (= (cdr (cdr tag)) byte-compile-depth)) - (error "Compiler bug: depth conflict at tag %d" (car (cdr tag)))) + (not (= (cdr (cdr tag)) byte-compile-depth)) + (error "Compiler bug: depth conflict at tag %d" (car (cdr tag)))) (setq byte-compile-depth (cdr (cdr tag)))) (setcdr (cdr tag) byte-compile-depth))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 10464047cd3..d8f5a7da44d 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -70,6 +70,15 @@ ;; ;;; Code: +;;; TODO: +;; - Use abstract `make-closure' and `closure-ref' expressions, which bytecomp +;; should turn into building corresponding byte-code function. +;; - don't use `curry', instead build a new compiled-byte-code object +;; (merge the closure env into the static constants pool). +;; - use relative addresses for byte-code-stack-ref. +;; - warn about unused lexical vars. +;; - clean up cconv-closure-convert-rec, especially the `let' binding part. + (eval-when-compile (require 'cl)) (defconst cconv-liftwhen 3 @@ -187,14 +196,14 @@ Returns a list of free variables." -- TOPLEVEL(optional) is a boolean variable, true if we are at the root of AST Returns a form where all lambdas don't have any free variables." - (message "Entering cconv-closure-convert...") + ;; (message "Entering cconv-closure-convert...") (let ((cconv-mutated '()) (cconv-lambda-candidates '()) (cconv-captured '()) (cconv-captured+mutated '())) - ;; Analyse form - fill these variables with new information + ;; Analyse form - fill these variables with new information. (cconv-analyse-form form '() 0) - ;; Calculate an intersection of cconv-mutated and cconv-captured + ;; Calculate an intersection of cconv-mutated and cconv-captured. (dolist (mvr cconv-mutated) (when (memq mvr cconv-captured) ; (push mvr cconv-captured+mutated))) @@ -216,14 +225,51 @@ Returns a form where all lambdas don't have any free variables." res)) (defconst cconv--dummy-var (make-symbol "ignored")) +(defconst cconv--env-var (make-symbol "env")) -(defun cconv-closure-convert-rec - (form emvrs fvrs envs lmenvs) +(defun cconv--set-diff (s1 s2) + "Return elements of set S1 that are not in set S2." + (let ((res '())) + (dolist (x s1) + (unless (memq x s2) (push x res))) + (nreverse res))) + +(defun cconv--set-diff-map (s m) + "Return elements of set S that are not in Dom(M)." + (let ((res '())) + (dolist (x s) + (unless (assq x m) (push x res))) + (nreverse res))) + +(defun cconv--map-diff (m1 m2) + "Return the submap of map M1 that has Dom(M2) removed." + (let ((res '())) + (dolist (x m1) + (unless (assq (car x) m2) (push x res))) + (nreverse res))) + +(defun cconv--map-diff-elem (m x) + "Return the map M minus any mapping for X." + ;; Here we assume that X appears at most once in M. + (let* ((b (assq x m)) + (res (if b (remq b m) m))) + (assert (null (assq x res))) ;; Check the assumption was warranted. + res)) + +(defun cconv--map-diff-set (m s) + "Return the map M minus any mapping for elements of S." + ;; Here we assume that X appears at most once in M. + (let ((res '())) + (dolist (b m) + (unless (memq (car b) s) (push b res))) + (nreverse res))) + +(defun cconv-closure-convert-rec (form emvrs fvrs envs lmenvs) ;; This function actually rewrites the tree. "Eliminates all free variables of all lambdas in given forms. Arguments: -- FORM is a piece of Elisp code after macroexpansion. --- LMENVS is a list of environments used for lambda-lifting. Initially empty. +-- LMENVS is a list of environments used for lambda-lifting. Initially empty. -- EMVRS is a list that contains mutated variables that are visible within current environment. -- ENVS is an environment(list of free variables) of current closure. @@ -343,10 +389,9 @@ Returns a form where all lambdas don't have any free variables." (setq lmenvs (remq old-lmenv lmenvs)) (push new-lmenv lmenvs) (push `(,closedsym ,var) binders-new)))) - ;; we push the element after redefined free variables - ;; are processes. this is important to avoid the bug - ;; when free variable and the function have the same - ;; name + ;; We push the element after redefined free variables are + ;; processed. This is important to avoid the bug when free + ;; variable and the function have the same name. (push (list var new-val) binders-new) (when (eq letsym 'let*) ; update fvrs @@ -355,11 +400,7 @@ Returns a form where all lambdas don't have any free variables." (when emvr-push (push emvr-push emvrs) (setq emvr-push nil)) - (let (lmenvs-1) ; remove var from lmenvs if redefined - (dolist (iter lmenvs) - (when (not (assq var lmenvs)) - (push iter lmenvs-1))) - (setq lmenvs lmenvs-1)) + (setq lmenvs (cconv--map-diff-elem lmenvs var)) (when lmenv-push (push lmenv-push lmenvs) (setq lmenv-push nil))) @@ -368,19 +409,10 @@ Returns a form where all lambdas don't have any free variables." (let (var fvrs-1 emvrs-1 lmenvs-1) ;; Here we update emvrs, fvrs and lmenvs lists - (dolist (vr fvrs) - ; safely remove - (when (not (assq vr binders-new)) (push vr fvrs-1))) - (setq fvrs fvrs-1) - (dolist (vr emvrs) - ; safely remove - (when (not (assq vr binders-new)) (push vr emvrs-1))) - (setq emvrs emvrs-1) - ; push new + (setq fvrs (cconv--set-diff-map fvrs binders-new)) + (setq emvrs (cconv--set-diff-map emvrs binders-new)) (setq emvrs (append emvrs emvrs-new)) - (dolist (vr lmenvs) - (when (not (assq (car vr) binders-new)) - (push vr lmenvs-1))) + (setq lmenvs (cconv--set-diff-map lmenvs binders-new)) (setq lmenvs (append lmenvs lmenvs-new))) ;; Here we do the same letbinding as for let* above @@ -402,9 +434,9 @@ Returns a form where all lambdas don't have any free variables." (symbol-name var)))) (setq new-lmenv (list (car lmenv))) - (dolist (frv (cdr lmenv)) (if (eq frv var) - (push closedsym new-lmenv) - (push frv new-lmenv))) + (dolist (frv (cdr lmenv)) + (push (if (eq frv var) closedsym frv) + new-lmenv)) (setq new-lmenv (reverse new-lmenv)) (setq lmenvs (remq lmenv lmenvs)) (push new-lmenv lmenvs) @@ -449,13 +481,9 @@ Returns a form where all lambdas don't have any free variables." (`(quote . ,_) form) ; quote form (`(function . ((lambda ,vars . ,body-forms))) ; function form - (let (fvrs-new) ; we remove vars from fvrs - (dolist (elm fvrs) ;i use such a tricky way to avoid side effects - (when (not (memq elm vars)) - (push elm fvrs-new))) - (setq fvrs fvrs-new)) - (let* ((fv (delete-dups (cconv-freevars form '()))) - (leave fvrs) ; leave = non nil if we should leave env unchanged + (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs. + (fv (delete-dups (cconv-freevars form '()))) + (leave fvrs-new) ; leave=non-nil if we should leave env unchanged. (body-forms-new '()) (letbind '()) (mv nil) @@ -470,7 +498,7 @@ Returns a form where all lambdas don't have any free variables." (if (eq (length envs) (length fv)) (let ((fv-temp fv)) (while (and fv-temp leave) - (when (not (memq (car fv-temp) fvrs)) (setq leave nil)) + (when (not (memq (car fv-temp) fvrs-new)) (setq leave nil)) (setq fv-temp (cdr fv-temp)))) (setq leave nil)) @@ -479,23 +507,30 @@ Returns a form where all lambdas don't have any free variables." (dolist (elm fv) (push (cconv-closure-convert-rec + ;; Remove `elm' from `emvrs' for this call because in case + ;; `elm' is a variable that's wrapped in a cons-cell, we + ;; want to put the cons-cell itself in the closure, rather + ;; than just a copy of its current content. elm (remq elm emvrs) fvrs envs lmenvs) - envector)) ; process vars for closure vector + envector)) ; Process vars for closure vector. (setq envector (reverse envector)) (setq envs fv)) - (setq envector `(env))) ; leave unchanged - (setq fvrs fv)) ; update substitution list + (setq envector `(,cconv--env-var))) ; Leave unchanged. + (setq fvrs-new fv)) ; Update substitution list. - ;; the difference between envs and fvrs is explained - ;; in comment in the beginning of the function - (dolist (elm cconv-captured+mutated) ; find mutated arguments - (setq mv (car elm)) ; used in inner closures + (setq emvrs (cconv--set-diff emvrs vars)) + (setq lmenvs (cconv--map-diff-set lmenvs vars)) + + ;; The difference between envs and fvrs is explained + ;; in comment in the beginning of the function. + (dolist (elm cconv-captured+mutated) ; Find mutated arguments + (setq mv (car elm)) ; used in inner closures. (when (and (memq mv vars) (eq form (caddr elm))) (progn (push mv emvrs) (push `(,mv (list ,mv)) letbind)))) (dolist (elm body-forms) ; convert function body (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs) + elm emvrs fvrs-new envs lmenvs) body-forms-new)) (setq body-forms-new @@ -509,12 +544,12 @@ Returns a form where all lambdas don't have any free variables." ; 1 free variable - do not build vector ((null (cdr envector)) `(curry - (function (lambda (env . ,vars) . ,body-forms-new)) + (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new)) ,(car envector))) ; >=2 free variables - build vector (t `(curry - (function (lambda (env . ,vars) . ,body-forms-new)) + (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new)) (vector . ,envector)))))) (`(function . ,_) form) ; same as quote @@ -674,13 +709,10 @@ Returns a form where all lambdas don't have any free variables." (let ((free (memq form fvrs))) (if free ;form is a free variable (let* ((numero (- (length fvrs) (length free))) - (var '())) - (assert numero) - (if (null (cdr envs)) - (setq var 'env) - ;replace form => - ;(aref env #) - (setq var `(aref env ,numero))) + (var (if (null (cdr envs)) + cconv--env-var + ;; Replace form => (aref env #) + `(aref ,cconv--env-var ,numero)))) (if (memq form emvrs) ; form => (car (aref env #)) if mutable `(car ,var) var)) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index e10dc10447c..a13e46ccc59 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -282,7 +282,7 @@ Not documented ;;;;;; do-all-symbols do-symbols dotimes dolist do* do loop return-from ;;;;;; return block etypecase typecase ecase case load-time-value ;;;;;; eval-when destructuring-bind function* defmacro* defun* gentemp -;;;;;; gensym) "cl-macs" "cl-macs.el" "0904b956872432ae7cc5fa9abcefce63") +;;;;;; gensym) "cl-macs" "cl-macs.el" "7602128fa01003de9a8df4c752865300") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 80e95724f1f..093e4fbf258 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -602,7 +602,13 @@ called from BODY." (put 'cl-block-wrapper 'byte-compile 'cl-byte-compile-block) (defun cl-byte-compile-block (cl-form) - (if (fboundp 'byte-compile-form-do-effect) ; Check for optimizing compiler + ;; Here we try to determine if a catch tag is used or not, so as to get rid + ;; of the catch when it's not used. + (if (and (fboundp 'byte-compile-form-do-effect) ; Optimizing compiler? + ;; FIXME: byte-compile-top-level can only be used for code that is + ;; closed (as the name implies), so for lexical scoping we should + ;; implement this optimization differently. + (not lexical-binding)) (progn (let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil)) (cl-active-block-names (cons cl-entry cl-active-block-names)) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 7990df264a9..a338de251ed 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -1,5 +1,4 @@ -;;; -*- lexical-binding: t -*- -;;; pcase.el --- ML-style pattern-matching macro for Elisp +;;; pcase.el --- ML-style pattern-matching macro for Elisp -*- lexical-binding: t -*- ;; Copyright (C) 2010-2011 Free Software Foundation, Inc. diff --git a/lisp/files.el b/lisp/files.el index 8b42eaaddb8..e7dd96ca2ff 100644 --- a/lisp/files.el +++ b/lisp/files.el @@ -2851,18 +2851,19 @@ asking you for confirmation." ;; ;; For variables defined in the C source code the declaration should go here: -(mapc (lambda (pair) - (put (car pair) 'safe-local-variable (cdr pair))) - '((buffer-read-only . booleanp) ;; C source code - (default-directory . stringp) ;; C source code - (fill-column . integerp) ;; C source code - (indent-tabs-mode . booleanp) ;; C source code - (left-margin . integerp) ;; C source code - (no-update-autoloads . booleanp) - (tab-width . integerp) ;; C source code - (truncate-lines . booleanp) ;; C source code - (word-wrap . booleanp) ;; C source code - (bidi-display-reordering . booleanp))) ;; C source code +(dolist (pair + '((buffer-read-only . booleanp) ;; C source code + (default-directory . stringp) ;; C source code + (fill-column . integerp) ;; C source code + (indent-tabs-mode . booleanp) ;; C source code + (left-margin . integerp) ;; C source code + (no-update-autoloads . booleanp) + (lexical-binding . booleanp) ;; C source code + (tab-width . integerp) ;; C source code + (truncate-lines . booleanp) ;; C source code + (word-wrap . booleanp) ;; C source code + (bidi-display-reordering . booleanp))) ;; C source code + (put (car pair) 'safe-local-variable (cdr pair))) (put 'bidi-paragraph-direction 'safe-local-variable (lambda (v) (memq v '(nil right-to-left left-to-right)))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 172a74d8c80..49767e6e9d3 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -530,7 +530,7 @@ suitable file is found, return nil." (let ((fill-begin (point))) (insert (car high) "\n") (fill-region fill-begin (point))) - (setq doc (cdr high)))) + (setq doc (cdr high)))) (let* ((obsolete (and ;; function might be a lambda construct. (symbolp function) diff --git a/src/ChangeLog b/src/ChangeLog index 6674fb31ca5..0b2ee8550ca 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,13 @@ +2011-02-17 Stefan Monnier + + * eval.c (Vinternal_interpreter_environment): Remove. + (syms_of_eval): Do declare Vinternal_interpreter_environment as + a global lisp var, but unintern it to hide it. + (Fcommandp): + * data.c (Finteractive_form): Understand `closure's. + + * bytecode.c (exec_byte_code): Fix handling of &rest. + 2011-02-12 Stefan Monnier * bytecode.c (Bvec_ref, Bvec_set): Remove. diff --git a/src/bytecode.c b/src/bytecode.c index 9bf6ae45ce9..1ad01aaf8f7 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -500,7 +500,9 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, optional = 1; else if (EQ (XCAR (at), Qand_rest)) { - PUSH (Flist (nargs, args)); + PUSH (pushed < nargs + ? Flist (nargs - pushed, args) + : Qnil); pushed = nargs; at = Qnil; break; diff --git a/src/data.c b/src/data.c index 83da3e103cb..2f17edd3fdc 100644 --- a/src/data.c +++ b/src/data.c @@ -755,6 +755,8 @@ Value, if non-nil, is a list \(interactive SPEC). */) else if (CONSP (fun)) { Lisp_Object funcar = XCAR (fun); + if (EQ (funcar, Qclosure)) + fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); if (EQ (funcar, Qlambda)) return Fassq (Qinteractive, Fcdr (XCDR (fun))); else if (EQ (funcar, Qautoload)) diff --git a/src/eval.c b/src/eval.c index 9adfc983ced..63484d40e1b 100644 --- a/src/eval.c +++ b/src/eval.c @@ -78,16 +78,6 @@ 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-environment'. Every element of this list - can be either a cons (VAR . VAL) specifying a lexical binding, - or a single symbol VAR indicating that this variable should use - dynamic scoping. */ - -Lisp_Object Vinternal_interpreter_environment; - /* Current number of specbindings allocated in specpdl. */ EMACS_INT specpdl_size; @@ -2092,9 +2082,11 @@ then strings and vectors are not accepted. */) if (!CONSP (fun)) return Qnil; funcar = XCAR (fun); + if (EQ (funcar, Qclosure)) + fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); if (EQ (funcar, Qlambda)) return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; - if (EQ (funcar, Qautoload)) + else if (EQ (funcar, Qautoload)) return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; else return Qnil; @@ -3695,6 +3687,8 @@ mark_backtrace (void) } } +EXFUN (Funintern, 2); + void syms_of_eval (void) { @@ -3840,19 +3834,27 @@ DECL is a list `(declare ...)' containing the declarations. The value the function returns is not used. */); Vmacro_declaration_function = Qnil; + /* When lexical binding is being used, + vinternal_interpreter_environment is non-nil, and contains an alist + of lexically-bound variable, or (t), indicating an empty + environment. The lisp name of this variable would be + `internal-interpreter-environment' if it weren't hidden. + Every element of this list can be either a cons (VAR . VAL) + specifying a lexical binding, or a single symbol VAR indicating + that this variable should use dynamic scoping. */ Qinternal_interpreter_environment = intern_c_string ("internal-interpreter-environment"); staticpro (&Qinternal_interpreter_environment); -#if 0 /* Don't export this variable to Elisp, so noone can mess with it - (Just imagine if someone makes it buffer-local). */ - DEFVAR__LISP ("internal-interpreter-environment", - Vinternal_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. */); -#endif Vinternal_interpreter_environment = Qnil; + /* Don't export this variable to Elisp, so noone can mess with it + (Just imagine if someone makes it buffer-local). */ + Funintern (Qinternal_interpreter_environment, Qnil); Vrun_hooks = intern_c_string ("run-hooks"); staticpro (&Vrun_hooks); diff --git a/src/lisp.h b/src/lisp.h index 906736bacad..0e7eeebc9da 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2855,7 +2855,7 @@ extern void syms_of_lread (void); /* Defined in eval.c */ extern Lisp_Object Qautoload, Qexit, Qinteractive, Qcommandp, Qdefun, Qmacro; -extern Lisp_Object Qinhibit_quit; +extern Lisp_Object Qinhibit_quit, Qclosure; extern Lisp_Object Vautoload_queue; extern Lisp_Object Vsignaling_function; extern int handling_signal; From 9a05edc4fcf1eff8966ac327e479bb8f9ca219a9 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 18 Feb 2011 08:55:51 -0500 Subject: [PATCH 16/45] * lisp/emacs-lisp/pcase.el (pcase--expand, pcase--u, pcase--u1, pcase--q1): Avoid destructuring-bind which results in poorer code. --- lisp/ChangeLog | 5 +++ lisp/emacs-lisp/pcase.el | 70 ++++++++++++++++++++++++---------------- 2 files changed, 47 insertions(+), 28 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 142deda9505..6b6555ab7e3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-02-18 Stefan Monnier + + * emacs-lisp/pcase.el (pcase--expand, pcase--u, pcase--u1, pcase--q1): + Avoid destructuring-bind which results in poorer code. + 2011-02-17 Stefan Monnier * files.el (lexical-binding): Add a safe-local-variable property. diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index a338de251ed..c8a07738fe5 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -37,8 +37,6 @@ ;;; Code: -(eval-when-compile (require 'cl)) - ;; Macro-expansion of pcase is reasonably fast, so it's not a problem ;; when byte-compiling a file, but when interpreting the code, if the pcase ;; is in a loop, the repeated macro-expansion becomes terribly costly, so we @@ -155,7 +153,9 @@ of the form (UPAT EXP)." ;; to a separate function if that number is too high. ;; ;; We've already used this branch. So it is shared. - (destructuring-bind (code prevvars res) prev + (let* ((code (car prev)) (cdrprev (cdr prev)) + (prevvars (car cdrprev)) (cddrprev (cdr cdrprev)) + (res (car cddrprev))) (unless (symbolp res) ;; This is the first repeat, so we have to move ;; the branch to a separate function. @@ -256,15 +256,18 @@ MATCH is the pattern that needs to be matched, of the form: (and MATCH ...) (or MATCH ...)" (when (setq branches (delq nil branches)) - (destructuring-bind (match code &rest vars) (car branches) + (let* ((carbranch (car branches)) + (match (car carbranch)) (cdarbranch (cdr carbranch)) + (code (car cdarbranch)) + (vars (cdr cdarbranch))) (pcase--u1 (list match) code vars (cdr branches))))) (defun pcase--and (match matches) (if matches `(and ,match ,@matches) match)) (defun pcase--split-match (sym splitter match) - (case (car match) - ((match) + (cond + ((eq (car match) 'match) (if (not (eq sym (cadr match))) (cons match match) (let ((pat (cddr match))) @@ -278,7 +281,7 @@ MATCH is the pattern that needs to be matched, of the form: (cdr pat))))) (t (let ((res (funcall splitter (cddr match)))) (cons (or (car res) match) (or (cdr res) match)))))))) - ((or and) + ((memq (car match) '(or and)) (let ((then-alts '()) (else-alts '()) (neutral-elem (if (eq 'or (car match)) @@ -408,32 +411,37 @@ and otherwise defers to REST which is a list of branches of the form (pcase--u1 (cons `(match ,var or . ,(nreverse simples)) (cdr matches)) code vars (if (null others) rest - (cons (list* + (cons (cons (pcase--and (if (cdr others) (cons 'or (nreverse others)) (car others)) (cdr matches)) - code vars) + (cons code vars)) rest)))) (t (pcase--u1 (cons (pop alts) (cdr matches)) code vars (if (null alts) (progn (error "Please avoid it") rest) - (cons (list* + (cons (cons (pcase--and (if (cdr alts) (cons 'or alts) (car alts)) (cdr matches)) - code vars) + (cons code vars)) rest))))))) ((eq 'match (caar matches)) - (destructuring-bind (op sym &rest upat) (pop matches) + (let* ((popmatches (pop matches)) + (op (car popmatches)) (cdrpopmatches (cdr popmatches)) + (sym (car cdrpopmatches)) + (upat (cdr cdrpopmatches))) (cond ((memq upat '(t _)) (pcase--u1 matches code vars rest)) ((eq upat 'dontcare) :pcase--dontcare) ((functionp upat) (error "Feature removed, use (pred %s)" upat)) ((memq (car-safe upat) '(guard pred)) - (destructuring-bind (then-rest &rest else-rest) - (pcase--split-rest - sym (apply-partially #'pcase--split-pred upat) rest) + (let* ((splitrest + (pcase--split-rest + sym (apply-partially #'pcase--split-pred upat) rest)) + (then-rest (car splitrest)) + (else-rest (cdr splitrest))) (pcase--if (if (and (eq (car upat) 'pred) (symbolp (cadr upat))) `(,(cadr upat) ,sym) (let* ((exp (cadr upat)) @@ -472,13 +480,15 @@ and otherwise defers to REST which is a list of branches of the form (setq all nil)))) (if all ;; Use memq for (or `a `b `c `d) rather than a big tree. - (let ((elems (mapcar 'cadr (cdr upat)))) - (destructuring-bind (then-rest &rest else-rest) - (pcase--split-rest - sym (apply-partially #'pcase--split-member elems) rest) - (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems) - (pcase--u1 matches code vars then-rest) - (pcase--u else-rest)))) + (let* ((elems (mapcar 'cadr (cdr upat))) + (splitrest + (pcase--split-rest + sym (apply-partially #'pcase--split-member elems) rest)) + (then-rest (car splitrest)) + (else-rest (cdr splitrest))) + (pcase--if `(,(if memq-fine #'memq #'member) ,sym ',elems) + (pcase--u1 matches code vars then-rest) + (pcase--u else-rest))) (pcase--u1 (cons `(match ,sym ,@(cadr upat)) matches) code vars (append (mapcar (lambda (upat) `((and (match ,sym . ,upat) ,@matches) @@ -527,10 +537,12 @@ and if not, defers to REST which is a list of branches of the form ((consp qpat) (let ((syma (make-symbol "xcar")) (symd (make-symbol "xcdr"))) - (destructuring-bind (then-rest &rest else-rest) - (pcase--split-rest sym - (apply-partially #'pcase--split-consp syma symd) - rest) + (let* ((splitrest (pcase--split-rest + sym + (apply-partially #'pcase--split-consp syma symd) + rest)) + (then-rest (car splitrest)) + (else-rest (cdr splitrest))) (pcase--if `(consp ,sym) `(let ((,syma (car ,sym)) (,symd (cdr ,sym))) @@ -540,8 +552,10 @@ and if not, defers to REST which is a list of branches of the form code vars then-rest)) (pcase--u else-rest))))) ((or (integerp qpat) (symbolp qpat) (stringp qpat)) - (destructuring-bind (then-rest &rest else-rest) - (pcase--split-rest sym (apply-partially 'pcase--split-equal qpat) rest) + (let* ((splitrest (pcase--split-rest + sym (apply-partially 'pcase--split-equal qpat) rest)) + (then-rest (car splitrest)) + (else-rest (cdr splitrest))) (pcase--if `(,(if (stringp qpat) #'equal #'eq) ,sym ',qpat) (pcase--u1 matches code vars then-rest) (pcase--u else-rest)))) From e0f57e65692ed73a86926f737388b60faec92767 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 19 Feb 2011 00:10:33 -0500 Subject: [PATCH 17/45] * lisp/subr.el (save-window-excursion): New macro, moved from C. * lisp/emacs-lisp/lisp-mode.el (save-window-excursion): Don't touch. * lisp/emacs-lisp/cconv.el (cconv-closure-convert-rec, cconv-analyse-form): Don't handle save-window-excursion any more. * lisp/emacs-lisp/bytecomp.el (interactive-p, save-window-excursion): Don't use the byte-code any more. (byte-compile-form): Check macro expansion was done. (byte-compile-save-window-excursion): Remove. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Ignore save-window-excursion. Don't macroepand any more. * src/window.c (Fsave_window_excursion): Remove. Moved to Lisp. (syms_of_window): Don't defsubr it. * src/window.h (Fsave_window_excursion): Don't declare it. * src/bytecode.c (exec_byte_code): Inline Fsave_window_excursion. --- lisp/ChangeLog | 13 +++++++++++++ lisp/emacs-lisp/byte-opt.el | 21 +-------------------- lisp/emacs-lisp/bytecomp.el | 18 ++++-------------- lisp/emacs-lisp/cconv.el | 6 +++--- lisp/emacs-lisp/lisp-mode.el | 1 - lisp/subr.el | 19 +++++++++++++++++++ src/ChangeLog | 7 +++++++ src/bytecode.c | 32 ++++++++++++++++++++------------ src/window.c | 23 ----------------------- src/window.h | 1 - 10 files changed, 67 insertions(+), 74 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 6b6555ab7e3..ae91513937c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2011-02-19 Stefan Monnier + + * subr.el (save-window-excursion): New macro, moved from C. + * emacs-lisp/lisp-mode.el (save-window-excursion): Don't touch. + * emacs-lisp/cconv.el (cconv-closure-convert-rec, cconv-analyse-form): + Don't handle save-window-excursion any more. + * emacs-lisp/bytecomp.el (interactive-p, save-window-excursion): + Don't use the byte-code any more. + (byte-compile-form): Check macro expansion was done. + (byte-compile-save-window-excursion): Remove. + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): + Ignore save-window-excursion. Don't macroepand any more. + 2011-02-18 Stefan Monnier * emacs-lisp/pcase.el (pcase--expand, pcase--u, pcase--u1, pcase--q1): diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 12df3251267..038db292350 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -498,8 +498,7 @@ (prin1-to-string form)) nil) - ((memq fn '(defun defmacro function - condition-case save-window-excursion)) + ((memq fn '(defun defmacro function condition-case)) ;; These forms are compiled as constants or by breaking out ;; all the subexpressions and compiling them separately. form) @@ -530,24 +529,6 @@ ;; However, don't actually bother calling `ignore'. `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form)))) - ;; If optimization is on, this is the only place that macros are - ;; expanded. If optimization is off, then macroexpansion happens - ;; in byte-compile-form. Otherwise, the macros are already expanded - ;; by the time that is reached. - ((not (eq form - (setq form (macroexpand form - byte-compile-macro-environment)))) - (byte-optimize-form form for-effect)) - - ;; Support compiler macros as in cl.el. - ((and (fboundp 'compiler-macroexpand) - (symbolp (car-safe form)) - (get (car-safe form) 'cl-compiler-macro) - (not (eq form - (with-no-warnings - (setq form (compiler-macroexpand form)))))) - (byte-optimize-form form for-effect)) - ((not (symbolp fn)) (byte-compile-warn "`%s' is a malformed function" (prin1-to-string fn)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index d3ac50a671a..54a1912169a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -586,7 +586,6 @@ Each element is (INDEX . VALUE)") (byte-defop 114 0 byte-save-current-buffer "To make a binding to record the current buffer") (byte-defop 115 0 byte-set-mark-OBSOLETE) -(byte-defop 116 1 byte-interactive-p) ;; These ops are new to v19 (byte-defop 117 0 byte-forward-char) @@ -622,8 +621,6 @@ otherwise pop it") (byte-defop 138 0 byte-save-excursion "to make a binding to record the buffer, point and mark") -(byte-defop 139 0 byte-save-window-excursion - "to make a binding to record entire window configuration") (byte-defop 140 0 byte-save-restriction "to make a binding to record the current buffer clipping restrictions") (byte-defop 141 -1 byte-catch @@ -2955,6 +2952,10 @@ That command is designed for interactive use only" bytecomp-fn)) custom-declare-face)) (byte-compile-nogroup-warn form)) (byte-compile-callargs-warn form)) + (if (and (fboundp (car form)) + (eq (car-safe (indirect-function (car form))) 'macro)) + (byte-compile-report-error + (format "Forgot to expand macro %s" (car form)))) (if (and bytecomp-handler ;; Make sure that function exists. This is important ;; for CL compiler macros since the symbol may be @@ -3167,7 +3168,6 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler bobp 0) (byte-defop-compiler current-buffer 0) ;;(byte-defop-compiler read-char 0) ;; obsolete -(byte-defop-compiler interactive-p 0) (byte-defop-compiler widen 0) (byte-defop-compiler end-of-line 0-1) (byte-defop-compiler forward-char 0-1) @@ -3946,7 +3946,6 @@ binding slots have been popped." (byte-defop-compiler-1 save-excursion) (byte-defop-compiler-1 save-current-buffer) (byte-defop-compiler-1 save-restriction) -(byte-defop-compiler-1 save-window-excursion) (byte-defop-compiler-1 with-output-to-temp-buffer) (byte-defop-compiler-1 track-mouse) @@ -4047,15 +4046,6 @@ binding slots have been popped." (byte-compile-body-do-effect (cdr form)) (byte-compile-out 'byte-unbind 1)) -(defun byte-compile-save-window-excursion (form) - (pcase (cdr form) - (`(:fun-body ,f) - (byte-compile-form `(list (list 'funcall ,f)))) - (body - (byte-compile-push-constant - (byte-compile-top-level-body body for-effect)))) - (byte-compile-out 'byte-save-window-excursion 0)) - (defun byte-compile-with-output-to-temp-buffer (form) (byte-compile-form (car (cdr form))) (byte-compile-out 'byte-temp-output-buffer-setup 0) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index d8f5a7da44d..4e42e9f3c1d 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -635,8 +635,8 @@ Returns a form where all lambdas don't have any free variables." ,(cconv-closure-convert-rec `(function (lambda () ,@body)) emvrs fvrs envs lmenvs))) - (`(,(and head (or `save-window-excursion `track-mouse)) . ,body) - `(,head + (`(track-mouse . ,body) + `(track-mouse :fun-body ,(cconv-closure-convert-rec `(function (lambda () ,@body)) emvrs fvrs envs lmenvs))) @@ -827,7 +827,7 @@ lambdas if they are suitable for lambda lifting. ;; FIXME: The bytecode for save-window-excursion and the lack of ;; bytecode for track-mouse forces us to wrap the body. - (`(,(or `save-window-excursion `track-mouse) . ,body) + (`(track-mouse . ,body) (setq inclosure (1+ inclosure)) (dolist (form body) (cconv-analyse-form form env inclosure))) diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 37a86b7135d..85717408121 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -1209,7 +1209,6 @@ This function also returns nil meaning don't specify the indentation." (put 'prog1 'lisp-indent-function 1) (put 'prog2 'lisp-indent-function 2) (put 'save-excursion 'lisp-indent-function 0) -(put 'save-window-excursion 'lisp-indent-function 0) (put 'save-restriction 'lisp-indent-function 0) (put 'save-match-data 'lisp-indent-function 0) (put 'save-current-buffer 'lisp-indent-function 0) diff --git a/lisp/subr.el b/lisp/subr.el index c72752eb8f2..626128c62b3 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2767,6 +2767,25 @@ nor the buffer list." (when (buffer-live-p ,old-buffer) (set-buffer ,old-buffer)))))) +(defmacro save-window-excursion (&rest body) + "Execute BODY, preserving window sizes and contents. +Return the value of the last form in BODY. +Restore which buffer appears in which window, where display starts, +and the value of point and mark for each window. +Also restore the choice of selected window. +Also restore which buffer is current. +Does not restore the value of point in current buffer. + +BEWARE: Most uses of this macro introduce bugs. +E.g. it should not be used to try and prevent some code from opening +a new window, since that window may sometimes appear in another frame, +in which case `save-window-excursion' cannot help." + (declare (indent 0) (debug t)) + (let ((c (make-symbol "wconfig"))) + `(let ((,c (current-window-configuration))) + (unwind-protect (progn ,@body) + (set-window-configuration ,c))))) + (defmacro with-temp-file (file &rest body) "Create a new buffer, evaluate BODY there, and write the buffer to FILE. The value returned is the value of the last form in BODY. diff --git a/src/ChangeLog b/src/ChangeLog index 0b2ee8550ca..6bebce0abaa 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-02-19 Stefan Monnier + + * window.c (Fsave_window_excursion): Remove. Moved to Lisp. + (syms_of_window): Don't defsubr it. + * window.h (Fsave_window_excursion): Don't declare it. + * bytecode.c (exec_byte_code): Inline Fsave_window_excursion. + 2011-02-17 Stefan Monnier * eval.c (Vinternal_interpreter_environment): Remove. diff --git a/src/bytecode.c b/src/bytecode.c index 1ad01aaf8f7..ad2f7d18ade 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -138,7 +138,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bpoint 0140 /* Was Bmark in v17. */ -#define Bsave_current_buffer 0141 +#define Bsave_current_buffer 0141 /* Obsolete. */ #define Bgoto_char 0142 #define Binsert 0143 #define Bpoint_max 0144 @@ -158,7 +158,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bsave_current_buffer_1 0162 /* Replacing Bsave_current_buffer. */ #define Bread_char 0162 /* No longer generated as of v19 */ #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ -#define Binteractive_p 0164 /* Needed since interactive-p takes unevalled args */ +#define Binteractive_p 0164 /* Obsolete. */ #define Bforward_char 0165 #define Bforward_word 0166 @@ -183,7 +183,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bdup 0211 #define Bsave_excursion 0212 -#define Bsave_window_excursion 0213 +#define Bsave_window_excursion 0213 /* Obsolete. */ #define Bsave_restriction 0214 #define Bcatch 0215 @@ -192,7 +192,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Btemp_output_buffer_setup 0220 #define Btemp_output_buffer_show 0221 -#define Bunbind_all 0222 +#define Bunbind_all 0222 /* Obsolete. */ #define Bset_marker 0223 #define Bmatch_beginning 0224 @@ -763,7 +763,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Bunbind_all: + case Bunbind_all: /* Obsolete. */ /* To unbind back to the beginning of this frame. Not used yet, but will be needed for tail-recursion elimination. */ BEFORE_POTENTIAL_GC (); @@ -891,16 +891,24 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, save_excursion_save ()); break; - case Bsave_current_buffer: + case Bsave_current_buffer: /* Obsolete. */ case Bsave_current_buffer_1: record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); break; - case Bsave_window_excursion: - BEFORE_POTENTIAL_GC (); - TOP = Fsave_window_excursion (TOP); /* FIXME: lexbind */ - AFTER_POTENTIAL_GC (); - break; + case Bsave_window_excursion: /* Obsolete. */ + { + register Lisp_Object val; + register int count = SPECPDL_INDEX (); + + record_unwind_protect (Fset_window_configuration, + Fcurrent_window_configuration (Qnil)); + BEFORE_POTENTIAL_GC (); + TOP = Fprogn (TOP); + unbind_to (count, TOP); + AFTER_POTENTIAL_GC (); + break; + } case Bsave_restriction: record_unwind_protect (save_restriction_restore, @@ -1412,7 +1420,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Binteractive_p: + case Binteractive_p: /* Obsolete. */ PUSH (Finteractive_p ()); break; diff --git a/src/window.c b/src/window.c index abf01758c3f..c90cc268a92 100644 --- a/src/window.c +++ b/src/window.c @@ -6400,28 +6400,6 @@ redirection (see `redirect-frame-focus'). */) return (tem); } -DEFUN ("save-window-excursion", Fsave_window_excursion, Ssave_window_excursion, - 0, UNEVALLED, 0, - doc: /* Execute BODY, preserving window sizes and contents. -Return the value of the last form in BODY. -Restore which buffer appears in which window, where display starts, -and the value of point and mark for each window. -Also restore the choice of selected window. -Also restore which buffer is current. -Does not restore the value of point in current buffer. -usage: (save-window-excursion BODY...) */) - (Lisp_Object args) -{ - register Lisp_Object val; - register int count = SPECPDL_INDEX (); - - record_unwind_protect (Fset_window_configuration, - Fcurrent_window_configuration (Qnil)); - val = Fprogn (args); - return unbind_to (count, val); -} - - /*********************************************************************** Window Split Tree @@ -7195,7 +7173,6 @@ frame to be redrawn only if it is a tty frame. */); defsubr (&Swindow_configuration_frame); defsubr (&Sset_window_configuration); defsubr (&Scurrent_window_configuration); - defsubr (&Ssave_window_excursion); defsubr (&Swindow_tree); defsubr (&Sset_window_margins); defsubr (&Swindow_margins); diff --git a/src/window.h b/src/window.h index 491ffa30bd1..473a43bbc3c 100644 --- a/src/window.h +++ b/src/window.h @@ -860,7 +860,6 @@ EXFUN (Fwindow_minibuffer_p, 1); EXFUN (Fdelete_window, 1); EXFUN (Fwindow_buffer, 1); EXFUN (Fget_buffer_window, 2); -EXFUN (Fsave_window_excursion, UNEVALLED); EXFUN (Fset_window_configuration, 1); EXFUN (Fcurrent_window_configuration, 1); extern int compare_window_configurations (Lisp_Object, Lisp_Object, int); From 3e21b6a72b87787e2327513a44623b250054f77d Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 21 Feb 2011 15:12:44 -0500 Subject: [PATCH 18/45] Use offsets relative to top rather than bottom for stack refs * lisp/emacs-lisp/byte-opt.el (byte-compile-side-effect-and-error-free-ops): Remove interactive-p. (byte-optimize-lapcode): Update optimizations now that stack-refs are relative to the top rather than to the bottom. * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode): Turn stack-ref-0 into dup. (byte-compile-form): Don't indirect-function since it can signal errors. (byte-compile-stack-ref, byte-compile-stack-set): Adjust to stack-refs being relative to top rather than to bottom in the byte-code. (with-output-to-temp-buffer): Remove. (byte-compile-with-output-to-temp-buffer): Remove. * lisp/emacs-lisp/cconv.el: Use lexical-binding. (cconv--lookup-let): Rename from cconv-lookup-let. (cconv-closure-convert-rec): Fix handling of captured+mutated arguments in defun/defmacro. * lisp/emacs-lisp/eieio-comp.el (eieio-byte-compile-file-form-defmethod): Rename from byte-compile-file-form-defmethod. Don't byte-compile-lambda. (eieio-byte-compile-defmethod-param-convert): Rename from byte-compile-defmethod-param-convert. * lisp/emacs-lisp/eieio.el (eieio-defgeneric-form-primary-only-one): Call byte-compile rather than byte-compile-lambda. * src/alloc.c (Fgarbage_collect): Don't mark the byte-stack redundantly. * src/bytecode.c (exec_byte_code): Change stack_ref and stack_set to use offsets relative to top rather than to bottom. * lisp/subr.el (with-output-to-temp-buffer): New macro. * lisp/simple.el (count-words-region): Don't use interactive-p. --- lisp/ChangeLog | 39 ++++++++++ lisp/emacs-lisp/byte-opt.el | 143 ++++++++++++++++------------------ lisp/emacs-lisp/bytecomp.el | 34 ++++---- lisp/emacs-lisp/cconv.el | 45 ++++++----- lisp/emacs-lisp/eieio-comp.el | 11 ++- lisp/emacs-lisp/eieio.el | 17 ++-- lisp/simple.el | 3 +- lisp/subr.el | 51 ++++++++++-- src/ChangeLog | 7 ++ src/alloc.c | 2 +- src/bytecode.c | 52 ++++++++----- src/print.c | 57 +------------- src/window.c | 12 ++- 13 files changed, 263 insertions(+), 210 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ae91513937c..4e2e87ab60f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,42 @@ +2011-02-21 Stefan Monnier + + * subr.el (with-output-to-temp-buffer): New macro. + + * simple.el (count-words-region): Don't use interactive-p. + + * minibuffer.el: Use lexical-binding. Replace all uses of lexical-let. + + * emacs-lisp/eieio.el (eieio-defgeneric-form-primary-only-one): + Call byte-compile rather than byte-compile-lambda. + + * emacs-lisp/eieio-comp.el (eieio-byte-compile-file-form-defmethod): + Rename from byte-compile-file-form-defmethod. + Don't byte-compile-lambda. + (eieio-byte-compile-defmethod-param-convert): Rename from + byte-compile-defmethod-param-convert. + + * emacs-lisp/cl-extra.el (cl-macroexpand-all): Don't assume that the + value of (function (lambda ...)) is self-quoting. + + * emacs-lisp/cconv.el: Use lexical-binding. + (cconv--lookup-let): Rename from cconv-lookup-let. + (cconv-closure-convert-rec): Fix handling of captured+mutated + arguments in defun/defmacro. + + * emacs-lisp/bytecomp.el (byte-compile-lapcode): + Turn stack-ref-0 into dup. + (byte-compile-form): Don't indirect-function since it can signal + errors. + (byte-compile-stack-ref, byte-compile-stack-set): Adjust to stack-refs + being relative to top rather than to bottom in the byte-code. + (with-output-to-temp-buffer): Remove. + (byte-compile-with-output-to-temp-buffer): Remove. + + * emacs-lisp/byte-opt.el (byte-compile-side-effect-and-error-free-ops): + Remove interactive-p. + (byte-optimize-lapcode): Update optimizations now that stack-refs are + relative to the top rather than to the bottom. + 2011-02-19 Stefan Monnier * subr.el (save-window-excursion): New macro, moved from C. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 038db292350..e415b5edde2 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1470,7 +1470,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-stack-ref)) + byte-current-buffer byte-stack-ref)) (defconst byte-compile-side-effect-free-ops (nconc @@ -1628,14 +1628,15 @@ 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. ;; - ((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)) + ;; For lexical variables, we could do the same + ;; stack-set-X+1 stack-ref-X --> dup stack-set-X+2 + ;; but this is a very minor gain, since dup is stack-ref-0, + ;; i.e. it's only better if X>5, and even then it comes + ;; at the cost cost of an extra stack slot. Let's not bother. + ((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)) (not (eq (car lap0) 'byte-constant))) nil (setq keep-going t) @@ -1663,15 +1664,18 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; ;; dup varset-X discard --> varset-X ;; dup varbind-X discard --> varbind-X + ;; dup stack-set-X discard --> stack-set-X-1 ;; (the varbind variant can emerge from other optimizations) ;; ((and (eq 'byte-dup (car lap0)) (eq 'byte-discard (car lap2)) - (memq (car lap1) '(byte-varset byte-varbind byte-stack-set))) + (memq (car lap1) '(byte-varset byte-varbind + byte-stack-set))) (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1) (setq keep-going t rest (cdr rest) stack-adjust -1) + (if (eq 'byte-stack-set (car lap1)) (decf (cdr lap1))) (setq lap (delq lap0 (delq lap2 lap)))) ;; ;; not goto-X-if-nil --> goto-X-if-non-nil @@ -1739,18 +1743,24 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; ;; varref-X varref-X --> varref-X dup ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup + ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup ;; We don't optimize the const-X variations on this here, ;; because that would inhibit some goto optimizations; we ;; optimize the const-X case after all other optimizations. ;; ((and (memq (car lap0) '(byte-varref byte-stack-ref)) (progn - (setq tmp (cdr rest) tmp2 0) + (setq tmp (cdr rest)) + (setq tmp2 0) (while (eq (car (car tmp)) 'byte-dup) - (setq tmp (cdr tmp) tmp2 (1+ tmp2))) + (setq tmp2 (1+ tmp2)) + (setq tmp (cdr tmp))) t) - (eq (car lap0) (car (car tmp))) - (eq (cdr lap0) (cdr (car tmp)))) + (eq (if (eq 'byte-stack-ref (car lap0)) + (+ tmp2 1 (cdr lap0)) + (cdr lap0)) + (cdr (car tmp))) + (eq (car lap0) (car (car tmp)))) (if (memq byte-optimize-log '(t byte)) (let ((str "")) (setq tmp2 (cdr rest)) @@ -1857,14 +1867,6 @@ 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 stack-depth (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 ;; @@ -1948,12 +1950,19 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; 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). + ;; + ;; Here again, we could do it for stack-ref/stack-set, but + ;; that's replacing a stack-ref-Y with a stack-ref-0, which + ;; is a very minor improvement (if any), at the cost of + ;; more stack use and more byte-code. Let's not do it. ;; - ((and (memq (car lap1) '(byte-varset byte-stack-set)) + ((and (eq (car lap1) 'byte-varset) (eq (car lap2) 'byte-goto) (not (memq (cdr lap2) rest)) ;Backwards jump (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap))))) - (if (eq (car lap1) 'byte-varset) 'byte-varref 'byte-stack-ref)) + (if (eq (car lap1) 'byte-varset) 'byte-varref + ;; 'byte-stack-ref + )) (eq (cdr (car tmp)) (cdr lap1)) (not (and (eq (car lap1) 'byte-varref) (memq (car (cdr lap1)) byte-boolean-vars)))) @@ -2026,7 +2035,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; Rebuild byte-compile-constants / byte-compile-variables. ;; Simple optimizations that would inhibit other optimizations if they ;; were done in the optimizing loop, and optimizations which there is no - ;; need to do more than once. + ;; need to do more than once. (setq byte-compile-constants nil byte-compile-variables nil) (setq rest lap @@ -2089,38 +2098,38 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; stack-set-M [discard/discardN ...] --> discardN-preserve-tos ;; stack-set-M [discard/discardN ...] --> discardN ;; - ((and stack-depth ;Make sure we know the stack depth. - (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 + ((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 (1- (cdr lap0))) + (setq tmp3 0) + (while (memq (car (car tmp)) '(byte-discard byte-discardN)) + (setq tmp3 + (+ tmp3 (if (eq (car (car tmp)) 'byte-discard) + 1 + (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))) + (setcar lap1 + (if (= 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. + 'byte-discardN-preserve-tos + ;; Otherwise, the value stored is lost, so just use a + ;; normal discard. + 'byte-discardN)) + (setcdr lap1 (1+ tmp3)) (setcdr (cdr rest) tmp) (setq stack-adjust 0) (byte-compile-log-lap " %s [discard/discardN]...\t-->\t%s" - lap0 lap1)) + lap0 lap1)) ;; ;; discard/discardN/discardN-preserve-tos-X discard/discardN-Y --> @@ -2158,30 +2167,16 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; dup return --> return ;; stack-set-N return --> return ; where N is TOS-1 ;; - ((and stack-depth ;Make sure we know the stack depth. - (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 + ((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) 1)))) + ;; 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 stack-depth ;Make sure we know the stack depth. - (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))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 54a1912169a..8892a27b29c 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -636,13 +636,13 @@ otherwise pop it") ;; Takes, on stack, the buffer name. ;; Binds standard-output and does some other things. ;; Returns with temp buffer on the stack in place of buffer name. -(byte-defop 144 0 byte-temp-output-buffer-setup) +;; (byte-defop 144 0 byte-temp-output-buffer-setup) ;; For exit from with-output-to-temp-buffer. ;; Expects the temp buffer on the stack underneath value to return. ;; Pops them both, then pushes the value back on. ;; Unbinds standard-output and makes the temp buffer visible. -(byte-defop 145 -1 byte-temp-output-buffer-show) +;; (byte-defop 145 -1 byte-temp-output-buffer-show) ;; these ops are new to v19 @@ -826,6 +826,10 @@ CONST2 may be evaulated multiple times." ((null off) ;; opcode that doesn't use OFF (byte-compile-push-bytecodes opcode bytes pc)) + ((and (eq opcode byte-stack-ref) (eq off 0)) + ;; (stack-ref 0) is really just another name for `dup'. + (debug) ;FIXME: When would this happen? + (byte-compile-push-bytecodes byte-dup 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. @@ -2530,13 +2534,13 @@ 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 + ;; Expand macros. (setq fun (macroexpand-all fun byte-compile-initial-macro-environment)) (if lexical-binding (setq fun (cconv-closure-convert fun))) - ;; get rid of the `function' quote added by the `lambda' macro + ;; 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)) @@ -2953,7 +2957,7 @@ That command is designed for interactive use only" bytecomp-fn)) (byte-compile-nogroup-warn form)) (byte-compile-callargs-warn form)) (if (and (fboundp (car form)) - (eq (car-safe (indirect-function (car form))) 'macro)) + (eq (car-safe (symbol-function (car form))) 'macro)) (byte-compile-report-error (format "Forgot to expand macro %s" (car form)))) (if (and bytecomp-handler @@ -3324,15 +3328,16 @@ discarding." (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))) + (let ((dist (- byte-compile-depth (1+ stack-pos)))) + (if (zerop dist) + ;; A simple optimization + (byte-compile-out 'byte-dup) + ;; normal case + (byte-compile-out 'byte-stack-ref dist)))) (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)) + (byte-compile-out 'byte-stack-set (- byte-compile-depth (1+ stack-pos)))) ;; Compile a function that accepts one or more args and is right-associative. @@ -3946,7 +3951,6 @@ binding slots have been popped." (byte-defop-compiler-1 save-excursion) (byte-defop-compiler-1 save-current-buffer) (byte-defop-compiler-1 save-restriction) -(byte-defop-compiler-1 with-output-to-temp-buffer) (byte-defop-compiler-1 track-mouse) (defun byte-compile-catch (form) @@ -4045,12 +4049,6 @@ binding slots have been popped." (byte-compile-out 'byte-save-current-buffer 0) (byte-compile-body-do-effect (cdr form)) (byte-compile-out 'byte-unbind 1)) - -(defun byte-compile-with-output-to-temp-buffer (form) - (byte-compile-form (car (cdr form))) - (byte-compile-out 'byte-temp-output-buffer-setup 0) - (byte-compile-body (cdr (cdr form))) - (byte-compile-out 'byte-temp-output-buffer-show 0)) ;;; top-level forms elsewhere diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 4e42e9f3c1d..66e5051c2f1 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -1,4 +1,4 @@ -;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: nil -*- +;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t -*- ;; Copyright (C) 2011 Free Software Foundation, Inc. @@ -71,13 +71,17 @@ ;;; Code: ;;; TODO: +;; - Change new byte-code representation, so it directly gives the +;; number of mandatory and optional arguments as well as whether or +;; not there's a &rest arg. ;; - Use abstract `make-closure' and `closure-ref' expressions, which bytecomp ;; should turn into building corresponding byte-code function. ;; - don't use `curry', instead build a new compiled-byte-code object ;; (merge the closure env into the static constants pool). -;; - use relative addresses for byte-code-stack-ref. ;; - warn about unused lexical vars. ;; - clean up cconv-closure-convert-rec, especially the `let' binding part. +;; - new byte codes for unwind-protect, catch, and condition-case so that +;; closures aren't needed at all. (eval-when-compile (require 'cl)) @@ -215,7 +219,7 @@ Returns a form where all lambdas don't have any free variables." '() ))) -(defun cconv-lookup-let (table var binder form) +(defun cconv--lookup-let (table var binder form) (let ((res nil)) (dolist (elem table) (when (and (eq (nth 2 elem) binder) @@ -312,7 +316,7 @@ Returns a form where all lambdas don't have any free variables." (new-val (cond ;; Check if var is a candidate for lambda lifting. - ((cconv-lookup-let cconv-lambda-candidates var binder form) + ((cconv--lookup-let cconv-lambda-candidates var binder form) (let* ((fv (delete-dups (cconv-freevars value '()))) (funargs (cadr (cadr value))) @@ -341,7 +345,7 @@ Returns a form where all lambdas don't have any free variables." ,(reverse funcbodies-new)))))))) ;; Check if it needs to be turned into a "ref-cell". - ((cconv-lookup-let cconv-captured+mutated var binder form) + ((cconv--lookup-let cconv-captured+mutated var binder form) ;; Declared variable is mutated and captured. (prog1 `(list ,(cconv-closure-convert-rec @@ -478,9 +482,9 @@ Returns a form where all lambdas don't have any free variables." (cons 'cond (reverse cond-forms-new)))) - (`(quote . ,_) form) ; quote form + (`(quote . ,_) form) - (`(function . ((lambda ,vars . ,body-forms))) ; function form + (`(function (lambda ,vars . ,body-forms)) ; function form (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs. (fv (delete-dups (cconv-freevars form '()))) (leave fvrs-new) ; leave=non-nil if we should leave env unchanged. @@ -493,8 +497,8 @@ Returns a form where all lambdas don't have any free variables." ;; If outer closure contains all ;; free variables of this function(and nothing else) ;; then we use the same environment vector as for outer closure, - ;; i.e. we leave the environment vector unchanged - ;; otherwise we build a new environmet vector + ;; i.e. we leave the environment vector unchanged, + ;; otherwise we build a new environment vector. (if (eq (length envs) (length fv)) (let ((fv-temp fv)) (while (and fv-temp leave) @@ -552,7 +556,7 @@ Returns a form where all lambdas don't have any free variables." (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new)) (vector . ,envector)))))) - (`(function . ,_) form) ; same as quote + (`(function . ,_) form) ; Same as quote. ;defconst, defvar (`(,(and sym (or `defconst `defvar)) ,definedsymbol . ,body-forms) @@ -568,23 +572,23 @@ Returns a form where all lambdas don't have any free variables." ;defun, defmacro (`(,(and sym (or `defun `defmacro)) ,func ,vars . ,body-forms) - (let ((body-new '()) ; the whole body - (body-forms-new '()) ; body w\o docstring and interactive + (let ((body-new '()) ; The whole body. + (body-forms-new '()) ; Body w\o docstring and interactive. (letbind '())) - ; find mutable arguments - (let ((lmutated cconv-captured+mutated) ismutated) - (dolist (elm vars) - (setq ismutated nil) + ; Find mutable arguments. + (dolist (elm vars) + (let ((lmutated cconv-captured+mutated) + (ismutated nil)) (while (and lmutated (not ismutated)) (when (and (eq (caar lmutated) elm) - (eq (cadar lmutated) form)) + (eq (caddar lmutated) form)) (setq ismutated t)) (setq lmutated (cdr lmutated))) (when ismutated (push elm letbind) (push elm emvrs)))) - ;transform body-forms - (when (stringp (car body-forms)) ; treat docstring well + ;Transform body-forms. + (when (stringp (car body-forms)) ; Treat docstring well. (push (car body-forms) body-new) (setq body-forms (cdr body-forms))) (when (eq (car-safe (car body-forms)) 'interactive) @@ -601,7 +605,7 @@ Returns a form where all lambdas don't have any free variables." (setq body-forms-new (reverse body-forms-new)) (if letbind - ; letbind mutable arguments + ; Letbind mutable arguments. (let ((binders-new '())) (dolist (elm letbind) (push `(,elm (list ,elm)) binders-new)) @@ -655,6 +659,7 @@ Returns a form where all lambdas don't have any free variables." (push `(setcar ,sym-new ,value) prognlist) (if (symbolp sym-new) (push `(setq ,sym-new ,value) prognlist) + (debug) ;FIXME: When can this be right? (push `(set ,sym-new ,value) prognlist))) (setq forms (cddr forms))) (if (cdr prognlist) diff --git a/lisp/emacs-lisp/eieio-comp.el b/lisp/emacs-lisp/eieio-comp.el index ed6fb6f1c41..244c4318425 100644 --- a/lisp/emacs-lisp/eieio-comp.el +++ b/lisp/emacs-lisp/eieio-comp.el @@ -45,9 +45,9 @@ ) ;; This teaches the byte compiler how to do this sort of thing. -(put 'defmethod 'byte-hunk-handler 'byte-compile-file-form-defmethod) +(put 'defmethod 'byte-hunk-handler 'eieio-byte-compile-file-form-defmethod) -(defun byte-compile-file-form-defmethod (form) +(defun eieio-byte-compile-file-form-defmethod (form) "Mumble about the method we are compiling. This function is mostly ripped from `byte-compile-file-form-defun', but it's been modified to handle the special syntax of the `defmethod' @@ -74,7 +74,7 @@ that is called but rarely. Argument FORM is the body of the method." ":static ") (t "")))) (params (car form)) - (lamparams (byte-compile-defmethod-param-convert params)) + (lamparams (eieio-byte-compile-defmethod-param-convert params)) (arg1 (car params)) (class (if (listp arg1) (nth 1 arg1) nil)) (my-outbuffer (if (eval-when-compile (featurep 'xemacs)) @@ -98,6 +98,9 @@ that is called but rarely. Argument FORM is the body of the method." ;; Byte compile the body. For the byte compiled forms, add the ;; rest arguments, which will get ignored by the engine which will ;; add them later (I hope) + ;; FIXME: This relies on compiler's internal. Make sure it still + ;; works with lexical-binding code. Maybe calling `byte-compile' + ;; would be preferable. (let* ((new-one (byte-compile-lambda (append (list 'lambda lamparams) (cdr form)))) @@ -125,7 +128,7 @@ that is called but rarely. Argument FORM is the body of the method." ;; nil prevents cruft from appearing in the output buffer. nil)) -(defun byte-compile-defmethod-param-convert (paramlist) +(defun eieio-byte-compile-defmethod-param-convert (paramlist) "Convert method params into the params used by the `defmethod' thingy. Argument PARAMLIST is the parameter list to convert." (let ((argfix nil)) diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index d958bfbd45c..82c0e1319fe 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -182,9 +182,9 @@ Stored outright without modifications or stripping.") )) ;; How to specialty compile stuff. -(autoload 'byte-compile-file-form-defmethod "eieio-comp" +(autoload 'eieio-byte-compile-file-form-defmethod "eieio-comp" "This function is used to byte compile methods in a nice way.") -(put 'defmethod 'byte-hunk-handler 'byte-compile-file-form-defmethod) +(put 'defmethod 'byte-hunk-handler 'eieio-byte-compile-file-form-defmethod) ;;; Important macros used in eieio. ;; @@ -1192,10 +1192,8 @@ IMPL is the symbol holding the method implementation." ;; is faster to execute this for not byte-compiled. ie, install this, ;; then measure calls going through here. I wonder why. (require 'bytecomp) - (let ((byte-compile-free-references nil) - (byte-compile-warnings nil) - ) - (byte-compile-lambda + (let ((byte-compile-warnings nil)) + (byte-compile `(lambda (&rest local-args) ,doc-string ;; This is a cool cheat. Usually we need to look up in the @@ -1205,7 +1203,8 @@ IMPL is the symbol holding the method implementation." ;; of that one implementation, then clearly, there is no method def. (if (not (eieio-object-p (car local-args))) ;; Not an object. Just signal. - (signal 'no-method-definition (list ,(list 'quote method) local-args)) + (signal 'no-method-definition + (list ,(list 'quote method) local-args)) ;; We do have an object. Make sure it is the right type. (if ,(if (eq class eieio-default-superclass) @@ -1228,9 +1227,7 @@ IMPL is the symbol holding the method implementation." ) (apply ,(list 'quote impl) local-args) ;(,impl local-args) - )))) - ) - )) + ))))))) (defsubst eieio-defgeneric-reset-generic-form-primary-only-one (method) "Setup METHOD to call the generic form." diff --git a/lisp/simple.el b/lisp/simple.el index 456318de213..4776cf37931 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -990,7 +990,7 @@ When called interactively, the word count is printed in echo area." (goto-char (point-min)) (while (forward-word 1) (setq count (1+ count))))) - (if (interactive-p) + (if (called-interactively-p 'interactive) (message "Region has %d words" count)) count)) @@ -6641,6 +6641,7 @@ saving the value of `buffer-invisibility-spec' and setting it to nil." ;; Partial application of functions (similar to "currying"). ;; This function is here rather than in subr.el because it uses CL. +;; (defalias 'apply-partially #'curry) (defun apply-partially (fun &rest args) "Return a function that is a partial application of FUN to ARGS. ARGS is a list of the first N arguments to pass to FUN. diff --git a/lisp/subr.el b/lisp/subr.el index 626128c62b3..a493c31b254 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -426,12 +426,6 @@ Non-strings in LIST are ignored." (setq list (cdr list))) list) -;; Remove this since we don't know how to handle it in the byte-compiler yet. -;; (defmacro with-lexical-binding (&rest body) -;; "Execute the statements in BODY using lexical binding." -;; `(let ((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. @@ -2786,6 +2780,51 @@ in which case `save-window-excursion' cannot help." (unwind-protect (progn ,@body) (set-window-configuration ,c))))) +(defmacro with-output-to-temp-buffer (bufname &rest body) + "Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer. + +This construct makes buffer BUFNAME empty before running BODY. +It does not make the buffer current for BODY. +Instead it binds `standard-output' to that buffer, so that output +generated with `prin1' and similar functions in BODY goes into +the buffer. + +At the end of BODY, this marks buffer BUFNAME unmodifed and displays +it in a window, but does not select it. The normal way to do this is +by calling `display-buffer', then running `temp-buffer-show-hook'. +However, if `temp-buffer-show-function' is non-nil, it calls that +function instead (and does not run `temp-buffer-show-hook'). The +function gets one argument, the buffer to display. + +The return value of `with-output-to-temp-buffer' is the value of the +last form in BODY. If BODY does not finish normally, the buffer +BUFNAME is not displayed. + +This runs the hook `temp-buffer-setup-hook' before BODY, +with the buffer BUFNAME temporarily current. It runs the hook +`temp-buffer-show-hook' after displaying buffer BUFNAME, with that +buffer temporarily current, and the window that was used to display it +temporarily selected. But it doesn't run `temp-buffer-show-hook' +if it uses `temp-buffer-show-function'." + (let ((old-dir (make-symbol "old-dir")) + (buf (make-symbol "buf"))) + `(let ((,old-dir default-directory)) + (with-current-buffer (get-buffer-create ,bufname) + (kill-all-local-variables) + ;; FIXME: delete_all_overlays + (setq default-directory ,old-dir) + (setq buffer-read-only nil) + (setq buffer-file-name nil) + (setq buffer-undo-list t) + (let ((,buf (current-buffer))) + (let ((inhibit-read-only t) + (inhibit-modification-hooks t)) + (erase-buffer) + (run-hooks 'temp-buffer-setup-hook)) + (let ((standard-output ,buf)) + (prog1 (progn ,@body) + (internal-temp-output-buffer-show ,buf)))))))) + (defmacro with-temp-file (file &rest body) "Create a new buffer, evaluate BODY there, and write the buffer to FILE. The value returned is the value of the last form in BODY. diff --git a/src/ChangeLog b/src/ChangeLog index 6bebce0abaa..d522b6c55dc 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-02-21 Stefan Monnier + + * bytecode.c (exec_byte_code): Change stack_ref and stack_set to use + offsets relative to top rather than to bottom. + + * alloc.c (Fgarbage_collect): Don't mark the byte-stack redundantly. + 2011-02-19 Stefan Monnier * window.c (Fsave_window_excursion): Remove. Moved to Lisp. diff --git a/src/alloc.c b/src/alloc.c index 36c849418f3..4c29ce0b4ec 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -5029,9 +5029,9 @@ returns nil, because real GC can't be done. */) for (i = 0; i < tail->nvars; i++) mark_object (tail->var[i]); } + mark_byte_stack (); #endif - mark_byte_stack (); for (catch = catchlist; catch; catch = catch->next) { mark_object (catch->tag); diff --git a/src/bytecode.c b/src/bytecode.c index ad2f7d18ade..b2e9e3c5b56 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -51,7 +51,7 @@ by Hallvard: * * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. */ -/* #define BYTE_CODE_SAFE */ +#define BYTE_CODE_SAFE /* #define BYTE_CODE_METER */ @@ -88,7 +88,7 @@ extern Lisp_Object Qand_optional, Qand_rest; /* Byte codes: */ -#define Bstack_ref 0 +#define Bstack_ref 0 /* Actually, Bstack_ref+0 is not implemented: use dup. */ #define Bvarref 010 #define Bvarset 020 #define Bvarbind 030 @@ -189,8 +189,8 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bunwind_protect 0216 #define Bcondition_case 0217 -#define Btemp_output_buffer_setup 0220 -#define Btemp_output_buffer_show 0221 +#define Btemp_output_buffer_setup 0220 /* Obsolete. */ +#define Btemp_output_buffer_show 0221 /* Obsolete. */ #define Bunbind_all 0222 /* Obsolete. */ @@ -898,9 +898,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, case Bsave_window_excursion: /* Obsolete. */ { - register Lisp_Object val; register int count = SPECPDL_INDEX (); - record_unwind_protect (Fset_window_configuration, Fcurrent_window_configuration (Qnil)); BEFORE_POTENTIAL_GC (); @@ -940,7 +938,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, break; } - case Btemp_output_buffer_setup: + case Btemp_output_buffer_setup: /* Obsolete. */ BEFORE_POTENTIAL_GC (); CHECK_STRING (TOP); temp_output_buffer_setup (SSDATA (TOP)); @@ -948,7 +946,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, TOP = Vstandard_output; break; - case Btemp_output_buffer_show: + case Btemp_output_buffer_show: /* Obsolete. */ { Lisp_Object v1; BEFORE_POTENTIAL_GC (); @@ -1710,26 +1708,42 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, #endif /* Handy byte-codes for lexical binding. */ - case Bstack_ref: + /* case Bstack_ref: */ /* Use `dup' instead. */ 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; + { + Lisp_Object *ptr = top - (op - Bstack_ref); + PUSH (*ptr); + break; + } case Bstack_ref+6: - PUSH (stack.bottom[FETCH]); - break; + { + Lisp_Object *ptr = top - (FETCH); + PUSH (*ptr); + break; + } case Bstack_ref+7: - PUSH (stack.bottom[FETCH2]); - break; + { + Lisp_Object *ptr = top - (FETCH2); + PUSH (*ptr); + break; + } + /* stack-set-0 = discard; stack-set-1 = discard-1-preserve-tos. */ case Bstack_set: - stack.bottom[FETCH] = POP; - break; + { + Lisp_Object *ptr = top - (FETCH); + *ptr = POP; + break; + } case Bstack_set2: - stack.bottom[FETCH2] = POP; - break; + { + Lisp_Object *ptr = top - (FETCH2); + *ptr = POP; + break; + } case BdiscardN: op = FETCH; if (op & 0x80) diff --git a/src/print.c b/src/print.c index 2c4762047ac..f48b618775d 100644 --- a/src/print.c +++ b/src/print.c @@ -524,6 +524,7 @@ temp_output_buffer_setup (const char *bufname) specbind (Qstandard_output, buf); } +/* FIXME: Use Lisp's with-output-to-temp-buffer instead! */ Lisp_Object internal_with_output_to_temp_buffer (const char *bufname, Lisp_Object (*function) (Lisp_Object), Lisp_Object args) { @@ -545,60 +546,6 @@ internal_with_output_to_temp_buffer (const char *bufname, Lisp_Object (*function return unbind_to (count, val); } - -DEFUN ("with-output-to-temp-buffer", - Fwith_output_to_temp_buffer, Swith_output_to_temp_buffer, - 1, UNEVALLED, 0, - doc: /* Bind `standard-output' to buffer BUFNAME, eval BODY, then show that buffer. - -This construct makes buffer BUFNAME empty before running BODY. -It does not make the buffer current for BODY. -Instead it binds `standard-output' to that buffer, so that output -generated with `prin1' and similar functions in BODY goes into -the buffer. - -At the end of BODY, this marks buffer BUFNAME unmodifed and displays -it in a window, but does not select it. The normal way to do this is -by calling `display-buffer', then running `temp-buffer-show-hook'. -However, if `temp-buffer-show-function' is non-nil, it calls that -function instead (and does not run `temp-buffer-show-hook'). The -function gets one argument, the buffer to display. - -The return value of `with-output-to-temp-buffer' is the value of the -last form in BODY. If BODY does not finish normally, the buffer -BUFNAME is not displayed. - -This runs the hook `temp-buffer-setup-hook' before BODY, -with the buffer BUFNAME temporarily current. It runs the hook -`temp-buffer-show-hook' after displaying buffer BUFNAME, with that -buffer temporarily current, and the window that was used to display it -temporarily selected. But it doesn't run `temp-buffer-show-hook' -if it uses `temp-buffer-show-function'. - -usage: (with-output-to-temp-buffer BUFNAME BODY...) */) - (Lisp_Object args) -{ - struct gcpro gcpro1; - Lisp_Object name; - int count = SPECPDL_INDEX (); - Lisp_Object buf, val; - - GCPRO1(args); - name = eval_sub (Fcar (args)); - CHECK_STRING (name); - temp_output_buffer_setup (SSDATA (name)); - buf = Vstandard_output; - UNGCPRO; - - val = Fprogn (XCDR (args)); - - GCPRO1 (val); - temp_output_buffer_show (buf); - UNGCPRO; - - return unbind_to (count, val); -} - static void print (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag); static void print_preprocess (Lisp_Object obj); @@ -2310,6 +2257,4 @@ priorities. */); print_prune_charset_plist = Qnil; staticpro (&print_prune_charset_plist); - - defsubr (&Swith_output_to_temp_buffer); } diff --git a/src/window.c b/src/window.c index c90cc268a92..d21cbb164ea 100644 --- a/src/window.c +++ b/src/window.c @@ -3655,7 +3655,6 @@ displaying that buffer. */) return Qnil; } - void temp_output_buffer_show (register Lisp_Object buf) { @@ -3715,6 +3714,16 @@ temp_output_buffer_show (register Lisp_Object buf) } } } + +DEFUN ("internal-temp-output-buffer-show", + Ftemp_output_buffer_show, Stemp_output_buffer_show, + 1, 1, 0, + doc: /* Internal function for `with-output-to-temp-buffer''. */) + (Lisp_Object buf) +{ + temp_output_buffer_show (buf); + return Qnil; +} static void make_dummy_parent (Lisp_Object window) @@ -7155,6 +7164,7 @@ frame to be redrawn only if it is a tty frame. */); defsubr (&Sset_window_buffer); defsubr (&Sselect_window); defsubr (&Sforce_window_update); + defsubr (&Stemp_output_buffer_show); defsubr (&Ssplit_window); defsubr (&Senlarge_window); defsubr (&Sshrink_window); From a647cb26b695a542e3a546104afdf4c7c47eb061 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 21 Feb 2011 15:31:07 -0500 Subject: [PATCH 19/45] Missing files in last commit; remove stack-depth in byte-optimize-lapcode --- lisp/emacs-lisp/byte-opt.el | 106 ++++---------------- lisp/emacs-lisp/cl-extra.el | 9 +- lisp/emacs-lisp/cl-loaddefs.el | 2 +- lisp/minibuffer.el | 174 ++++++++++++++++----------------- 4 files changed, 109 insertions(+), 182 deletions(-) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index e415b5edde2..b08fc3d708a 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -186,8 +186,10 @@ (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")) + ;; Newer byte codes for stack-ref make the slot 0 non-nil again. + ;; But the "old disassembler" is *really* ancient by now. + ;; (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) @@ -1512,50 +1514,12 @@ ;; 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 @@ -1566,15 +1530,12 @@ 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. @@ -1588,22 +1549,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 ((= stack-adjust 1) + (cond ((= tmp 1) (byte-compile-log-lap " %s discard\t-->\t" lap0) (setq lap (delq lap0 (delq lap1 lap)))) - ((= stack-adjust 0) + ((= tmp 0) (byte-compile-log-lap " %s discard\t-->\t discard" lap0) (setq lap (delq lap0 lap))) - ((= stack-adjust -1) + ((= tmp -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"))) - (setq stack-adjust (1- stack-adjust))) + ((error "Optimizer error: too much on the stack")))) ;; ;; goto*-X X: --> X: ;; @@ -1673,8 +1634,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." byte-stack-set))) (byte-compile-log-lap " dup %s discard\t-->\t%s" lap1 lap1) (setq keep-going t - rest (cdr rest) - stack-adjust -1) + rest (cdr rest)) (if (eq 'byte-stack-set (car lap1)) (decf (cdr lap1))) (setq lap (delq lap0 (delq lap2 lap)))) ;; @@ -1697,8 +1657,7 @@ 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 - stack-adjust 0)) + (setq keep-going t)) ;; ;; 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: @@ -1714,8 +1673,7 @@ 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) - stack-adjust 0) + (setq lap (delq lap0 lap)) (setcar lap1 inverse) (setq keep-going t))) ;; @@ -1738,8 +1696,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (when (memq (car lap1) byte-goto-always-pop-ops) (setq lap (delq lap0 lap))) (setcar lap1 'byte-goto))) - (setq keep-going t - stack-adjust 0)) + (setq keep-going t)) ;; ;; varref-X varref-X --> varref-X dup ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup @@ -1772,8 +1729,7 @@ 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 - stack-adjust (+ 2 tmp2))) + (setq rest tmp)) ;; ;; TAG1: TAG2: --> TAG1: ;; (and other references to TAG2 are replaced with TAG1) @@ -1840,8 +1796,7 @@ 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 - stack-adjust 0)) + (setq keep-going t)) ;; ;; varbind-X unbind-N --> discard unbind-(N-1) ;; save-excursion unbind-N --> unbind-(N-1) @@ -1943,8 +1898,7 @@ 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 - stack-adjust 0)) + (setq keep-going t)) ;; ;; X: varref-Y ... varset-Y goto-X --> ;; X: varref-Y Z: ... dup varset-Y goto-Z @@ -1960,12 +1914,9 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (eq (car lap2) 'byte-goto) (not (memq (cdr lap2) rest)) ;Backwards jump (eq (car (car (setq tmp (cdr (memq (cdr lap2) lap))))) - (if (eq (car lap1) 'byte-varset) 'byte-varref - ;; 'byte-stack-ref - )) + 'byte-varref) (eq (cdr (car tmp)) (cdr lap1)) - (not (and (eq (car lap1) 'byte-varref) - (memq (car (cdr lap1)) byte-boolean-vars)))) + (not (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 @@ -2022,15 +1973,10 @@ 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 - stack-adjust (and (not (eq (car lap0) 'byte-goto)) -1))) + (setq keep-going t)) ) - - (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 @@ -2038,13 +1984,11 @@ 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 - stack-depth initial-stack-depth) + (setq rest lap) (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)) @@ -2127,7 +2071,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." 'byte-discardN)) (setcdr lap1 (1+ tmp3)) (setcdr (cdr rest) tmp) - (setq stack-adjust 0) (byte-compile-log-lap " %s [discard/discardN]...\t-->\t%s" lap0 lap1)) @@ -2148,8 +2091,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (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)) + (setcar lap1 'byte-discardN)) ;; ;; discardN-preserve-tos-X discardN-preserve-tos-Y --> @@ -2159,7 +2101,6 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (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))) ;; @@ -2174,14 +2115,9 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; 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)) ) - - (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/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 885424ec726..12dafe274b9 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -771,10 +771,11 @@ This also does some trivial optimizations to make the form prettier." (sublis sub (nreverse decls)) (list (list* 'list '(quote apply) - (list 'function - (list* 'lambda - (append new (cadadr form)) - (sublis sub body))) + (list 'quote + (list 'function + (list* 'lambda + (append new (cadadr form)) + (sublis sub body)))) (nconc (mapcar (function (lambda (x) (list 'list '(quote quote) x))) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index a13e46ccc59..4f2d5df1f54 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -10,7 +10,7 @@ ;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p ;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively ;;;;;; notevery notany every some mapcon mapcan mapl maplist map -;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "60f6b85256416c5f2a0a3954a11523b6") +;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "2bfbae6523c842d511b8c8d88658825a") ;;; Generated autoloads from cl-extra.el (autoload 'coerce "cl-extra" "\ diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 1b42ee1f2ce..94ba46069d5 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -1,4 +1,4 @@ -;;; minibuffer.el --- Minibuffer completion functions +;;; minibuffer.el --- Minibuffer completion functions -*- lexical-binding: t -*- ;; Copyright (C) 2008-2011 Free Software Foundation, Inc. @@ -133,8 +133,8 @@ the closest directory separators." "Apply FUN to each element of XS in turn. Return the first non-nil returned value. Like CL's `some'." - (lexical-let ((firsterror nil) - res) + (let ((firsterror nil) + res) (while (and (not res) xs) (condition-case err (setq res (funcall fun (pop xs))) @@ -171,12 +171,11 @@ FUN will be called in the buffer from which the minibuffer was entered. The result of the `completion-table-dynamic' form is a function that can be used as the COLLECTION argument to `try-completion' and `all-completions'. See Info node `(elisp)Programmed Completion'." - (lexical-let ((fun fun)) - (lambda (string pred action) - (with-current-buffer (let ((win (minibuffer-selected-window))) - (if (window-live-p win) (window-buffer win) - (current-buffer))) - (complete-with-action action (funcall fun string) string pred))))) + (lambda (string pred action) + (with-current-buffer (let ((win (minibuffer-selected-window))) + (if (window-live-p win) (window-buffer win) + (current-buffer))) + (complete-with-action action (funcall fun string) string pred)))) (defmacro lazy-completion-table (var fun) "Initialize variable VAR as a lazy completion table. @@ -201,19 +200,18 @@ You should give VAR a non-nil `risky-local-variable' property." ;; Notice that `pred' may not be a function in some abusive cases. (when (functionp pred) (setq pred - (lexical-let ((pred pred)) - ;; Predicates are called differently depending on the nature of - ;; the completion table :-( - (cond - ((vectorp table) ;Obarray. - (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) - ((hash-table-p table) - (lambda (s v) (funcall pred (concat prefix s)))) - ((functionp table) - (lambda (s) (funcall pred (concat prefix s)))) - (t ;Lists and alists. - (lambda (s) - (funcall pred (concat prefix (if (consp s) (car s) s))))))))) + ;; Predicates are called differently depending on the nature of + ;; the completion table :-( + (cond + ((vectorp table) ;Obarray. + (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) + ((hash-table-p table) + (lambda (s v) (funcall pred (concat prefix s)))) + ((functionp table) + (lambda (s) (funcall pred (concat prefix s)))) + (t ;Lists and alists. + (lambda (s) + (funcall pred (concat prefix (if (consp s) (car s) s)))))))) (if (eq (car-safe action) 'boundaries) (let* ((len (length prefix)) (bound (completion-boundaries string table pred (cdr action)))) @@ -288,11 +286,10 @@ Note: TABLE needs to be a proper completion table which obeys predicates." (t (or (complete-with-action action table string (if (null pred2) pred1 - (lexical-let ((pred1 pred2) (pred2 pred2)) - (lambda (x) - ;; Call `pred1' first, so that `pred2' - ;; really can't tell that `x' is in table. - (if (funcall pred1 x) (funcall pred2 x)))))) + (lambda (x) + ;; Call `pred1' first, so that `pred2' + ;; really can't tell that `x' is in table. + (if (funcall pred1 x) (funcall pred2 x))))) ;; If completion failed and we're not applying pred1 strictly, try ;; again without pred1. (and (not strict) @@ -302,11 +299,10 @@ Note: TABLE needs to be a proper completion table which obeys predicates." "Create a completion table that tries each table in TABLES in turn." ;; FIXME: the boundaries may come from TABLE1 even when the completion list ;; is returned by TABLE2 (because TABLE1 returned an empty list). - (lexical-let ((tables tables)) - (lambda (string pred action) - (completion--some (lambda (table) - (complete-with-action action table string pred)) - tables)))) + (lambda (string pred action) + (completion--some (lambda (table) + (complete-with-action action table string pred)) + tables))) ;; (defmacro complete-in-turn (a b) `(completion-table-in-turn ,a ,b)) ;; (defmacro dynamic-completion-table (fun) `(completion-table-dynamic ,fun)) @@ -548,16 +544,15 @@ E = after completion we now have an Exact match. 101 5 ??? impossible 110 6 some completion happened 111 7 completed to an exact completion" - (lexical-let* - ((beg (field-beginning)) - (end (field-end)) - (string (buffer-substring beg end)) - (comp (funcall (or try-completion-function - 'completion-try-completion) - string - minibuffer-completion-table - minibuffer-completion-predicate - (- (point) beg)))) + (let* ((beg (field-beginning)) + (end (field-end)) + (string (buffer-substring beg end)) + (comp (funcall (or try-completion-function + 'completion-try-completion) + string + minibuffer-completion-table + minibuffer-completion-predicate + (- (point) beg)))) (cond ((null comp) (minibuffer-hide-completions) @@ -572,13 +567,12 @@ E = after completion we now have an Exact match. ;; `completed' should be t if some completion was done, which doesn't ;; include simply changing the case of the entered string. However, ;; for appearance, the string is rewritten if the case changes. - (lexical-let* - ((comp-pos (cdr comp)) - (completion (car comp)) - (completed (not (eq t (compare-strings completion nil nil - string nil nil t)))) - (unchanged (eq t (compare-strings completion nil nil - string nil nil nil)))) + (let* ((comp-pos (cdr comp)) + (completion (car comp)) + (completed (not (eq t (compare-strings completion nil nil + string nil nil t)))) + (unchanged (eq t (compare-strings completion nil nil + string nil nil nil)))) (if unchanged (goto-char end) ;; Insert in minibuffer the chars we got. @@ -759,8 +753,8 @@ If `minibuffer-completion-confirm' is `confirm-after-completion', `minibuffer-confirm-exit-commands', and accept the input otherwise." (interactive) - (lexical-let ((beg (field-beginning)) - (end (field-end))) + (let ((beg (field-beginning)) + (end (field-end))) (cond ;; Allow user to specify null string ((= beg end) (exit-minibuffer)) @@ -1137,14 +1131,14 @@ variables.") "Display a list of possible completions of the current minibuffer contents." (interactive) (message "Making completion list...") - (lexical-let* ((start (field-beginning)) - (end (field-end)) - (string (field-string)) - (completions (completion-all-completions - string - minibuffer-completion-table - minibuffer-completion-predicate - (- (point) (field-beginning))))) + (let* ((start (field-beginning)) + (end (field-end)) + (string (field-string)) + (completions (completion-all-completions + string + minibuffer-completion-table + minibuffer-completion-predicate + (- (point) (field-beginning))))) (message nil) (if (and completions (or (consp (cdr completions)) @@ -1619,8 +1613,8 @@ and `read-file-name-function'." ;; just use `default-directory', but in order to avoid ;; changing `default-directory' in the current buffer, ;; we don't let-bind it. - (lexical-let ((dir (file-name-as-directory - (expand-file-name dir)))) + (let ((dir (file-name-as-directory + (expand-file-name dir)))) (minibuffer-with-setup-hook (lambda () (setq default-directory dir) @@ -1719,7 +1713,7 @@ and `read-file-name-function'." "Perform completion on all buffers excluding BUFFER. BUFFER nil or omitted means use the current buffer. Like `internal-complete-buffer', but removes BUFFER from the completion list." - (lexical-let ((except (if (stringp buffer) buffer (buffer-name buffer)))) + (let ((except (if (stringp buffer) buffer (buffer-name buffer)))) (apply-partially 'completion-table-with-predicate 'internal-complete-buffer (lambda (name) @@ -1791,10 +1785,9 @@ Return the new suffix." (substring afterpoint 0 (cdr bounds))))) (defun completion-basic-try-completion (string table pred point) - (lexical-let* - ((beforepoint (substring string 0 point)) - (afterpoint (substring string point)) - (bounds (completion-boundaries beforepoint table pred afterpoint))) + (let* ((beforepoint (substring string 0 point)) + (afterpoint (substring string point)) + (bounds (completion-boundaries beforepoint table pred afterpoint))) (if (zerop (cdr bounds)) ;; `try-completion' may return a subtly different result ;; than `all+merge', so try to use it whenever possible. @@ -1805,30 +1798,28 @@ Return the new suffix." (concat completion (completion--merge-suffix completion point afterpoint)) (length completion)))) - (lexical-let* - ((suffix (substring afterpoint (cdr bounds))) - (prefix (substring beforepoint 0 (car bounds))) - (pattern (delete - "" (list (substring beforepoint (car bounds)) - 'point - (substring afterpoint 0 (cdr bounds))))) - (all (completion-pcm--all-completions prefix pattern table pred))) + (let* ((suffix (substring afterpoint (cdr bounds))) + (prefix (substring beforepoint 0 (car bounds))) + (pattern (delete + "" (list (substring beforepoint (car bounds)) + 'point + (substring afterpoint 0 (cdr bounds))))) + (all (completion-pcm--all-completions prefix pattern table pred))) (if minibuffer-completing-file-name (setq all (completion-pcm--filename-try-filter all))) (completion-pcm--merge-try pattern all prefix suffix))))) (defun completion-basic-all-completions (string table pred point) - (lexical-let* - ((beforepoint (substring string 0 point)) - (afterpoint (substring string point)) - (bounds (completion-boundaries beforepoint table pred afterpoint)) - (suffix (substring afterpoint (cdr bounds))) - (prefix (substring beforepoint 0 (car bounds))) - (pattern (delete - "" (list (substring beforepoint (car bounds)) - 'point - (substring afterpoint 0 (cdr bounds))))) - (all (completion-pcm--all-completions prefix pattern table pred))) + (let* ((beforepoint (substring string 0 point)) + (afterpoint (substring string point)) + (bounds (completion-boundaries beforepoint table pred afterpoint)) + (suffix (substring afterpoint (cdr bounds))) + (prefix (substring beforepoint 0 (car bounds))) + (pattern (delete + "" (list (substring beforepoint (car bounds)) + 'point + (substring afterpoint 0 (cdr bounds))))) + (all (completion-pcm--all-completions prefix pattern table pred))) (completion-hilit-commonality all point (car bounds)))) ;;; Partial-completion-mode style completion. @@ -1991,13 +1982,12 @@ POINT is a position inside STRING. FILTER is a function applied to the return value, that can be used, e.g. to filter out additional entries (because TABLE migth not obey PRED)." (unless filter (setq filter 'identity)) - (lexical-let* - ((beforepoint (substring string 0 point)) - (afterpoint (substring string point)) - (bounds (completion-boundaries beforepoint table pred afterpoint)) - (prefix (substring beforepoint 0 (car bounds))) - (suffix (substring afterpoint (cdr bounds))) - firsterror) + (let* ((beforepoint (substring string 0 point)) + (afterpoint (substring string point)) + (bounds (completion-boundaries beforepoint table pred afterpoint)) + (prefix (substring beforepoint 0 (car bounds))) + (suffix (substring afterpoint (cdr bounds))) + firsterror) (setq string (substring string (car bounds) (+ point (cdr bounds)))) (let* ((relpoint (- point (car bounds))) (pattern (completion-pcm--string->pattern string relpoint)) From cb9336bd977d3345b86234c36d45228f7fb27eec Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 21 Feb 2011 18:40:54 -0500 Subject: [PATCH 20/45] * lisp/emacs-lisp/cconv.el (cconv-closure-convert-rec): Let the byte compiler choose the representation of closures. (cconv--env-var): Remove. * lisp/emacs-lisp/bytecomp.el (byte-compile--env-var): New var. (byte-compile-make-closure, byte-compile-get-closed-var): New functions. * lisp/cedet/semantic/wisent/comp.el (wisent-byte-compile-grammar): Macroexpand before passing to byte-compile-form. --- lisp/ChangeLog | 9 +++++ lisp/cedet/ChangeLog | 5 +++ lisp/cedet/semantic/wisent/comp.el | 16 ++++++--- lisp/emacs-lisp/bytecomp.el | 18 ++++++++++ lisp/emacs-lisp/cconv.el | 55 +++++++++--------------------- 5 files changed, 60 insertions(+), 43 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4e2e87ab60f..f7a62bc8385 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2011-02-21 Stefan Monnier + + * emacs-lisp/cconv.el (cconv-closure-convert-rec): Let the byte + compiler choose the representation of closures. + (cconv--env-var): Remove. + * emacs-lisp/bytecomp.el (byte-compile--env-var): New var. + (byte-compile-make-closure, byte-compile-get-closed-var): + New functions. + 2011-02-21 Stefan Monnier * subr.el (with-output-to-temp-buffer): New macro. diff --git a/lisp/cedet/ChangeLog b/lisp/cedet/ChangeLog index b6d5cff6b51..fa3f633d1ac 100644 --- a/lisp/cedet/ChangeLog +++ b/lisp/cedet/ChangeLog @@ -1,3 +1,8 @@ +2011-02-21 Stefan Monnier + + * semantic/wisent/comp.el (wisent-byte-compile-grammar): + Macroexpand before passing to byte-compile-form. + 2011-01-13 Stefan Monnier * srecode/srt-mode.el (srecode-template-mode): Use define-derived-mode. diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index c3243c12923..6b473f9ad81 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -3452,15 +3452,13 @@ where: (if (wisent-automaton-p grammar) grammar ;; Grammar already compiled just return it (wisent-with-context compile-grammar - (let* ((gc-cons-threshold 1000000) - automaton) + (let* ((gc-cons-threshold 1000000)) (garbage-collect) (setq wisent-new-log-flag t) ;; Parse input grammar (wisent-parse-grammar grammar start-list) ;; Generate the LALR(1) automaton - (setq automaton (wisent-parser-automaton)) - automaton)))) + (wisent-parser-automaton))))) ;;;; -------------------------- ;;;; Byte compile input grammar @@ -3476,7 +3474,15 @@ Automatically called by the Emacs Lisp byte compiler as a ;; automaton internal data structure. Then, because the internal ;; data structure contains an obarray, convert it to a lisp form so ;; it can be byte-compiled. - (byte-compile-form (wisent-automaton-lisp-form (eval form)))) + (byte-compile-form + ;; FIXME: we macroexpand here since `byte-compile-form' expects + ;; macroexpanded code, but that's just a workaround: for lexical-binding + ;; the lisp form should have to pass through closure-conversion and + ;; `wisent-byte-compile-grammar' is called much too late for that. + ;; Why isn't this `wisent-automaton-lisp-form' performed at + ;; macroexpansion time? --Stef + (macroexpand-all + (wisent-automaton-lisp-form (eval form))))) (put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 8892a27b29c..771306bb0e6 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3339,6 +3339,24 @@ discarding." "Output byte codes to store the top-of-stack value at position STACK-POS in the stack." (byte-compile-out 'byte-stack-set (- byte-compile-depth (1+ stack-pos)))) +(byte-defop-compiler-1 internal-make-closure byte-compile-make-closure) +(byte-defop-compiler-1 internal-get-closed-var byte-compile-get-closed-var) + +(defconst byte-compile--env-var (make-symbol "env")) + +(defun byte-compile-make-closure (form) + ;; FIXME: don't use `curry'! + (byte-compile-form + (unless for-effect + `(curry (function (lambda (,byte-compile--env-var . ,(nth 1 form)) + . ,(nthcdr 3 form))) + (vector . ,(nth 2 form)))) + for-effect)) + +(defun byte-compile-get-closed-var (form) + (byte-compile-form (unless for-effect + `(aref ,byte-compile--env-var ,(nth 1 form))) + for-effect)) ;; Compile a function that accepts one or more args and is right-associative. ;; We do it by left-associativity so that the operations diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 66e5051c2f1..6aa4b7e0a61 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -71,6 +71,8 @@ ;;; Code: ;;; TODO: +;; - canonize code in macro-expand so we don't have to handle (let (var) body) +;; and other oddities. ;; - Change new byte-code representation, so it directly gives the ;; number of mandatory and optional arguments as well as whether or ;; not there's a &rest arg. @@ -229,7 +231,6 @@ Returns a form where all lambdas don't have any free variables." res)) (defconst cconv--dummy-var (make-symbol "ignored")) -(defconst cconv--env-var (make-symbol "env")) (defun cconv--set-diff (s1 s2) "Return elements of set S1 that are not in set S2." @@ -494,32 +495,18 @@ Returns a form where all lambdas don't have any free variables." (envector nil)) (when fv ;; Here we form our environment vector. - ;; If outer closure contains all - ;; free variables of this function(and nothing else) - ;; then we use the same environment vector as for outer closure, - ;; i.e. we leave the environment vector unchanged, - ;; otherwise we build a new environment vector. - (if (eq (length envs) (length fv)) - (let ((fv-temp fv)) - (while (and fv-temp leave) - (when (not (memq (car fv-temp) fvrs-new)) (setq leave nil)) - (setq fv-temp (cdr fv-temp)))) - (setq leave nil)) - (if (not leave) - (progn - (dolist (elm fv) - (push - (cconv-closure-convert-rec - ;; Remove `elm' from `emvrs' for this call because in case - ;; `elm' is a variable that's wrapped in a cons-cell, we - ;; want to put the cons-cell itself in the closure, rather - ;; than just a copy of its current content. - elm (remq elm emvrs) fvrs envs lmenvs) - envector)) ; Process vars for closure vector. - (setq envector (reverse envector)) - (setq envs fv)) - (setq envector `(,cconv--env-var))) ; Leave unchanged. + (dolist (elm fv) + (push + (cconv-closure-convert-rec + ;; Remove `elm' from `emvrs' for this call because in case + ;; `elm' is a variable that's wrapped in a cons-cell, we + ;; want to put the cons-cell itself in the closure, rather + ;; than just a copy of its current content. + elm (remq elm emvrs) fvrs envs lmenvs) + envector)) ; Process vars for closure vector. + (setq envector (reverse envector)) + (setq envs fv) (setq fvrs-new fv)) ; Update substitution list. (setq emvrs (cconv--set-diff emvrs vars)) @@ -546,15 +533,9 @@ Returns a form where all lambdas don't have any free variables." ((null envector) `(function (lambda ,vars . ,body-forms-new))) ; 1 free variable - do not build vector - ((null (cdr envector)) - `(curry - (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new)) - ,(car envector))) - ; >=2 free variables - build vector (t - `(curry - (function (lambda (,cconv--env-var . ,vars) . ,body-forms-new)) - (vector . ,envector)))))) + `(internal-make-closure + ,vars ,envector . ,body-forms-new))))) (`(function . ,_) form) ; Same as quote. @@ -714,10 +695,8 @@ Returns a form where all lambdas don't have any free variables." (let ((free (memq form fvrs))) (if free ;form is a free variable (let* ((numero (- (length fvrs) (length free))) - (var (if (null (cdr envs)) - cconv--env-var - ;; Replace form => (aref env #) - `(aref ,cconv--env-var ,numero)))) + ;; Replace form => (aref env #) + (var `(internal-get-closed-var ,numero))) (if (memq form emvrs) ; form => (car (aref env #)) if mutable `(car ,var) var)) From 876c194cbac17a6220dbf406b0a602325978011c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 24 Feb 2011 22:27:45 -0500 Subject: [PATCH 21/45] Get rid of funvec. * lisp/emacs-lisp/bytecomp.el (byte-compile-lapcode): Handle new form of `byte-constant'. (byte-compile-close-variables, displaying-byte-compile-warnings): Add edebug spec. (byte-compile-toplevel-file-form): New fun, split out of byte-compile-file-form. (byte-compile-from-buffer): Use it to avoid applying cconv multiple times. (byte-compile): Only strip `function' if it's present. (byte-compile-lambda): Add `reserved-csts' argument. Use new lexenv arg of byte-compile-top-level. (byte-compile-reserved-constants): New var. (byte-compile-constants-vector): Obey it. (byte-compile-constants-vector): Handle new `byte-constant' form. (byte-compile-top-level): Add args `lexenv' and `reserved-csts'. (byte-compile-form): Don't check callargs here. (byte-compile-normal-call): Do it here instead. (byte-compile-push-unknown-constant) (byte-compile-resolve-unknown-constant): Remove, unused. (byte-compile-make-closure): Use `make-byte-code' rather than `curry', putting the environment into the "constant" pool. (byte-compile-get-closed-var): Use special byte-constant. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Handle new intermediate special form `internal-make-vector'. (byte-optimize-lapcode): Handle new form of `byte-constant'. * lisp/help-fns.el (describe-function-1): Don't handle funvecs. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Only convert quote to function if the content is a lambda expression, not if it's a closure. * emacs-lisp/eieio-come.el: Remove. * lisp/emacs-lisp/eieio.el: Don't require eieio-comp. (defmethod): Do a bit more work to find the body and wrap it into a function before passing it to eieio-defmethod. (eieio-defmethod): New arg `code' for it. * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Don't hide things in debugger backtrace. * lisp/emacs-lisp/cl-extra.el (cl-macroexpand-all): Use backquotes, and be more careful when quoting a function value. * lisp/emacs-lisp/cconv.el (cconv-freevars): Accept defvar/defconst. (cconv-closure-convert-rec): Catch stray `internal-make-closure'. * lisp/Makefile.in (COMPILE_FIRST): Compile pcase and cconv early. * src/eval.c (Qcurry): Remove. (funcall_funvec): Remove. (funcall_lambda): Move new byte-code handling to reduce impact. Treat all args as lexical in the case of lexbind. (Fcurry): Remove. * src/data.c (Qfunction_vector): Remove. (Ffunvecp): Remove. * src/lread.c (read1): Revert to calling make_byte_code here. (read_vector): Don't call make_byte_code any more. * src/lisp.h (enum pvec_type): Rename back to PVEC_COMPILED. (XSETCOMPILED): Rename back from XSETFUNVEC. (FUNVEC_SIZE): Remove. (FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): Remove. (COMPILEDP): Rename back from FUNVECP. * src/fns.c (Felt): Remove unexplained FUNVEC check. * src/doc.c (Fdocumentation): Don't handle funvec. * src/alloc.c (make_funvec, Ffunvec): Remove. * doc/lispref/vol2.texi (Top): * doc/lispref/vol1.texi (Top): * doc/lispref/objects.texi (Programming Types, Funvec Type, Type Predicates): * doc/lispref/functions.texi (Functions, What Is a Function, FunctionCurrying): * doc/lispref/elisp.texi (Top): Remove mentions of funvec and curry. --- .dir-locals.el | 2 +- doc/lispref/ChangeLog | 8 ++ doc/lispref/elisp.texi | 4 +- doc/lispref/functions.texi | 70 +--------------- doc/lispref/objects.texi | 61 +++----------- doc/lispref/vol1.texi | 2 +- doc/lispref/vol2.texi | 2 +- etc/NEWS.lexbind | 21 ++--- lisp/ChangeLog | 43 ++++++++++ lisp/Makefile.in | 6 +- lisp/emacs-lisp/byte-opt.el | 47 +++++++---- lisp/emacs-lisp/bytecomp.el | 138 ++++++++++++++++--------------- lisp/emacs-lisp/cconv.el | 43 ++++------ lisp/emacs-lisp/cl-extra.el | 24 ++---- lisp/emacs-lisp/cl-loaddefs.el | 2 +- lisp/emacs-lisp/debug.el | 5 +- lisp/emacs-lisp/eieio-comp.el | 145 --------------------------------- lisp/emacs-lisp/eieio.el | 43 +++++++--- lisp/emacs-lisp/macroexp.el | 5 +- lisp/help-fns.el | 22 ----- src/ChangeLog | 56 +++++++++++++ src/ChangeLog.funvec | 37 --------- src/alloc.c | 71 ++-------------- src/bytecode.c | 9 +- src/data.c | 25 ++---- src/doc.c | 5 -- src/eval.c | 133 ++++++------------------------ src/fns.c | 25 +++--- src/image.c | 3 +- src/keyboard.c | 2 +- src/lisp.h | 33 ++------ src/lread.c | 33 +++----- src/print.c | 6 +- 33 files changed, 379 insertions(+), 752 deletions(-) delete mode 100644 lisp/emacs-lisp/eieio-comp.el delete mode 100644 src/ChangeLog.funvec diff --git a/.dir-locals.el b/.dir-locals.el index f098f3e7460..86410cc8f40 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,6 +1,6 @@ ((nil . ((tab-width . 8) (sentence-end-double-space . t) - (fill-column . 70))) + (fill-column . 79))) (c-mode . ((c-file-style . "GNU"))) ;; You must set bugtracker_debbugs_url in your bazaar.conf for this to work. ;; See admin/notes/bugtracker. diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 90eed004d39..c5e445cec38 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,11 @@ +2011-02-25 Stefan Monnier + + * vol2.texi (Top): + * vol1.texi (Top): + * objects.texi (Programming Types, Funvec Type, Type Predicates): + * functions.texi (Functions, What Is a Function, Function Currying): + * elisp.texi (Top): Remove mentions of funvec and curry. + 2011-02-19 Eli Zaretskii * elisp.texi: Sync @dircategory with ../../info/dir. diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index 8e3498b8b6f..f7c1d55f6ae 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -249,7 +249,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. -* Funvec Type:: A vector type callable as a function. +* Byte-Code Type:: A function written in Lisp, then compiled. * Autoload Type:: A type used for automatically loading seldom-used functions. @@ -464,8 +464,6 @@ 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. diff --git a/doc/lispref/functions.texi b/doc/lispref/functions.texi index fc56e806cf7..974487382c8 100644 --- a/doc/lispref/functions.texi +++ b/doc/lispref/functions.texi @@ -23,8 +23,6 @@ define them. of a symbol. * Obsolete Functions:: Declaring functions obsolete. * 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 @@ -113,25 +111,7 @@ 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. 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 - +byte compiler. @xref{Byte-Code Type}. @end table @defun functionp object @@ -172,11 +152,6 @@ 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 @@ -1302,49 +1277,6 @@ 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 a20c50b63d6..c58d54f13fc 100644 --- a/doc/lispref/objects.texi +++ b/doc/lispref/objects.texi @@ -156,7 +156,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. -* Funvec Type:: A vector type callable as a function. +* Byte-Code Type:: A function written in Lisp, then compiled. * Autoload Type:: A type used for automatically loading seldom-used functions. @end menu @@ -1313,55 +1313,18 @@ with the name of the subroutine. @end group @end example -@node Funvec Type -@subsection ``Function Vector' Type -@cindex function vector -@cindex funvec +@node Byte-Code Type +@subsection Byte-Code Function Type -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 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. -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 +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{[}. @node Autoload Type @subsection Autoload Type @@ -1808,7 +1771,7 @@ with references to further information. @xref{Buffer Basics, bufferp}. @item byte-code-function-p -@xref{Funvec Type, byte-code-function-p}. +@xref{Byte-Code 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 33671623b51..ad8ff0819ca 100644 --- a/doc/lispref/vol1.texi +++ b/doc/lispref/vol1.texi @@ -269,7 +269,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. -* Funvec Type:: A vector type callable as a function. +* Byte-Code Type:: A function written in Lisp, then compiled. * Autoload Type:: A type used for automatically loading seldom-used functions. diff --git a/doc/lispref/vol2.texi b/doc/lispref/vol2.texi index 8e5c4b2ef8f..7832b3a8614 100644 --- a/doc/lispref/vol2.texi +++ b/doc/lispref/vol2.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. -* Funvec Type:: A vector type callable as a function. +* Byte-Code Type:: A function written in Lisp, then compiled. * Autoload Type:: A type used for automatically loading seldom-used functions. diff --git a/etc/NEWS.lexbind b/etc/NEWS.lexbind index 372ee6827cf..bcb56c313f8 100644 --- a/etc/NEWS.lexbind +++ b/etc/NEWS.lexbind @@ -1,6 +1,6 @@ GNU Emacs NEWS -- history of user-visible changes. -Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007 +Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2011 Free Software Foundation, Inc. See the end of the file for license conditions. @@ -12,21 +12,12 @@ 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 - +** The `lexical-binding' lets code use lexical scoping for local variables. +It is typically set via file-local variables, in which case it applies to +all the code in that file. +** Lexically scoped interpreted functions are represented with a new form +of function value which looks like (closure ENV lambda ARGS &rest BODY). ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index f7a62bc8385..ee6944d8e07 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,46 @@ +2011-02-25 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-lapcode): Handle new form of + `byte-constant'. + (byte-compile-close-variables, displaying-byte-compile-warnings): + Add edebug spec. + (byte-compile-toplevel-file-form): New fun, split out of + byte-compile-file-form. + (byte-compile-from-buffer): Use it to avoid applying cconv + multiple times. + (byte-compile): Only strip `function' if it's present. + (byte-compile-lambda): Add `reserved-csts' argument. + Use new lexenv arg of byte-compile-top-level. + (byte-compile-reserved-constants): New var. + (byte-compile-constants-vector): Obey it. + (byte-compile-constants-vector): Handle new `byte-constant' form. + (byte-compile-top-level): Add args `lexenv' and `reserved-csts'. + (byte-compile-form): Don't check callargs here. + (byte-compile-normal-call): Do it here instead. + (byte-compile-push-unknown-constant) + (byte-compile-resolve-unknown-constant): Remove, unused. + (byte-compile-make-closure): Use `make-byte-code' rather than `curry', + putting the environment into the "constant" pool. + (byte-compile-get-closed-var): Use special byte-constant. + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Handle new + intermediate special form `internal-make-vector'. + (byte-optimize-lapcode): Handle new form of `byte-constant'. + * help-fns.el (describe-function-1): Don't handle funvecs. + * emacs-lisp/macroexp.el (macroexpand-all-1): Only convert quote to + function if the content is a lambda expression, not if it's a closure. + * emacs-lisp/eieio-come.el: Remove. + * emacs-lisp/eieio.el: Don't require eieio-comp. + (defmethod): Do a bit more work to find the body and wrap it into + a function before passing it to eieio-defmethod. + (eieio-defmethod): New arg `code' for it. + * emacs-lisp/debug.el (debugger-setup-buffer): Don't hide things in + debugger backtrace. + * emacs-lisp/cl-extra.el (cl-macroexpand-all): Use backquotes, and be + more careful when quoting a function value. + * emacs-lisp/cconv.el (cconv-freevars): Accept defvar/defconst. + (cconv-closure-convert-rec): Catch stray `internal-make-closure'. + * Makefile.in (COMPILE_FIRST): Compile pcase and cconv early. + 2011-02-21 Stefan Monnier * emacs-lisp/cconv.el (cconv-closure-convert-rec): Let the byte diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 6e28c3f9df8..389d5b154aa 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -83,7 +83,9 @@ BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" COMPILE_FIRST = \ $(lisp)/emacs-lisp/bytecomp.elc \ $(lisp)/emacs-lisp/byte-opt.elc \ + $(lisp)/emacs-lisp/pcase.elc \ $(lisp)/emacs-lisp/macroexp.elc \ + $(lisp)/emacs-lisp/cconv.elc \ $(lisp)/emacs-lisp/autoload.elc # The actual Emacs command run in the targets below. @@ -203,7 +205,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.el -f byte-compile-refresh-preloaded \ + $(emacs) -l bytecomp.el -f byte-compile-refresh-preloaded \ $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ -f batch-byte-compile $(THEFILE) @@ -220,7 +222,7 @@ compile-onefile: # cannot have prerequisites. .el.elc: @echo Compiling $< - @$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ + $(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ -f batch-byte-compile $< .PHONY: compile-first compile-main compile compile-always diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index c9cc4618967..342dd8b71d1 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -531,7 +531,11 @@ ;; However, don't actually bother calling `ignore'. `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form)))) + ((eq fn 'internal-make-closure) + form) + ((not (symbolp fn)) + (debug) (byte-compile-warn "`%s' is a malformed function" (prin1-to-string fn)) form) @@ -1472,7 +1476,8 @@ 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-stack-ref)) + byte-current-buffer byte-stack-ref ;; byte-closed-var + )) (defconst byte-compile-side-effect-free-ops (nconc @@ -1680,11 +1685,18 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; const goto-if-* --> whatever ;; ((and (eq 'byte-constant (car lap0)) - (memq (car lap1) byte-conditional-ops)) + (memq (car lap1) byte-conditional-ops) + ;; If the `byte-constant's cdr is not a cons cell, it has + ;; to be an index into the constant pool); even though + ;; it'll be a constant, that constant is not known yet + ;; (it's typically a free variable of a closure, so will + ;; only be known when the closure will be built at + ;; run-time). + (consp (cdr lap0))) (cond ((if (or (eq (car lap1) 'byte-goto-if-nil) - (eq (car lap1) 'byte-goto-if-nil-else-pop)) - (car (cdr lap0)) - (not (car (cdr lap0)))) + (eq (car lap1) 'byte-goto-if-nil-else-pop)) + (car (cdr lap0)) + (not (car (cdr lap0)))) (byte-compile-log-lap " %s %s\t-->\t" lap0 lap1) (setq rest (cdr rest) @@ -1696,11 +1708,11 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (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)) ;; ;; varref-X varref-X --> varref-X dup ;; varref-X [dup ...] varref-X --> varref-X [dup ...] dup - ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup + ;; stackref-X [dup ...] stackref-X+N --> stackref-X [dup ...] dup ;; We don't optimize the const-X variations on this here, ;; because that would inhibit some goto optimizations; we ;; optimize the const-X case after all other optimizations. @@ -1877,18 +1889,21 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (cons 'byte-discard byte-conditional-ops))) (not (eq lap1 (car tmp)))) (setq tmp2 (car tmp)) - (cond ((memq (car tmp2) - (if (null (car (cdr lap0))) - '(byte-goto-if-nil byte-goto-if-nil-else-pop) - '(byte-goto-if-not-nil - byte-goto-if-not-nil-else-pop))) + (cond ((when (consp (cdr lap0)) + (memq (car tmp2) + (if (null (car (cdr lap0))) + '(byte-goto-if-nil byte-goto-if-nil-else-pop) + '(byte-goto-if-not-nil + byte-goto-if-not-nil-else-pop)))) (byte-compile-log-lap " %s goto [%s]\t-->\t%s %s" lap0 tmp2 lap0 tmp2) (setcar lap1 (car tmp2)) (setcdr lap1 (cdr tmp2)) ;; Let next step fix the (const,goto-if*) sequence. - (setq rest (cons nil rest))) - (t + (setq rest (cons nil rest)) + (setq keep-going t)) + ((or (consp (cdr lap0)) + (eq (car tmp2) 'byte-discard)) ;; Jump one step further (byte-compile-log-lap " %s goto [%s]\t-->\t goto " @@ -1897,8 +1912,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setcdr tmp (cons (byte-compile-make-tag) (cdr tmp)))) (setcdr lap1 (car (cdr tmp))) - (setq lap (delq lap0 lap)))) - (setq keep-going t)) + (setq lap (delq lap0 lap)) + (setq keep-going t)))) ;; ;; X: varref-Y ... varset-Y goto-X --> ;; X: varref-Y Z: ... dup varset-Y goto-Z diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 771306bb0e6..6bc2b3b5617 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -794,10 +794,13 @@ CONST2 may be evaulated multiple times." ;; 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))) + ((or (and (consp off) + ;; Variable or constant reference + (progn + (setq off (cdr off)) + (eq op 'byte-constant))) + (and (eq op 'byte-constant) ;; 'byte-closed-var + (integerp off))) ;; constant ref (if (< off byte-constant-limit) (byte-compile-push-bytecodes (+ byte-constant off) @@ -1480,6 +1483,7 @@ symbol itself." ((byte-compile-const-symbol-p ,form)))) (defmacro byte-compile-close-variables (&rest body) + (declare (debug t)) (cons 'let (cons '(;; ;; Close over these variables to encapsulate the @@ -1510,6 +1514,7 @@ symbol itself." body))) (defmacro displaying-byte-compile-warnings (&rest body) + (declare (debug t)) `(let* ((--displaying-byte-compile-warnings-fn (lambda () ,@body)) (warning-series-started (and (markerp warning-series) @@ -1930,7 +1935,7 @@ With argument ARG, insert value in current buffer after the form." (byte-compile-warn "!! The file uses old-style backquotes !! This functionality has been obsolete for more than 10 years already and will be removed soon. See (elisp)Backquote in the manual.")) - (byte-compile-file-form form))) + (byte-compile-toplevel-file-form form))) ;; Compile pending forms at end of file. (byte-compile-flush-pending) ;; Make warnings about unresolved functions @@ -2041,8 +2046,8 @@ Call from the source buffer." ;; defalias calls are output directly by byte-compile-file-form-defmumble; ;; it does not pay to first build the defalias in defmumble and then parse ;; it here. - (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst autoload - custom-declare-variable)) + (if (and (memq (car-safe form) '(defun defmacro defvar defvaralias defconst + autoload custom-declare-variable)) (stringp (nth 3 form))) (byte-compile-output-docform nil nil '("\n(" 3 ")") form nil (memq (car form) @@ -2182,12 +2187,17 @@ list that represents a doc string reference. byte-compile-maxdepth 0 byte-compile-output nil)))) -(defun byte-compile-file-form (form) - (let ((byte-compile-current-form nil) ; close over this for warnings. - bytecomp-handler) +;; byte-hunk-handlers cannot call this! +(defun byte-compile-toplevel-file-form (form) + (let ((byte-compile-current-form nil)) ; close over this for warnings. (setq form (macroexpand-all form byte-compile-macro-environment)) (if lexical-binding (setq form (cconv-closure-convert form))) + (byte-compile-file-form form))) + +;; byte-hunk-handlers can call this. +(defun byte-compile-file-form (form) + (let (bytecomp-handler) (cond ((not (consp form)) (byte-compile-keep-pending form)) ((and (symbolp (car form)) @@ -2541,7 +2551,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (if lexical-binding (setq fun (cconv-closure-convert fun))) ;; Get rid of the `function' quote added by the `lambda' macro. - (setq fun (cadr fun)) + (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) (setq fun (if macro (cons 'macro (byte-compile-lambda fun)) (byte-compile-lambda fun))) @@ -2654,7 +2664,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; of the list FUN and `byte-compile-set-symbol-position' is not called. ;; Use this feature to avoid calling `byte-compile-set-symbol-position' ;; for symbols generated by the byte compiler itself. -(defun byte-compile-lambda (bytecomp-fun &optional add-lambda) +(defun byte-compile-lambda (bytecomp-fun &optional add-lambda reserved-csts) (if add-lambda (setq bytecomp-fun (cons 'lambda bytecomp-fun)) (unless (eq 'lambda (car-safe bytecomp-fun)) @@ -2702,14 +2712,16 @@ 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* ((byte-compile-lexical-environment - ;; If doing lexical binding, push a new lexical environment - ;; containing just the args (since lambda expressions - ;; should be closed by now). - (and lexical-binding - (byte-compile-make-lambda-lexenv bytecomp-fun))) - (compiled - (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda))) + (let* ((compiled + (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda + ;; If doing lexical binding, push a new + ;; lexical environment containing just the + ;; args (since lambda expressions should be + ;; closed by now). + (and lexical-binding + (byte-compile-make-lambda-lexenv + bytecomp-fun)) + reserved-csts))) ;; Build the actual byte-coded function. (if (eq 'byte-code (car-safe compiled)) (apply 'make-byte-code @@ -2740,6 +2752,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; A simple lambda is just a constant. (byte-compile-constant code))) +(defvar byte-compile-reserved-constants 0) + (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). @@ -2748,7 +2762,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; Next up to byte-constant-limit are constants, still with one-byte codes. ;; Next variables again, to get 2-byte codes for variable lookup. ;; The rest of the constants and variables need 3-byte byte-codes. - (let* ((i -1) + (let* ((i (1- byte-compile-reserved-constants)) (rest (nreverse byte-compile-variables)) ; nreverse because the first (other (nreverse byte-compile-constants)) ; vars often are used most. ret tmp @@ -2759,11 +2773,15 @@ If FORM is a lambda or a macro, byte-compile it as a function." limit) (while (or rest other) (setq limit (car limits)) - (while (and rest (not (eq i limit))) - (if (setq tmp (assq (car (car rest)) ret)) - (setcdr (car rest) (cdr tmp)) + (while (and rest (< i limit)) + (cond + ((numberp (car rest)) + (assert (< (car rest) byte-compile-reserved-constants))) + ((setq tmp (assq (car (car rest)) ret)) + (setcdr (car rest) (cdr tmp))) + (t (setcdr (car rest) (setq i (1+ i))) - (setq ret (cons (car rest) ret))) + (setq ret (cons (car rest) ret)))) (setq rest (cdr rest))) (setq limits (cdr limits) rest (prog1 other @@ -2772,7 +2790,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; Given an expression FORM, compile it and return an equivalent byte-code ;; expression (a call to the function byte-code). -(defun byte-compile-top-level (form &optional for-effect output-type) +(defun byte-compile-top-level (form &optional for-effect output-type + lexenv reserved-csts) ;; OUTPUT-TYPE advises about how form is expected to be used: ;; 'eval or nil -> a single form, ;; 'progn or t -> a list of forms, @@ -2783,9 +2802,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-tag-number 0) (byte-compile-depth 0) (byte-compile-maxdepth 0) - (byte-compile-lexical-environment - (when (eq output-type 'lambda) - byte-compile-lexical-environment)) + (byte-compile-lexical-environment lexenv) + (byte-compile-reserved-constants (or reserved-csts 0)) (byte-compile-output nil)) (if (memq byte-optimize '(t source)) (setq form (byte-optimize-form form for-effect))) @@ -2904,6 +2922,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (bytecomp-body (list bytecomp-body)))) +;; FIXME: Like defsubst's, this hunk-handler won't be called any more +;; because the macro is expanded away before we see it. (put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function) (defun byte-compile-declare-function (form) (push (cons (nth 1 form) @@ -2950,12 +2970,6 @@ If FORM is a lambda or a macro, byte-compile it as a function." (memq bytecomp-fn byte-compile-interactive-only-functions) (byte-compile-warn "`%s' used from Lisp code\n\ That command is designed for interactive use only" bytecomp-fn)) - (when (byte-compile-warning-enabled-p 'callargs) - (if (memq bytecomp-fn - '(custom-declare-group custom-declare-variable - custom-declare-face)) - (byte-compile-nogroup-warn form)) - (byte-compile-callargs-warn form)) (if (and (fboundp (car form)) (eq (car-safe (symbol-function (car form))) 'macro)) (byte-compile-report-error @@ -2985,6 +2999,13 @@ That command is designed for interactive use only" bytecomp-fn)) (byte-compile-discard))) (defun byte-compile-normal-call (form) + (when (and (byte-compile-warning-enabled-p 'callargs) + (symbolp (car form))) + (if (memq (car form) + '(custom-declare-group custom-declare-variable + custom-declare-face)) + (byte-compile-nogroup-warn form)) + (byte-compile-callargs-warn form)) (if byte-compile-generate-call-tree (byte-compile-annotate-call-tree form)) (when (and for-effect (eq (car form) 'mapcar) @@ -3037,7 +3058,7 @@ If BINDING is non-nil, VAR is being bound." (boundp var) (memq var byte-compile-bound-variables) (memq var byte-compile-free-references)) - (byte-compile-warn "reference to free variable `%s'" var) + (byte-compile-warn "reference to free variable `%S'" var) (push var byte-compile-free-references)) (byte-compile-dynamic-variable-op 'byte-varref var)))) @@ -3082,26 +3103,6 @@ If BINDING is non-nil, VAR is being bound." (defun byte-compile-push-constant (const) (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. @@ -3345,18 +3346,23 @@ discarding." (defconst byte-compile--env-var (make-symbol "env")) (defun byte-compile-make-closure (form) - ;; FIXME: don't use `curry'! - (byte-compile-form - (unless for-effect - `(curry (function (lambda (,byte-compile--env-var . ,(nth 1 form)) - . ,(nthcdr 3 form))) - (vector . ,(nth 2 form)))) - for-effect)) + (if for-effect (setq for-effect nil) + (let* ((vars (nth 1 form)) + (env (nth 2 form)) + (body (nthcdr 3 form)) + (fun + (byte-compile-lambda `(lambda ,vars . ,body) nil (length env)))) + (assert (byte-code-function-p fun)) + (byte-compile-form `(make-byte-code + ',(aref fun 0) ',(aref fun 1) + (vconcat (vector . ,env) ',(aref fun 2)) + ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun))))))) + (defun byte-compile-get-closed-var (form) - (byte-compile-form (unless for-effect - `(aref ,byte-compile--env-var ,(nth 1 form))) - for-effect)) + (if for-effect (setq for-effect nil) + (byte-compile-out 'byte-constant ;; byte-closed-var + (nth 1 form)))) ;; Compile a function that accepts one or more args and is right-associative. ;; We do it by left-associativity so that the operations diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 6aa4b7e0a61..bc7ecb1ad55 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -47,19 +47,14 @@ ;; (lambda (v1 ...) ... fv1 fv2 ...) => (lambda (v1 ... fv1 fv2 ) ... fv1 fv2 .) ;; if the function is suitable for lambda lifting (if all calls are known) ;; -;; (lambda (v1 ...) ... fv ...) => -;; (curry (lambda (env v1 ...) ... env ...) env) -;; if the function has only 1 free variable -;; -;; and finally -;; (lambda (v1 ...) ... fv1 fv2 ...) => -;; (curry (lambda (env v1 ..) .. (aref env 0) (aref env 1) ..) (vector fv1 fv2)) -;; if the function has 2 or more free variables. +;; (lambda (v0 ...) ... fv0 .. fv1 ...) => +;; (internal-make-closure (v0 ...) (fv1 ...) +;; ... (internal-get-closed-var 0) ... (internal-get-closed-var 1) ...) ;; ;; If the function has no free variables, we don't do anything. ;; ;; If a variable is mutated (updated by setq), and it is used in a closure -;; we wrap it's definition with list: (list val) and we also replace +;; we wrap its definition with list: (list val) and we also replace ;; var => (car var) wherever this variable is used, and also ;; (setq var value) => (setcar var value) where it is updated. ;; @@ -71,15 +66,12 @@ ;;; Code: ;;; TODO: +;; - pay attention to `interactive': its arg is run in an empty env. ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. ;; - Change new byte-code representation, so it directly gives the ;; number of mandatory and optional arguments as well as whether or ;; not there's a &rest arg. -;; - Use abstract `make-closure' and `closure-ref' expressions, which bytecomp -;; should turn into building corresponding byte-code function. -;; - don't use `curry', instead build a new compiled-byte-code object -;; (merge the closure env into the static constants pool). ;; - warn about unused lexical vars. ;; - clean up cconv-closure-convert-rec, especially the `let' binding part. ;; - new byte codes for unwind-protect, catch, and condition-case so that @@ -184,8 +176,8 @@ Returns a list of free variables." ;; We call cconv-freevars only for functions(lambdas) ;; defun, defconst, defvar are not allowed to be inside ;; a function (lambda). - ;; FIXME: should be a byte-compile-report-error! - (error "Invalid form: %s inside a function" sym)) + ;; (error "Invalid form: %s inside a function" sym) + (cconv-freevars `(progn ,@(cddr form)) fvrs)) (`(,_ . ,body-forms) ; First element is (like) a function. (dolist (exp body-forms) @@ -537,6 +529,9 @@ Returns a form where all lambdas don't have any free variables." `(internal-make-closure ,vars ,envector . ,body-forms-new))))) + (`(internal-make-closure . ,_) + (error "Internal byte-compiler error: cconv called twice")) + (`(function . ,_) form) ; Same as quote. ;defconst, defvar @@ -599,20 +594,18 @@ Returns a form where all lambdas don't have any free variables." ;condition-case (`(condition-case ,var ,protected-form . ,handlers) - (let ((handlers-new '()) - (newform (cconv-closure-convert-rec + (let ((newform (cconv-closure-convert-rec `(function (lambda () ,protected-form)) emvrs fvrs envs lmenvs))) (setq fvrs (remq var fvrs)) - (dolist (handler handlers) - (push (list (car handler) - (cconv-closure-convert-rec - `(function (lambda (,(or var cconv--dummy-var)) - ,@(cdr handler))) - emvrs fvrs envs lmenvs)) - handlers-new)) `(condition-case :fun-body ,newform - ,@(nreverse handlers-new)))) + ,@(mapcar (lambda (handler) + (list (car handler) + (cconv-closure-convert-rec + (let ((arg (or var cconv--dummy-var))) + `(function (lambda (,arg) ,@(cdr handler)))) + emvrs fvrs envs lmenvs))) + handlers)))) (`(,(and head (or `catch `unwind-protect)) ,form . ,body) `(,head ,(cconv-closure-convert-rec form emvrs fvrs envs lmenvs) diff --git a/lisp/emacs-lisp/cl-extra.el b/lisp/emacs-lisp/cl-extra.el index 12dafe274b9..7468a0237cf 100644 --- a/lisp/emacs-lisp/cl-extra.el +++ b/lisp/emacs-lisp/cl-extra.el @@ -766,21 +766,15 @@ This also does some trivial optimizations to make the form prettier." (eq (car-safe (car body)) 'interactive)) (push (list 'quote (pop body)) decls)) (put (car (last cl-closure-vars)) 'used t) - (append - (list 'list '(quote lambda) '(quote (&rest --cl-rest--))) - (sublis sub (nreverse decls)) - (list - (list* 'list '(quote apply) - (list 'quote - (list 'function - (list* 'lambda - (append new (cadadr form)) - (sublis sub body)))) - (nconc (mapcar (function - (lambda (x) - (list 'list '(quote quote) x))) - cl-closure-vars) - '((quote --cl-rest--))))))) + `(list 'lambda '(&rest --cl-rest--) + ,@(sublis sub (nreverse decls)) + (list 'apply + (list 'quote + #'(lambda ,(append new (cadadr form)) + ,@(sublis sub body))) + ,@(nconc (mapcar (lambda (x) `(list 'quote ,x)) + cl-closure-vars) + '((quote --cl-rest--)))))) (list (car form) (list* 'lambda (cadadr form) body)))) (let ((found (assq (cadr form) env))) (if (and found (ignore-errors diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index bd50c75bcc3..df9460154e8 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -10,7 +10,7 @@ ;;;;;; ceiling* floor* isqrt lcm gcd cl-progv-before cl-set-frame-visible-p ;;;;;; cl-map-overlays cl-map-intervals cl-map-keymap-recursively ;;;;;; notevery notany every some mapcon mapcan mapl maplist map -;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "2bfbae6523c842d511b8c8d88658825a") +;;;;;; cl-mapcar-many equalp coerce) "cl-extra" "cl-extra.el" "26339d9571f9485bf34fa6d2ae38fc84") ;;; Generated autoloads from cl-extra.el (autoload 'coerce "cl-extra" "\ diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 88633eaaa46..0b2ea81fb64 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -269,8 +269,9 @@ That buffer should be current already." (setq buffer-undo-list t) (let ((standard-output (current-buffer)) (print-escape-newlines t) - (print-level 8) - (print-length 50)) + (print-level 1000) ;8 + ;; (print-length 50) + ) (backtrace)) (goto-char (point-min)) (delete-region (point) diff --git a/lisp/emacs-lisp/eieio-comp.el b/lisp/emacs-lisp/eieio-comp.el deleted file mode 100644 index 244c4318425..00000000000 --- a/lisp/emacs-lisp/eieio-comp.el +++ /dev/null @@ -1,145 +0,0 @@ -;;; eieio-comp.el -- eieio routines to help with byte compilation - -;; Copyright (C) 1995-1996, 1998-2002, 2005, 2008-2011 -;; Free Software Foundation, Inc. - -;; Author: Eric M. Ludlam -;; Version: 0.2 -;; Keywords: lisp, tools -;; Package: eieio - -;; 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 3 of the License, 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. If not, see . - -;;; Commentary: - -;; Byte compiler functions for defmethod. This will affect the new GNU -;; byte compiler for Emacs 19 and better. This function will be called by -;; the byte compiler whenever a `defmethod' is encountered in a file. -;; It will output a function call to `eieio-defmethod' with the byte -;; compiled function as a parameter. - -;;; Code: - -(declare-function eieio-defgeneric-form "eieio" (method doc-string)) - -;; Some compatibility stuff -(eval-and-compile - (if (not (fboundp 'byte-compile-compiled-obj-to-list)) - (defun byte-compile-compiled-obj-to-list (moose) nil)) - - (if (not (boundp 'byte-compile-outbuffer)) - (defvar byte-compile-outbuffer nil)) - ) - -;; This teaches the byte compiler how to do this sort of thing. -(put 'defmethod 'byte-hunk-handler 'eieio-byte-compile-file-form-defmethod) - -(defun eieio-byte-compile-file-form-defmethod (form) - "Mumble about the method we are compiling. -This function is mostly ripped from `byte-compile-file-form-defun', -but it's been modified to handle the special syntax of the `defmethod' -command. There should probably be one for `defgeneric' as well, but -that is called but rarely. Argument FORM is the body of the method." - (setq form (cdr form)) - (let* ((meth (car form)) - (key (progn (setq form (cdr form)) - (cond ((or (eq ':BEFORE (car form)) - (eq ':before (car form))) - (setq form (cdr form)) - ":before ") - ((or (eq ':AFTER (car form)) - (eq ':after (car form))) - (setq form (cdr form)) - ":after ") - ((or (eq ':PRIMARY (car form)) - (eq ':primary (car form))) - (setq form (cdr form)) - ":primary ") - ((or (eq ':STATIC (car form)) - (eq ':static (car form))) - (setq form (cdr form)) - ":static ") - (t "")))) - (params (car form)) - (lamparams (eieio-byte-compile-defmethod-param-convert params)) - (arg1 (car params)) - (class (if (listp arg1) (nth 1 arg1) nil)) - (my-outbuffer (if (eval-when-compile (featurep 'xemacs)) - byte-compile-outbuffer - (cond ((boundp 'bytecomp-outbuffer) - bytecomp-outbuffer) ; Emacs >= 23.2 - ((boundp 'outbuffer) outbuffer) - (t (error "Unable to set outbuffer")))))) - (let ((name (format "%s::%s" (or class "#") meth))) - (if byte-compile-verbose - ;; #### filename used free - (message "Compiling %s... (%s)" - (cond ((boundp 'bytecomp-filename) bytecomp-filename) - ((boundp 'filename) filename) - (t "")) - name)) - (setq byte-compile-current-form name) ; for warnings - ) - ;; Flush any pending output - (byte-compile-flush-pending) - ;; Byte compile the body. For the byte compiled forms, add the - ;; rest arguments, which will get ignored by the engine which will - ;; add them later (I hope) - ;; FIXME: This relies on compiler's internal. Make sure it still - ;; works with lexical-binding code. Maybe calling `byte-compile' - ;; would be preferable. - (let* ((new-one (byte-compile-lambda - (append (list 'lambda lamparams) - (cdr form)))) - (code (byte-compile-byte-code-maker new-one))) - (princ "\n(eieio-defmethod '" my-outbuffer) - (princ meth my-outbuffer) - (princ " '(" my-outbuffer) - (princ key my-outbuffer) - (prin1 params my-outbuffer) - (princ " " my-outbuffer) - (prin1 code my-outbuffer) - (princ "))" my-outbuffer) - ) - ;; Now add this function to the list of known functions. - ;; Don't bother with a doc string. Not relevant here. - (add-to-list 'byte-compile-function-environment - (cons meth - (eieio-defgeneric-form meth ""))) - - ;; Remove it from the undefined list if it is there. - (let ((elt (assq meth byte-compile-unresolved-functions))) - (if elt (setq byte-compile-unresolved-functions - (delq elt byte-compile-unresolved-functions)))) - - ;; nil prevents cruft from appearing in the output buffer. - nil)) - -(defun eieio-byte-compile-defmethod-param-convert (paramlist) - "Convert method params into the params used by the `defmethod' thingy. -Argument PARAMLIST is the parameter list to convert." - (let ((argfix nil)) - (while paramlist - (setq argfix (cons (if (listp (car paramlist)) - (car (car paramlist)) - (car paramlist)) - argfix)) - (setq paramlist (cdr paramlist))) - (nreverse argfix))) - -(provide 'eieio-comp) - -;;; eieio-comp.el ends here diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index bd768dbdb9f..4e443452d8b 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -45,8 +45,7 @@ ;;; Code: (eval-when-compile - (require 'cl) - (require 'eieio-comp)) + (require 'cl)) (defvar eieio-version "1.3" "Current version of EIEIO.") @@ -123,6 +122,7 @@ execute a `call-next-method'. DO NOT SET THIS YOURSELF!") ;; while it is being built itself. (defvar eieio-default-superclass nil) +;; FIXME: The constants below should have a `eieio-' prefix added!! (defconst class-symbol 1 "Class's symbol (self-referencing.).") (defconst class-parent 2 "Class parent slot.") (defconst class-children 3 "Class children class slot.") @@ -181,10 +181,6 @@ Stored outright without modifications or stripping.") (t key) ;; already generic.. maybe. )) -;; How to specialty compile stuff. -(autoload 'eieio-byte-compile-file-form-defmethod "eieio-comp" - "This function is used to byte compile methods in a nice way.") -(put 'defmethod 'byte-hunk-handler 'eieio-byte-compile-file-form-defmethod) ;;; Important macros used in eieio. ;; @@ -1293,9 +1289,35 @@ Summary: ((typearg class-name) arg2 &optional opt &rest rest) \"doc-string\" body)" - `(eieio-defmethod (quote ,method) (quote ,args))) + (let* ((key (cond ((or (eq ':BEFORE (car args)) + (eq ':before (car args))) + (setq args (cdr args)) + :before) + ((or (eq ':AFTER (car args)) + (eq ':after (car args))) + (setq args (cdr args)) + :after) + ((or (eq ':PRIMARY (car args)) + (eq ':primary (car args))) + (setq args (cdr args)) + :primary) + ((or (eq ':STATIC (car args)) + (eq ':static (car args))) + (setq args (cdr args)) + :static) + (t nil))) + (params (car args)) + (lamparams + (mapcar (lambda (param) (if (listp param) (car param) param)) + params)) + (arg1 (car params)) + (class (if (listp arg1) (nth 1 arg1) nil))) + `(eieio-defmethod ',method + '(,@(if key (list key)) + ,params) + (lambda ,lamparams ,@(cdr args))))) -(defun eieio-defmethod (method args) +(defun eieio-defmethod (method args &optional code) "Work part of the `defmethod' macro defining METHOD with ARGS." (let ((key nil) (body nil) (firstarg nil) (argfix nil) (argclass nil) loopa) ;; find optional keys @@ -1349,10 +1371,7 @@ Summary: ;; generics are higher (setq key (eieio-specialized-key-to-generic-key key))) ;; Put this lambda into the symbol so we can find it - (if (byte-code-function-p (car-safe body)) - (eieiomt-add method (car-safe body) key argclass) - (eieiomt-add method (append (list 'lambda (reverse argfix)) body) - key argclass)) + (eieiomt-add method code key argclass) ) (when eieio-optimize-primary-methods-flag diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index bccc60a24e0..781195d034a 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -153,13 +153,14 @@ Assumes the caller has bound `macroexpand-all-environment'." ;; here, so that any code that cares about the difference will ;; see the same transformation. ;; First arg is a function: - (`(,(and fun (or `apply `mapcar `mapatoms `mapconcat `mapc)) ',f . ,args) + (`(,(and fun (or `apply `mapcar `mapatoms `mapconcat `mapc)) + ',(and f `(lambda . ,_)) . ,args) ;; We don't use `maybe-cons' since there's clearly a change. (cons fun (cons (macroexpand-all-1 (list 'function f)) (macroexpand-all-forms args)))) ;; Second arg is a function: - (`(,(and fun (or `sort)) ,arg1 ',f . ,args) + (`(,(and fun (or `sort)) ,arg1 ',(and f `(lambda . ,_)) . ,args) ;; We don't use `maybe-cons' since there's clearly a change. (cons fun (cons (macroexpand-all-1 arg1) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 49767e6e9d3..b488bc40acd 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -363,13 +363,6 @@ 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))) @@ -510,21 +503,6 @@ 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))) diff --git a/src/ChangeLog b/src/ChangeLog index d522b6c55dc..e7902b8c083 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,23 @@ +2011-02-25 Stefan Monnier + + * eval.c (Qcurry): Remove. + (funcall_funvec): Remove. + (funcall_lambda): Move new byte-code handling to reduce impact. + Treat all args as lexical in the case of lexbind. + (Fcurry): Remove. + * data.c (Qfunction_vector): Remove. + (Ffunvecp): Remove. + * lread.c (read1): Revert to calling make_byte_code here. + (read_vector): Don't call make_byte_code any more. + * lisp.h (enum pvec_type): Rename back to PVEC_COMPILED. + (XSETCOMPILED): Rename back from XSETFUNVEC. + (FUNVEC_SIZE): Remove. + (FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): Remove. + (COMPILEDP): Rename back from FUNVECP. + * fns.c (Felt): Remove unexplained FUNVEC check. + * doc.c (Fdocumentation): Don't handle funvec. + * alloc.c (make_funvec, Ffunvec): Remove. + 2011-02-21 Stefan Monnier * bytecode.c (exec_byte_code): Change stack_ref and stack_set to use @@ -113,6 +133,42 @@ Merge funvec patch. +2004-05-20 Miles Bader + + * lisp.h: Declare make_funvec and Ffunvec. + (enum pvec_type): Rename `PVEC_COMPILED' to `PVEC_FUNVEC'. + (XSETFUNVEC): Rename from `XSETCOMPILED'. + (FUNVEC_SIZE, FUNVEC_COMPILED_TAG_P, FUNVEC_COMPILED_P): New macros. + (COMPILEDP): Define in terms of funvec macros. + (FUNVECP, GC_FUNVECP): Rename 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. + 2004-04-10 Miles Bader * eval.c (Fspecialp): New function. diff --git a/src/ChangeLog.funvec b/src/ChangeLog.funvec deleted file mode 100644 index 098539f1dd9..00000000000 --- a/src/ChangeLog.funvec +++ /dev/null @@ -1,37 +0,0 @@ -2004-05-20 Miles Bader - - * 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/alloc.c b/src/alloc.c index 81a17b5c13b..0b7db7ec627 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2924,37 +2924,6 @@ 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 (Lisp_Object kind, int num_nil_slots, int 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. @@ -2974,27 +2943,6 @@ 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) */) - (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, @@ -3008,10 +2956,6 @@ 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); @@ -3033,8 +2977,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_FUNVEC); - XSETFUNVEC (val, p); + XSETPVECTYPE (p, PVEC_COMPILED); + XSETCOMPILED (val, p); return val; } @@ -4817,7 +4761,7 @@ Does not copy symbols. Copies strings without text properties. */) obj = make_pure_string (SSDATA (obj), SCHARS (obj), SBYTES (obj), STRING_MULTIBYTE (obj)); - else if (FUNVECP (obj) || VECTORP (obj)) + else if (COMPILEDP (obj) || VECTORP (obj)) { register struct Lisp_Vector *vec; register EMACS_INT i; @@ -4829,10 +4773,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 (FUNVECP (obj)) + if (COMPILEDP (obj)) { - XSETPVECTYPE (vec, PVEC_FUNVEC); - XSETFUNVEC (obj, vec); + XSETPVECTYPE (vec, PVEC_COMPILED); + XSETCOMPILED (obj, vec); } else XSETVECTOR (obj, vec); @@ -5418,7 +5362,7 @@ mark_object (Lisp_Object arg) } else if (SUBRP (obj)) break; - else if (FUNVECP (obj) && FUNVEC_COMPILED_P (obj)) + else if (COMPILEDP (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. */ @@ -6320,7 +6264,6 @@ 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/bytecode.c b/src/bytecode.c index 639c543dbf9..464bc3d12de 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -51,7 +51,7 @@ by Hallvard: * * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. */ -/* #define BYTE_CODE_SAFE 1 */ +/* #define BYTE_CODE_SAFE */ /* #define BYTE_CODE_METER */ @@ -1720,8 +1720,13 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, break; #endif + case 0: + /* Actually this is Bstack_ref with offset 0, but we use Bdup + for that instead. */ + /* case Bstack_ref: */ + abort (); + /* Handy byte-codes for lexical binding. */ - /* case Bstack_ref: */ /* Use `dup' instead. */ case Bstack_ref+1: case Bstack_ref+2: case Bstack_ref+3: diff --git a/src/data.c b/src/data.c index ecedba24101..186e9cb9859 100644 --- a/src/data.c +++ b/src/data.c @@ -84,7 +84,7 @@ static Lisp_Object Qsymbol, Qstring, Qcons, Qmarker, Qoverlay; Lisp_Object Qwindow; static Lisp_Object Qfloat, Qwindow_configuration; Lisp_Object Qprocess; -static Lisp_Object Qcompiled_function, Qfunction_vector, Qbuffer, Qframe, Qvector; +static Lisp_Object Qcompiled_function, 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; @@ -194,11 +194,8 @@ for example, (type-of 1) returns `integer'. */) return Qwindow; if (SUBRP (object)) return Qsubr; - if (FUNVECP (object)) - if (FUNVEC_COMPILED_P (object)) - return Qcompiled_function; - else - return Qfunction_vector; + if (COMPILEDP (object)) + return Qcompiled_function; if (BUFFERP (object)) return Qbuffer; if (CHAR_TABLE_P (object)) @@ -397,13 +394,6 @@ 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. */) - (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. */) (register Lisp_Object object) @@ -2113,9 +2103,9 @@ or a byte-code object. IDX starts at 0. */) { int size = 0; if (VECTORP (array)) - size = ASIZE (array); - else if (FUNVECP (array)) - size = FUNVEC_SIZE (array); + size = XVECTOR (array)->size; + else if (COMPILEDP (array)) + size = XVECTOR (array)->size & PSEUDOVECTOR_SIZE_MASK; else wrong_type_argument (Qarrayp, array); @@ -3180,7 +3170,6 @@ syms_of_data (void) 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"); @@ -3206,7 +3195,6 @@ syms_of_data (void) staticpro (&Qwindow); /* staticpro (&Qsubr); */ staticpro (&Qcompiled_function); - staticpro (&Qfunction_vector); staticpro (&Qbuffer); staticpro (&Qframe); staticpro (&Qvector); @@ -3243,7 +3231,6 @@ syms_of_data (void) 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 834321108b5..de20edb2d98 100644 --- a/src/doc.c +++ b/src/doc.c @@ -357,11 +357,6 @@ 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."); diff --git a/src/eval.c b/src/eval.c index 63484d40e1b..869d70e3d7f 100644 --- a/src/eval.c +++ b/src/eval.c @@ -60,7 +60,6 @@ Lisp_Object Qinhibit_quit; Lisp_Object Qand_rest, Qand_optional; Lisp_Object Qdebug_on_error; Lisp_Object Qdeclare; -Lisp_Object Qcurry; Lisp_Object Qinternal_interpreter_environment, Qclosure; Lisp_Object Qdebug; @@ -2405,7 +2404,7 @@ eval_sub (Lisp_Object form) } } } - else if (FUNVECP (fun)) + else if (COMPILEDP (fun)) val = apply_lambda (fun, original_args); else { @@ -2890,7 +2889,7 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, if (SUBRP (object)) return (XSUBR (object)->max_args != UNEVALLED) ? Qt : Qnil; - else if (FUNVECP (object)) + else if (COMPILEDP (object)) return Qt; else if (CONSP (object)) { @@ -3034,7 +3033,7 @@ usage: (funcall FUNCTION &rest ARGUMENTS) */) } } } - else if (FUNVECP (fun)) + else if (COMPILEDP (fun)) val = funcall_lambda (fun, numargs, args + 1); else { @@ -3107,54 +3106,6 @@ apply_lambda (Lisp_Object fun, Lisp_Object args) return tem; } - -/* Call a non-bytecode funvec object FUN, on the argments in ARGS (of - length NARGS). */ - -static Lisp_Object -funcall_funvec (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. */ - memcpy (funcall_args + curried_args_offs, curried_args, - num_curried_args * sizeof (Lisp_Object)); - memcpy (funcall_args + user_args_offs, args, - 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. */ @@ -3167,34 +3118,6 @@ funcall_lambda (Lisp_Object fun, int nargs, 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)) { if (EQ (XCAR (fun), Qclosure)) @@ -3213,6 +3136,27 @@ funcall_lambda (Lisp_Object fun, int nargs, } else if (COMPILEDP (fun)) { + if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > 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); + } syms_left = AREF (fun, COMPILED_ARGLIST); lexenv = Qnil; } @@ -3248,11 +3192,7 @@ funcall_lambda (Lisp_Object fun, int nargs, val = Qnil; /* Bind the argument. */ - if (!NILP (lexenv) && SYMBOLP (next) - /* FIXME: there's no good reason to allow dynamic-scoping - on function arguments, other than consistency with let. */ - && !XSYMBOL (next)->declared_special - && NILP (Fmemq (next, Vinternal_interpreter_environment))) + if (!NILP (lexenv) && SYMBOLP (next)) /* Lexically bind NEXT by adding it to the lexenv alist. */ lexenv = Fcons (Fcons (next, val), lexenv); else @@ -3532,24 +3472,6 @@ context where binding is lexical by default. */) -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) */) - (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. */) @@ -3764,9 +3686,6 @@ before making `inhibit-quit' nil. */); Qclosure = intern_c_string ("closure"); staticpro (&Qclosure); - Qcurry = intern_c_string ("curry"); - staticpro (&Qcurry); - Qdebug = intern_c_string ("debug"); staticpro (&Qdebug); @@ -3901,11 +3820,9 @@ alist of active lexical bindings. */); 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 (&Sspecial_variable_p); defsubr (&Sfunctionp); } diff --git a/src/fns.c b/src/fns.c index 5748c3d6e02..b800846b781 100644 --- a/src/fns.c +++ b/src/fns.c @@ -127,8 +127,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 (FUNVECP (sequence)) - XSETFASTINT (val, FUNVEC_SIZE (sequence)); + else if (COMPILEDP (sequence)) + XSETFASTINT (val, ASIZE (sequence) & PSEUDOVECTOR_SIZE_MASK); else if (CONSP (sequence)) { i = 0; @@ -488,7 +488,7 @@ concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_speci { this = args[argnum]; if (!(CONSP (this) || NILP (this) || VECTORP (this) || STRINGP (this) - || FUNVECP (this) || BOOL_VECTOR_P (this))) + || COMPILEDP (this) || BOOL_VECTOR_P (this))) wrong_type_argument (Qsequencep, this); } @@ -512,7 +512,7 @@ concat (int nargs, Lisp_Object *args, enum Lisp_Type target_type, int last_speci Lisp_Object ch; EMACS_INT this_len_byte; - if (VECTORP (this) || FUNVECP (this)) + if (VECTORP (this) || COMPILEDP (this)) for (i = 0; i < len; i++) { ch = AREF (this, i); @@ -1311,9 +1311,7 @@ DEFUN ("elt", Felt, Selt, 2, 2, 0, return Fcar (Fnthcdr (n, sequence)); /* Faref signals a "not array" error, so check here. */ - if (! FUNVECP (sequence)) - CHECK_ARRAY (sequence, Qsequencep); - + CHECK_ARRAY (sequence, Qsequencep); return Faref (sequence, n); } @@ -2092,14 +2090,13 @@ internal_equal (register Lisp_Object o1, register Lisp_Object o2, int depth, int if (WINDOW_CONFIGURATIONP (o1)) return compare_window_configurations (o1, o2, 0); - /* 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. */ + /* 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. */ if (size & PSEUDOVECTOR_FLAG) { - if (!(size & (PVEC_FUNVEC - | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE - | PVEC_FONT))) + if (!(size & (PVEC_COMPILED + | PVEC_CHAR_TABLE | PVEC_SUB_CHAR_TABLE | PVEC_FONT))) return 0; size &= PSEUDOVECTOR_SIZE_MASK; } @@ -2302,7 +2299,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq) 1) lists are not relocated and 2) the list is marked via `seq' so will not be freed */ - if (VECTORP (seq) || FUNVECP (seq)) + if (VECTORP (seq) || COMPILEDP (seq)) { for (i = 0; i < leni; i++) { diff --git a/src/image.c b/src/image.c index f4a50e92ab1..a7c6346f62c 100644 --- a/src/image.c +++ b/src/image.c @@ -835,8 +835,9 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, case IMAGE_FUNCTION_VALUE: value = indirect_function (value); + /* FIXME: Shouldn't we use Ffunctionp here? */ if (SUBRP (value) - || FUNVECP (value) + || COMPILEDP (value) || (CONSP (value) && EQ (XCAR (value), Qlambda))) break; return 0; diff --git a/src/keyboard.c b/src/keyboard.c index 1f14af78844..78aa1cfea77 100644 --- a/src/keyboard.c +++ b/src/keyboard.c @@ -10179,7 +10179,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) || FUNVECP (final)) + if (CONSP (final) || SUBRP (final) || COMPILEDP (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 badeb4258fb..223cdbc92f0 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -349,7 +349,7 @@ enum pvec_type PVEC_NORMAL_VECTOR = 0, PVEC_PROCESS = 0x200, PVEC_FRAME = 0x400, - PVEC_FUNVEC = 0x800, + PVEC_COMPILED = 0x800, PVEC_WINDOW = 0x1000, PVEC_WINDOW_CONFIGURATION = 0x2000, PVEC_SUBR = 0x4000, @@ -607,7 +607,7 @@ extern Lisp_Object make_number (EMACS_INT); #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 XSETFUNVEC(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_FUNVEC)) +#define XSETCOMPILED(a, b) (XSETPSEUDOVECTOR (a, b, PVEC_COMPILED)) #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)) @@ -623,9 +623,6 @@ extern Lisp_Object make_number (EMACS_INT); 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) @@ -1474,7 +1471,7 @@ struct Lisp_Float typedef unsigned char UCHAR; #endif -/* Meanings of slots in a byte-compiled function vector: */ +/* Meanings of slots in a Lisp_Compiled: */ #define COMPILED_ARGLIST 0 #define COMPILED_BYTECODE 1 @@ -1484,24 +1481,6 @@ typedef unsigned char UCHAR; #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 thinks that MULE (MUlti-Lingual Emacs) might need 22 bits for the character value @@ -1657,7 +1636,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 FUNVECP(x) PSEUDOVECTORP (x, PVEC_FUNVEC) +#define COMPILEDP(x) PSEUDOVECTORP (x, PVEC_COMPILED) #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) @@ -1851,7 +1830,7 @@ typedef struct { #define FUNCTIONP(OBJ) \ ((CONSP (OBJ) && EQ (XCAR (OBJ), Qlambda)) \ || (SYMBOLP (OBJ) && !NILP (Ffboundp (OBJ))) \ - || FUNVECP (OBJ) \ + || COMPILEDP (OBJ) \ || SUBRP (OBJ)) /* defsubr (Sname); @@ -2725,7 +2704,6 @@ EXFUN (Fmake_list, 2); extern Lisp_Object allocate_misc (void); EXFUN (Fmake_vector, 2); EXFUN (Fvector, MANY); -EXFUN (Ffunvec, MANY); EXFUN (Fmake_symbol, 1); EXFUN (Fmake_marker, 0); EXFUN (Fmake_string, 2); @@ -2745,7 +2723,6 @@ extern Lisp_Object make_pure_c_string (const char *data); extern Lisp_Object pure_cons (Lisp_Object, Lisp_Object); extern Lisp_Object make_pure_vector (EMACS_INT); EXFUN (Fgarbage_collect, 0); -extern Lisp_Object make_funvec (Lisp_Object, int, int, Lisp_Object *); EXFUN (Fmake_byte_code, MANY); EXFUN (Fmake_bool_vector, 2); extern Lisp_Object Qchar_table_extra_slots; diff --git a/src/lread.c b/src/lread.c index b30a75b67c3..77b397a03df 100644 --- a/src/lread.c +++ b/src/lread.c @@ -2497,8 +2497,14 @@ read1 (register Lisp_Object readcharfun, int *pch, int first_in_list) invalid_syntax ("#&...", 5); } if (c == '[') - /* `function vector' objects, including byte-compiled functions. */ - return read_vector (readcharfun, 1); + { + /* 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); + } if (c == '(') { Lisp_Object tmp; @@ -3311,7 +3317,7 @@ isfloat_string (const char *cp, int ignore_trailing) static Lisp_Object -read_vector (Lisp_Object readcharfun, int read_funvec) +read_vector (Lisp_Object readcharfun, int bytecodeflag) { register int i; register int size; @@ -3319,11 +3325,6 @@ read_vector (Lisp_Object readcharfun, int read_funvec) 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); @@ -3335,18 +3336,11 @@ read_vector (Lisp_Object readcharfun, int read_funvec) { 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 (read_bytecode && load_force_doc_strings) + if (bytecodeflag && load_force_doc_strings) { if (i == COMPILED_BYTECODE) { @@ -3400,13 +3394,6 @@ read_vector (Lisp_Object readcharfun, int read_funvec) 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; } diff --git a/src/print.c b/src/print.c index 11bce153ffc..00847d67318 100644 --- a/src/print.c +++ b/src/print.c @@ -1155,7 +1155,7 @@ print_preprocess (Lisp_Object obj) loop: if (STRINGP (obj) || CONSP (obj) || VECTORP (obj) - || FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) + || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) || HASH_TABLE_P (obj) || (! NILP (Vprint_gensym) && SYMBOLP (obj) @@ -1337,7 +1337,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag /* Detect circularities and truncate them. */ if (STRINGP (obj) || CONSP (obj) || VECTORP (obj) - || FUNVECP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) + || COMPILEDP (obj) || CHAR_TABLE_P (obj) || SUB_CHAR_TABLE_P (obj) || HASH_TABLE_P (obj) || (! NILP (Vprint_gensym) && SYMBOLP (obj) @@ -1960,7 +1960,7 @@ print_object (Lisp_Object obj, register Lisp_Object printcharfun, int escapeflag else { EMACS_INT size = XVECTOR (obj)->size; - if (FUNVECP (obj)) + if (COMPILEDP (obj)) { PRINTCHAR ('#'); size &= PSEUDOVECTOR_SIZE_MASK; From a9de04fa62f123413d82b7b7b1e7a77705eb82dd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 26 Feb 2011 10:19:08 -0500 Subject: [PATCH 22/45] Compute freevars in cconv-analyse. * lisp/emacs-lisp/cconv.el: Compute freevars in cconv-analyse. (cconv-mutated, cconv-captured): Remove. (cconv-captured+mutated, cconv-lambda-candidates): Don't give them a global value. (cconv-freevars-alist): New var. (cconv-freevars): Remove. (cconv--lookup-let): Remove. (cconv-closure-convert-function): Extract from cconv-closure-convert-rec. (cconv-closure-convert-rec): Adjust to above changes. (fboundp): New function. (cconv-analyse-function, form): Rewrite. * lisp/emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): Handle declare-function here. (byte-compile-obsolete): Remove. (byte-compile-arglist-warn): Check late defsubst here. (byte-compile-file-form): Simplify. (byte-compile-file-form-defsubst): Remove. (byte-compile-macroexpand-declare-function): Rename from byte-compile-declare-function, turn it into a macro-expander. (byte-compile-normal-call): Check obsolescence. (byte-compile-quote-form): Remove. (byte-compile-defmacro): Revert to trunk's definition which seems to work just as well and handles `declare'. * lisp/emacs-lisp/byte-run.el (make-obsolete): Don't modify byte-compile. * lisp/Makefile.in (BIG_STACK_DEPTH): Increase to 1200. (compile-onefile): Pass $(BIG_STACK_OPTS) before "-l bytecomp". * lisp/emacs-lisp/macroexp.el: Use lexbind. (macroexpand-all-1): Check macro obsolescence. * lisp/vc/diff-mode.el: Use lexbind. * lisp/follow.el (follow-calc-win-end): Simplify. --- lisp/ChangeLog | 33 +++ lisp/Makefile.in | 8 +- lisp/emacs-lisp/byte-run.el | 10 +- lisp/emacs-lisp/bytecomp.el | 121 ++++------ lisp/emacs-lisp/cconv.el | 466 ++++++++++++++++-------------------- lisp/emacs-lisp/debug.el | 1 + lisp/emacs-lisp/macroexp.el | 11 +- lisp/follow.el | 3 +- lisp/vc/diff-mode.el | 4 +- src/bytecode.c | 2 +- 10 files changed, 307 insertions(+), 352 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ee6944d8e07..1b5e9400a8c 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,36 @@ +2011-02-26 Stefan Monnier + + * emacs-lisp/cconv.el: Compute freevars in cconv-analyse. + (cconv-mutated, cconv-captured): Remove. + (cconv-captured+mutated, cconv-lambda-candidates): Don't give them + a global value. + (cconv-freevars-alist): New var. + (cconv-freevars): Remove. + (cconv--lookup-let): Remove. + (cconv-closure-convert-function): Extract from cconv-closure-convert-rec. + (cconv-closure-convert-rec): Adjust to above changes. + (fboundp): New function. + (cconv-analyse-function, form): Rewrite. + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): + Handle declare-function here. + (byte-compile-obsolete): Remove. + (byte-compile-arglist-warn): Check late defsubst here. + (byte-compile-file-form): Simplify. + (byte-compile-file-form-defsubst): Remove. + (byte-compile-macroexpand-declare-function): Rename from + byte-compile-declare-function, turn it into a macro-expander. + (byte-compile-normal-call): Check obsolescence. + (byte-compile-quote-form): Remove. + (byte-compile-defmacro): Revert to trunk's definition which seems to + work just as well and handles `declare'. + * emacs-lisp/byte-run.el (make-obsolete): Don't modify byte-compile. + * Makefile.in (BIG_STACK_DEPTH): Increase to 1200. + (compile-onefile): Pass $(BIG_STACK_OPTS) before "-l bytecomp". + * emacs-lisp/macroexp.el: Use lexbind. + (macroexpand-all-1): Check macro obsolescence. + * vc/diff-mode.el: Use lexbind. + * follow.el (follow-calc-win-end): Simplify. + 2011-02-25 Stefan Monnier * emacs-lisp/bytecomp.el (byte-compile-lapcode): Handle new form of diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 389d5b154aa..0182b7f5072 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -74,7 +74,7 @@ AUTOGENEL = loaddefs.el \ # During bootstrapping the byte-compiler is run interpreted when compiling # itself, and uses more stack than usual. # -BIG_STACK_DEPTH = 1000 +BIG_STACK_DEPTH = 1200 BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" # Files to compile before others during a bootstrap. This is done to @@ -205,8 +205,8 @@ 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.el -f byte-compile-refresh-preloaded \ - $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ + @$(emacs) $(BIG_STACK_OPTS) -l bytecomp $(BYTE_COMPILE_EXTRA_FLAGS) \ + -f byte-compile-refresh-preloaded \ -f batch-byte-compile $(THEFILE) # Files MUST be compiled one by one. If we compile several files in a @@ -222,7 +222,7 @@ compile-onefile: # cannot have prerequisites. .el.elc: @echo Compiling $< - $(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ + @$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ -f batch-byte-compile $< .PHONY: compile-first compile-main compile compile-always diff --git a/lisp/emacs-lisp/byte-run.el b/lisp/emacs-lisp/byte-run.el index 524f4f1b465..3fb3d841ed1 100644 --- a/lisp/emacs-lisp/byte-run.el +++ b/lisp/emacs-lisp/byte-run.el @@ -123,12 +123,10 @@ If CURRENT-NAME is a string, that is the `use instead' message If provided, WHEN should be a string indicating when the function was first made obsolete, for example a date or a release number." (interactive "aMake function obsolete: \nxObsoletion replacement: ") - (let ((handler (get obsolete-name 'byte-compile))) - (if (eq 'byte-compile-obsolete handler) - (setq handler (nth 1 (get obsolete-name 'byte-obsolete-info))) - (put obsolete-name 'byte-compile 'byte-compile-obsolete)) - (put obsolete-name 'byte-obsolete-info - (list (purecopy current-name) handler (purecopy when)))) + (put obsolete-name 'byte-obsolete-info + ;; The second entry used to hold the `byte-compile' handler, but + ;; is not used any more nowadays. + (list (purecopy current-name) nil (purecopy when))) obsolete-name) (set-advertised-calling-convention ;; New code should always provide the `when' argument. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6bc2b3b5617..4a53faefa3d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -424,6 +424,7 @@ This list lives partly on the stack.") '( ;; (byte-compiler-options . (lambda (&rest forms) ;; (apply 'byte-compiler-options-handler forms))) + (declare-function . byte-compile-macroexpand-declare-function) (eval-when-compile . (lambda (&rest body) (list 'quote @@ -1140,13 +1141,6 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (byte-compile-log-warning (error-message-string error-info) nil :error)) - -;;; Used by make-obsolete. -(defun byte-compile-obsolete (form) - (byte-compile-set-symbol-position (car form)) - (byte-compile-warn-obsolete (car form)) - (funcall (or (cadr (get (car form) 'byte-obsolete-info)) ; handler - 'byte-compile-normal-call) form)) ;;; sanity-checking arglists @@ -1328,7 +1322,8 @@ extra args." ;; Warn if the function or macro is being redefined with a different ;; number of arguments. (defun byte-compile-arglist-warn (form macrop) - (let ((old (byte-compile-fdefinition (nth 1 form) macrop))) + (let* ((name (nth 1 form)) + (old (byte-compile-fdefinition name macrop))) (if (and old (not (eq old t))) (progn (and (eq 'macro (car-safe old)) @@ -1342,36 +1337,39 @@ extra args." (t '(&rest def))))) (sig2 (byte-compile-arglist-signature (nth 2 form)))) (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) - (byte-compile-set-symbol-position (nth 1 form)) + (byte-compile-set-symbol-position name) (byte-compile-warn "%s %s used to take %s %s, now takes %s" (if (eq (car form) 'defun) "function" "macro") - (nth 1 form) + name (byte-compile-arglist-signature-string sig1) (if (equal sig1 '(1 . 1)) "argument" "arguments") (byte-compile-arglist-signature-string sig2))))) ;; This is the first definition. See if previous calls are compatible. - (let ((calls (assq (nth 1 form) byte-compile-unresolved-functions)) + (let ((calls (assq name byte-compile-unresolved-functions)) nums sig min max) - (if calls - (progn - (setq sig (byte-compile-arglist-signature (nth 2 form)) - nums (sort (copy-sequence (cdr calls)) (function <)) - min (car nums) - max (car (nreverse nums))) - (when (or (< min (car sig)) - (and (cdr sig) (> max (cdr sig)))) - (byte-compile-set-symbol-position (nth 1 form)) - (byte-compile-warn - "%s being defined to take %s%s, but was previously called with %s" - (nth 1 form) - (byte-compile-arglist-signature-string sig) - (if (equal sig '(1 . 1)) " arg" " args") - (byte-compile-arglist-signature-string (cons min max)))) + (when calls + (when (and (symbolp name) + (eq (get name 'byte-optimizer) + 'byte-compile-inline-expand)) + (byte-compile-warn "defsubst `%s' was used before it was defined" + name)) + (setq sig (byte-compile-arglist-signature (nth 2 form)) + nums (sort (copy-sequence (cdr calls)) (function <)) + min (car nums) + max (car (nreverse nums))) + (when (or (< min (car sig)) + (and (cdr sig) (> max (cdr sig)))) + (byte-compile-set-symbol-position name) + (byte-compile-warn + "%s being defined to take %s%s, but was previously called with %s" + name + (byte-compile-arglist-signature-string sig) + (if (equal sig '(1 . 1)) " arg" " args") + (byte-compile-arglist-signature-string (cons min max)))) - (setq byte-compile-unresolved-functions - (delq calls byte-compile-unresolved-functions))))) - ))) + (setq byte-compile-unresolved-functions + (delq calls byte-compile-unresolved-functions))))))) (defvar byte-compile-cl-functions nil "List of functions defined in CL.") @@ -1470,7 +1468,7 @@ symbol itself." (if any-value (or (memq symbol byte-compile-const-variables) ;; FIXME: We should provide a less intrusive way to find out - ;; is a variable is "constant". + ;; if a variable is "constant". (and (boundp symbol) (condition-case nil (progn (set symbol (symbol-value symbol)) nil) @@ -2198,9 +2196,8 @@ list that represents a doc string reference. ;; byte-hunk-handlers can call this. (defun byte-compile-file-form (form) (let (bytecomp-handler) - (cond ((not (consp form)) - (byte-compile-keep-pending form)) - ((and (symbolp (car form)) + (cond ((and (consp form) + (symbolp (car form)) (setq bytecomp-handler (get (car form) 'byte-hunk-handler))) (cond ((setq form (funcall bytecomp-handler form)) (byte-compile-flush-pending) @@ -2212,16 +2209,6 @@ list that represents a doc string reference. ;; so make-docfile can recognise them. Most other things can be output ;; as byte-code. -(put 'defsubst 'byte-hunk-handler 'byte-compile-file-form-defsubst) -(defun byte-compile-file-form-defsubst (form) - (when (assq (nth 1 form) byte-compile-unresolved-functions) - (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 form) - ;; Return nil so the form is not output twice. - nil) - (put 'autoload 'byte-hunk-handler 'byte-compile-file-form-autoload) (defun byte-compile-file-form-autoload (form) (and (let ((form form)) @@ -2914,7 +2901,6 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; Given BYTECOMP-BODY, compile it and return a new body. (defun byte-compile-top-level-body (bytecomp-body &optional for-effect) - ;; FIXME: lexbind. Check all callers! (setq bytecomp-body (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t)) (cond ((eq (car-safe bytecomp-body) 'progn) @@ -2922,20 +2908,18 @@ If FORM is a lambda or a macro, byte-compile it as a function." (bytecomp-body (list bytecomp-body)))) -;; FIXME: Like defsubst's, this hunk-handler won't be called any more -;; because the macro is expanded away before we see it. -(put 'declare-function 'byte-hunk-handler 'byte-compile-declare-function) -(defun byte-compile-declare-function (form) - (push (cons (nth 1 form) - (if (and (> (length form) 3) - (listp (nth 3 form))) - (list 'declared (nth 3 form)) +;; Special macro-expander used during byte-compilation. +(defun byte-compile-macroexpand-declare-function (fn file &rest args) + (push (cons fn + (if (and (consp args) (listp (car args))) + (list 'declared (car args)) t)) ; arglist not specified byte-compile-function-environment) ;; We are stating that it _will_ be defined at runtime. (setq byte-compile-noruntime-functions - (delq (nth 1 form) byte-compile-noruntime-functions)) - nil) + (delq fn byte-compile-noruntime-functions)) + ;; Delegate the rest to the normal macro definition. + (macroexpand `(declare-function ,fn ,file ,@args))) ;; This is the recursive entry point for compiling each subform of an @@ -3005,6 +2989,8 @@ That command is designed for interactive use only" bytecomp-fn)) '(custom-declare-group custom-declare-variable custom-declare-face)) (byte-compile-nogroup-warn form)) + (when (get (car form) 'byte-obsolete-info) + (byte-compile-warn-obsolete (car form))) (byte-compile-callargs-warn form)) (if byte-compile-generate-call-tree (byte-compile-annotate-call-tree form)) @@ -3562,7 +3548,6 @@ discarding." (byte-defop-compiler-1 setq) (byte-defop-compiler-1 setq-default) (byte-defop-compiler-1 quote) -(byte-defop-compiler-1 quote-form) (defun byte-compile-setq (form) (let ((bytecomp-args (cdr form))) @@ -3606,10 +3591,6 @@ discarding." (defun byte-compile-quote (form) (byte-compile-constant (car (cdr form)))) - -(defun byte-compile-quote-form (form) - (byte-compile-constant (byte-compile-top-level (nth 1 form)))) - ;;; control structures @@ -3845,6 +3826,7 @@ Return the offset in the form (VAR . OFFSET)." (byte-compile-push-constant nil))))) (defun byte-compile-not-lexical-var-p (var) + ;; FIXME: this doesn't catch defcustoms! (or (not (symbolp var)) (special-variable-p var) (memq var byte-compile-bound-variables) @@ -4097,15 +4079,16 @@ binding slots have been popped." (defun byte-compile-defmacro (form) ;; This is not used for file-level defmacros with doc strings. - ;; 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)) - (byte-compile-push-constant (cons 'macro code)) - (byte-compile-out 'byte-fset) - (byte-compile-discard)) - (byte-compile-constant (nth 1 form))) + (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))))) (defun byte-compile-defvar (form) ;; This is not used for file-level defvar/consts with doc strings. @@ -4153,7 +4136,7 @@ binding slots have been popped." `(if (not (default-boundp ',var)) (setq-default ,var ,value)))) (when (eq fun 'defconst) ;; This will signal an appropriate error at runtime. - `(eval ',form))) ;FIXME: lexbind + `(eval ',form))) `',var)))) (defun byte-compile-autoload (form) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index bc7ecb1ad55..0e4b5d31699 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -82,110 +82,19 @@ (defconst cconv-liftwhen 3 "Try to do lambda lifting if the number of arguments + free variables is less than this number.") -(defvar cconv-mutated nil - "List of mutated variables in current form") -(defvar cconv-captured nil - "List of closure captured variables in current form") -(defvar cconv-captured+mutated nil - "An intersection between cconv-mutated and cconv-captured lists.") -(defvar cconv-lambda-candidates nil - "List of candidates for lambda lifting. -Each candidate has the form (VAR INCLOSURE BINDER PARENTFORM).") +;; List of all the variables that are both captured by a closure +;; and mutated. Each entry in the list takes the form +;; (BINDER . PARENTFORM) where BINDER is the (VAR VAL) that introduces the +;; variable (or is just (VAR) for variables not introduced by let). +(defvar cconv-captured+mutated) -(defun cconv-freevars (form &optional fvrs) - "Find all free variables of given form. -Arguments: --- FORM is a piece of Elisp code after macroexpansion. --- FVRS(optional) is a list of variables already found. Used for recursive tree -traversal +;; List of candidates for lambda lifting. +;; Each candidate has the form (BINDER . PARENTFORM). A candidate +;; is a variable that is only passed to `funcall' or `apply'. +(defvar cconv-lambda-candidates) -Returns a list of free variables." - ;; If a leaf in the tree is a symbol, but it is not a global variable, not a - ;; keyword, not 'nil or 't we consider this leaf as a variable. - ;; Free variables are the variables that are not declared above in this tree. - ;; For example free variables of (lambda (a1 a2 ..) body-forms) are - ;; free variables of body-forms excluding a1, a2 .. - ;; Free variables of (let ((v1 ..) (v2) ..)) body-forms) are - ;; free variables of body-forms excluding v1, v2 ... - ;; and so on. - - ;; A list of free variables already found(FVRS) is passed in parameter - ;; to try to use cons or push where possible, and to minimize the usage - ;; of append. - - ;; This function can return duplicates (because we use 'append instead - ;; of union of two sets - for performance reasons). - (pcase form - (`(let ,varsvalues . ,body-forms) ; let special form - (let ((fvrs-1 '())) - (dolist (exp body-forms) - (setq fvrs-1 (cconv-freevars exp fvrs-1))) - (dolist (elm varsvalues) - (setq fvrs-1 (delq (if (consp elm) (car elm) elm) fvrs-1))) - (setq fvrs (nconc fvrs-1 fvrs)) - (dolist (exp varsvalues) - (when (consp exp) (setq fvrs (cconv-freevars (cadr exp) fvrs)))) - fvrs)) - - (`(let* ,varsvalues . ,body-forms) ; let* special form - (let ((vrs '()) - (fvrs-1 '())) - (dolist (exp varsvalues) - (if (consp exp) - (progn - (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1)) - (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) - (push (car exp) vrs)) - (progn - (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) - (push exp vrs)))) - (dolist (exp body-forms) - (setq fvrs-1 (cconv-freevars exp fvrs-1))) - (dolist (elm vrs) (setq fvrs-1 (delq elm fvrs-1))) - (append fvrs fvrs-1))) - - (`((lambda . ,_) . ,_) ; first element is lambda expression - (dolist (exp `((function ,(car form)) . ,(cdr form))) - (setq fvrs (cconv-freevars exp fvrs))) fvrs) - - (`(cond . ,cond-forms) ; cond special form - (dolist (exp1 cond-forms) - (dolist (exp2 exp1) - (setq fvrs (cconv-freevars exp2 fvrs)))) fvrs) - - (`(quote . ,_) fvrs) ; quote form - - (`(function . ((lambda ,vars . ,body-forms))) - (let ((functionform (cadr form)) (fvrs-1 '())) - (dolist (exp body-forms) - (setq fvrs-1 (cconv-freevars exp fvrs-1))) - (dolist (elm vars) (setq fvrs-1 (delq elm fvrs-1))) - (append fvrs fvrs-1))) ; function form - - (`(function . ,_) fvrs) ; same as quote - ;condition-case - (`(condition-case ,var ,protected-form . ,conditions-bodies) - (let ((fvrs-1 '())) - (dolist (exp conditions-bodies) - (setq fvrs-1 (cconv-freevars (cadr exp) fvrs-1))) - (setq fvrs-1 (delq var fvrs-1)) - (setq fvrs-1 (cconv-freevars protected-form fvrs-1)) - (append fvrs fvrs-1))) - - (`(,(and sym (or `defun `defconst `defvar)) . ,_) - ;; We call cconv-freevars only for functions(lambdas) - ;; defun, defconst, defvar are not allowed to be inside - ;; a function (lambda). - ;; (error "Invalid form: %s inside a function" sym) - (cconv-freevars `(progn ,@(cddr form)) fvrs)) - - (`(,_ . ,body-forms) ; First element is (like) a function. - (dolist (exp body-forms) - (setq fvrs (cconv-freevars exp fvrs))) fvrs) - - (_ (if (byte-compile-not-lexical-var-p form) - fvrs - (cons form fvrs))))) +;; Alist associating to each function body the list of its free variables. +(defvar cconv-freevars-alist) ;;;###autoload (defun cconv-closure-convert (form) @@ -195,16 +104,12 @@ Returns a list of free variables." Returns a form where all lambdas don't have any free variables." ;; (message "Entering cconv-closure-convert...") - (let ((cconv-mutated '()) + (let ((cconv-freevars-alist '()) (cconv-lambda-candidates '()) - (cconv-captured '()) (cconv-captured+mutated '())) ;; Analyse form - fill these variables with new information. - (cconv-analyse-form form '() 0) - ;; Calculate an intersection of cconv-mutated and cconv-captured. - (dolist (mvr cconv-mutated) - (when (memq mvr cconv-captured) ; - (push mvr cconv-captured+mutated))) + (cconv-analyse-form form '()) + (setq cconv-freevars-alist (nreverse cconv-freevars-alist)) (cconv-closure-convert-rec form ; the tree '() ; @@ -213,15 +118,6 @@ Returns a form where all lambdas don't have any free variables." '() ))) -(defun cconv--lookup-let (table var binder form) - (let ((res nil)) - (dolist (elem table) - (when (and (eq (nth 2 elem) binder) - (eq (nth 3 elem) form)) - (assert (eq (car elem) var)) - (setq res elem))) - res)) - (defconst cconv--dummy-var (make-symbol "ignored")) (defun cconv--set-diff (s1 s2) @@ -261,6 +157,57 @@ Returns a form where all lambdas don't have any free variables." (unless (memq (car b) s) (push b res))) (nreverse res))) +(defun cconv-closure-convert-function (fvrs vars emvrs envs lmenvs body-forms + parentform) + (assert (equal body-forms (caar cconv-freevars-alist))) + (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs. + (fv (cdr (pop cconv-freevars-alist))) + (body-forms-new '()) + (letbind '()) + (envector nil)) + (when fv + ;; Here we form our environment vector. + + (dolist (elm fv) + (push + (cconv-closure-convert-rec + ;; Remove `elm' from `emvrs' for this call because in case + ;; `elm' is a variable that's wrapped in a cons-cell, we + ;; want to put the cons-cell itself in the closure, rather + ;; than just a copy of its current content. + elm (remq elm emvrs) fvrs envs lmenvs) + envector)) ; Process vars for closure vector. + (setq envector (reverse envector)) + (setq envs fv) + (setq fvrs-new fv)) ; Update substitution list. + + (setq emvrs (cconv--set-diff emvrs vars)) + (setq lmenvs (cconv--map-diff-set lmenvs vars)) + + ;; The difference between envs and fvrs is explained + ;; in comment in the beginning of the function. + (dolist (var vars) + (when (member (cons (list var) parentform) cconv-captured+mutated) + (push var emvrs) + (push `(,var (list ,var)) letbind))) + (dolist (elm body-forms) ; convert function body + (push (cconv-closure-convert-rec + elm emvrs fvrs-new envs lmenvs) + body-forms-new)) + + (setq body-forms-new + (if letbind `((let ,letbind . ,(reverse body-forms-new))) + (reverse body-forms-new))) + + (cond + ;if no freevars - do nothing + ((null envector) + `(function (lambda ,vars . ,body-forms-new))) + ; 1 free variable - do not build vector + (t + `(internal-make-closure + ,vars ,envector . ,body-forms-new))))) + (defun cconv-closure-convert-rec (form emvrs fvrs envs lmenvs) ;; This function actually rewrites the tree. "Eliminates all free variables of all lambdas in given forms. @@ -303,15 +250,18 @@ Returns a form where all lambdas don't have any free variables." (dolist (binder binders) (let* ((value nil) (var (if (not (consp binder)) - binder + (prog1 binder (setq binder (list binder))) (setq value (cadr binder)) (car binder))) (new-val (cond ;; Check if var is a candidate for lambda lifting. - ((cconv--lookup-let cconv-lambda-candidates var binder form) - - (let* ((fv (delete-dups (cconv-freevars value '()))) + ((member (cons binder form) cconv-lambda-candidates) + (assert (and (eq (car value) 'function) + (eq (car (cadr value)) 'lambda))) + (assert (equal (cddr (cadr value)) + (caar cconv-freevars-alist))) + (let* ((fv (cdr (pop cconv-freevars-alist))) (funargs (cadr (cadr value))) (funcvars (append fv funargs)) (funcbodies (cddadr value)) ; function bodies @@ -338,7 +288,7 @@ Returns a form where all lambdas don't have any free variables." ,(reverse funcbodies-new)))))))) ;; Check if it needs to be turned into a "ref-cell". - ((cconv--lookup-let cconv-captured+mutated var binder form) + ((member (cons binder form) cconv-captured+mutated) ;; Declared variable is mutated and captured. (prog1 `(list ,(cconv-closure-convert-rec @@ -404,13 +354,12 @@ Returns a form where all lambdas don't have any free variables." )) ; end of dolist over binders (when (eq letsym 'let) - (let (var fvrs-1 emvrs-1 lmenvs-1) - ;; Here we update emvrs, fvrs and lmenvs lists - (setq fvrs (cconv--set-diff-map fvrs binders-new)) - (setq emvrs (cconv--set-diff-map emvrs binders-new)) - (setq emvrs (append emvrs emvrs-new)) - (setq lmenvs (cconv--set-diff-map lmenvs binders-new)) - (setq lmenvs (append lmenvs lmenvs-new))) + ;; Here we update emvrs, fvrs and lmenvs lists + (setq fvrs (cconv--set-diff-map fvrs binders-new)) + (setq emvrs (cconv--set-diff-map emvrs binders-new)) + (setq emvrs (append emvrs emvrs-new)) + (setq lmenvs (cconv--set-diff-map lmenvs binders-new)) + (setq lmenvs (append lmenvs lmenvs-new)) ;; Here we do the same letbinding as for let* above ;; to avoid situation when a free variable of a lambda lifted @@ -478,56 +427,8 @@ Returns a form where all lambdas don't have any free variables." (`(quote . ,_) form) (`(function (lambda ,vars . ,body-forms)) ; function form - (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs. - (fv (delete-dups (cconv-freevars form '()))) - (leave fvrs-new) ; leave=non-nil if we should leave env unchanged. - (body-forms-new '()) - (letbind '()) - (mv nil) - (envector nil)) - (when fv - ;; Here we form our environment vector. - - (dolist (elm fv) - (push - (cconv-closure-convert-rec - ;; Remove `elm' from `emvrs' for this call because in case - ;; `elm' is a variable that's wrapped in a cons-cell, we - ;; want to put the cons-cell itself in the closure, rather - ;; than just a copy of its current content. - elm (remq elm emvrs) fvrs envs lmenvs) - envector)) ; Process vars for closure vector. - (setq envector (reverse envector)) - (setq envs fv) - (setq fvrs-new fv)) ; Update substitution list. - - (setq emvrs (cconv--set-diff emvrs vars)) - (setq lmenvs (cconv--map-diff-set lmenvs vars)) - - ;; The difference between envs and fvrs is explained - ;; in comment in the beginning of the function. - (dolist (elm cconv-captured+mutated) ; Find mutated arguments - (setq mv (car elm)) ; used in inner closures. - (when (and (memq mv vars) (eq form (caddr elm))) - (progn (push mv emvrs) - (push `(,mv (list ,mv)) letbind)))) - (dolist (elm body-forms) ; convert function body - (push (cconv-closure-convert-rec - elm emvrs fvrs-new envs lmenvs) - body-forms-new)) - - (setq body-forms-new - (if letbind `((let ,letbind . ,(reverse body-forms-new))) - (reverse body-forms-new))) - - (cond - ;if no freevars - do nothing - ((null envector) - `(function (lambda ,vars . ,body-forms-new))) - ; 1 free variable - do not build vector - (t - `(internal-make-closure - ,vars ,envector . ,body-forms-new))))) + (cconv-closure-convert-function + fvrs vars emvrs envs lmenvs body-forms form)) (`(internal-make-closure . ,_) (error "Internal byte-compiler error: cconv called twice")) @@ -548,21 +449,21 @@ Returns a form where all lambdas don't have any free variables." ;defun, defmacro (`(,(and sym (or `defun `defmacro)) ,func ,vars . ,body-forms) + + ;; The freevar data was pushed onto cconv-freevars-alist + ;; but we don't need it. + (assert (equal body-forms (caar cconv-freevars-alist))) + (assert (null (cdar cconv-freevars-alist))) + (setq cconv-freevars-alist (cdr cconv-freevars-alist)) + (let ((body-new '()) ; The whole body. (body-forms-new '()) ; Body w\o docstring and interactive. (letbind '())) ; Find mutable arguments. (dolist (elm vars) - (let ((lmutated cconv-captured+mutated) - (ismutated nil)) - (while (and lmutated (not ismutated)) - (when (and (eq (caar lmutated) elm) - (eq (caddar lmutated) form)) - (setq ismutated t)) - (setq lmutated (cdr lmutated))) - (when ismutated - (push elm letbind) - (push elm emvrs)))) + (when (member (cons (list elm) form) cconv-captured+mutated) + (push elm letbind) + (push elm emvrs))) ;Transform body-forms. (when (stringp (car body-forms)) ; Treat docstring well. (push (car body-forms) body-new) @@ -629,12 +530,13 @@ Returns a form where all lambdas don't have any free variables." (setq value (cconv-closure-convert-rec (cadr forms) emvrs fvrs envs lmenvs)) - (if (memq sym emvrs) - (push `(setcar ,sym-new ,value) prognlist) - (if (symbolp sym-new) - (push `(setq ,sym-new ,value) prognlist) - (debug) ;FIXME: When can this be right? - (push `(set ,sym-new ,value) prognlist))) + (cond + ((memq sym emvrs) (push `(setcar ,sym-new ,value) prognlist)) + ((symbolp sym-new) (push `(setq ,sym-new ,value) prognlist)) + ;; This should never happen, but for variables which are + ;; mutated+captured+unused, we may end up trying to `setq' + ;; on a closed-over variable, so just drop the setq. + (t (push value prognlist))) (setq forms (cddr forms))) (if (cdr prognlist) `(progn . ,(reverse prognlist)) @@ -697,54 +599,110 @@ Returns a form where all lambdas don't have any free variables." `(car ,form) ; replace form => (car form) form)))))) -(defun cconv-analyse-function (args body env parentform inclosure) - (dolist (arg args) - (cond - ((byte-compile-not-lexical-var-p arg) - (byte-compile-report-error - (format "Argument %S is not a lexical variable" arg))) - ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... - (t (push (list arg inclosure parentform) env)))) ;Push vrs to vars. - (dolist (form body) ;Analyse body forms. - (cconv-analyse-form form env inclosure))) +(unless (fboundp 'byte-compile-not-lexical-var-p) + ;; Only used to test the code in non-lexbind Emacs. + (defalias 'byte-compile-not-lexical-var-p 'boundp)) -(defun cconv-analyse-form (form env inclosure) - "Find mutated variables and variables captured by closure. Analyse -lambdas if they are suitable for lambda lifting. +(defun cconv-analyse-use (vardata form) + ;; use = `(,binder ,read ,mutated ,captured ,called) + (pcase vardata + (`(,binder nil ,_ ,_ nil) + ;; FIXME: Don't warn about unused fun-args. + ;; FIXME: Don't warn about uninterned vars or _ vars. + ;; FIXME: This gives warnings in the wrong order and with wrong line + ;; number and without function name info. + (byte-compile-log-warning (format "Unused variable %S" (car binder)))) + ;; If it's unused, there's no point converting it into a cons-cell, even if + ;; it's captures and mutated. + (`(,binder ,_ t t ,_) + (push (cons binder form) cconv-captured+mutated)) + (`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t) + ;; This is very rare in typical Elisp code. It's probably not really + ;; worth the trouble to try and use lambda-lifting in Elisp, but + ;; since we coded it up, we might as well use it. + (push (cons binder form) cconv-lambda-candidates)) + (`(,_ ,_ ,_ ,_ ,_) nil) + (dontcare))) + +(defun cconv-analyse-function (args body env parentform) + (let* ((newvars nil) + (freevars (list body)) + ;; We analyze the body within a new environment where all uses are + ;; nil, so we can distinguish uses within that function from uses + ;; outside of it. + (envcopy + (mapcar (lambda (vdata) (list (car vdata) nil nil nil nil)) env)) + (newenv envcopy)) + ;; Push it before recursing, so cconv-freevars-alist contains entries in + ;; the order they'll be used by closure-convert-rec. + (push freevars cconv-freevars-alist) + (dolist (arg args) + (cond + ((byte-compile-not-lexical-var-p arg) + (byte-compile-report-error + (format "Argument %S is not a lexical variable" arg))) + ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... + (t (let ((varstruct (list arg nil nil nil nil))) + (push (cons (list arg) (cdr varstruct)) newvars) + (push varstruct newenv))))) + (dolist (form body) ;Analyse body forms. + (cconv-analyse-form form newenv)) + ;; Summarize resulting data about arguments. + (dolist (vardata newvars) + (cconv-analyse-use vardata parentform)) + ;; Transfer uses collected in `envcopy' (via `newenv') back to `env'; + ;; and compute free variables. + (while env + (assert (and envcopy (eq (caar env) (caar envcopy)))) + (let ((free nil) + (x (cdr (car env))) + (y (cdr (car envcopy)))) + (while x + (when (car y) (setcar x t) (setq free t)) + (setq x (cdr x) y (cdr y))) + (when free + (push (caar env) (cdr freevars)) + (setf (nth 3 (car env)) t)) + (setq env (cdr env) envcopy (cdr envcopy)))))) + +(defun cconv-analyse-form (form env) + "Find mutated variables and variables captured by closure. +Analyse lambdas if they are suitable for lambda lifting. -- FORM is a piece of Elisp code after macroexpansion. --- ENV is a list of variables visible in current lexical environment. - Each entry has the form (VAR INCLOSURE BINDER PARENTFORM) - for let-bound vars and (VAR INCLOSURE PARENTFORM) for function arguments. --- INCLOSURE is the nesting level within lambdas." +-- ENV is an alist mapping each enclosing lexical variable to its info. + I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)). +This function does not return anything but instead fills the +`cconv-captured+mutated' and `cconv-lambda-candidates' variables +and updates the data stored in ENV." (pcase form ; let special form (`(,(and (or `let* `let) letsym) ,binders . ,body-forms) (let ((orig-env env) + (newvars nil) (var nil) (value nil)) (dolist (binder binders) (if (not (consp binder)) (progn (setq var binder) ; treat the form (let (x) ...) well + (setq binder (list binder)) (setq value nil)) (setq var (car binder)) (setq value (cadr binder)) - (cconv-analyse-form value (if (eq letsym 'let*) env orig-env) - inclosure)) + (cconv-analyse-form value (if (eq letsym 'let*) env orig-env))) (unless (byte-compile-not-lexical-var-p var) - (let ((varstruct (list var inclosure binder form))) - (push varstruct env) ; Push a new one. + (let ((varstruct (list var nil nil nil nil))) + (push (cons binder (cdr varstruct)) newvars) + (push varstruct env)))) - (pcase value - (`(function (lambda . ,_)) - ;; If var is a function push it to lambda list. - (push varstruct cconv-lambda-candidates))))))) + (dolist (form body-forms) ; Analyse body forms. + (cconv-analyse-form form env)) - (dolist (form body-forms) ; Analyse body forms. - (cconv-analyse-form form env inclosure))) + (dolist (vardata newvars) + (cconv-analyse-use vardata form)))) ; defun special form (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms) @@ -753,33 +711,28 @@ lambdas if they are suitable for lambda lifting. (format "Function %S will ignore its context %S" func (mapcar #'car env)) t :warning)) - (cconv-analyse-function vrs body-forms nil form 0)) + (cconv-analyse-function vrs body-forms nil form)) (`(function (lambda ,vrs . ,body-forms)) - (cconv-analyse-function vrs body-forms env form (1+ inclosure))) + (cconv-analyse-function vrs body-forms env form)) (`(setq . ,forms) ;; If a local variable (member of env) is modified by setq then ;; it is a mutated variable. (while forms (let ((v (assq (car forms) env))) ; v = non nil if visible - (when v - (push v cconv-mutated) - ;; Delete from candidate list for lambda lifting. - (setq cconv-lambda-candidates (delq v cconv-lambda-candidates)) - (unless (eq inclosure (cadr v)) ;Bound in a different closure level. - (push v cconv-captured)))) - (cconv-analyse-form (cadr forms) env inclosure) + (when v (setf (nth 2 v) t))) + (cconv-analyse-form (cadr forms) env) (setq forms (cddr forms)))) (`((lambda . ,_) . ,_) ; first element is lambda expression (dolist (exp `((function ,(car form)) . ,(cdr form))) - (cconv-analyse-form exp env inclosure))) + (cconv-analyse-form exp env))) (`(cond . ,cond-forms) ; cond special form (dolist (forms cond-forms) (dolist (form forms) - (cconv-analyse-form form env inclosure)))) + (cconv-analyse-form form env)))) (`(quote . ,_) nil) ; quote form (`(function . ,_) nil) ; same as quote @@ -788,63 +741,44 @@ lambdas if they are suitable for lambda lifting. ;; FIXME: The bytecode for condition-case forces us to wrap the ;; form and handlers in closures (for handlers, it's probably ;; unavoidable, but not for the protected form). - (setq inclosure (1+ inclosure)) - (cconv-analyse-form protected-form env inclosure) - (push (list var inclosure form) env) + (cconv-analyse-function () (list protected-form) env form) (dolist (handler handlers) - (dolist (form (cdr handler)) - (cconv-analyse-form form env inclosure)))) + (cconv-analyse-function (if var (list var)) (cdr handler) env form))) ;; FIXME: The bytecode for catch forces us to wrap the body. (`(,(or `catch `unwind-protect) ,form . ,body) - (cconv-analyse-form form env inclosure) - (setq inclosure (1+ inclosure)) - (dolist (form body) - (cconv-analyse-form form env inclosure))) + (cconv-analyse-form form env) + (cconv-analyse-function () body env form)) ;; FIXME: The bytecode for save-window-excursion and the lack of ;; bytecode for track-mouse forces us to wrap the body. (`(track-mouse . ,body) - (setq inclosure (1+ inclosure)) - (dolist (form body) - (cconv-analyse-form form env inclosure))) + (cconv-analyse-function () body env form)) (`(,(or `defconst `defvar) ,var ,value . ,_) (push var byte-compile-bound-variables) - (cconv-analyse-form value env inclosure)) + (cconv-analyse-form value env)) (`(,(or `funcall `apply) ,fun . ,args) ;; Here we ignore fun because funcall and apply are the only two ;; functions where we can pass a candidate for lambda lifting as ;; argument. So, if we see fun elsewhere, we'll delete it from ;; lambda candidate list. - (if (symbolp fun) - (let ((lv (assq fun cconv-lambda-candidates))) - (when lv - (unless (eq (cadr lv) inclosure) - (push lv cconv-captured) - ;; If this funcall and the definition of fun are in - ;; different closures - we delete fun from candidate - ;; list, because it is too complicated to manage free - ;; variables in this case. - (setq cconv-lambda-candidates - (delq lv cconv-lambda-candidates))))) - (cconv-analyse-form fun env inclosure)) + (let ((fdata (and (symbolp fun) (assq fun env)))) + (if fdata + (setf (nth 4 fdata) t) + (cconv-analyse-form fun env))) (dolist (form args) - (cconv-analyse-form form env inclosure))) + (cconv-analyse-form form env))) (`(,_ . ,body-forms) ; First element is a function or whatever. (dolist (form body-forms) - (cconv-analyse-form form env inclosure))) + (cconv-analyse-form form env))) ((pred symbolp) (let ((dv (assq form env))) ; dv = declared and visible (when dv - (unless (eq inclosure (cadr dv)) ; capturing condition - (push dv cconv-captured)) - ;; Delete lambda if it is found here, since it escapes. - (setq cconv-lambda-candidates - (delq dv cconv-lambda-candidates))))))) + (setf (nth 1 dv) t)))))) (provide 'cconv) ;;; cconv.el ends here diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 0b2ea81fb64..0bdab919434 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -269,6 +269,7 @@ That buffer should be current already." (setq buffer-undo-list t) (let ((standard-output (current-buffer)) (print-escape-newlines t) + (print-quoted t) ;Doesn't seem to work :-( (print-level 1000) ;8 ;; (print-length 50) ) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 781195d034a..4377797cba8 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -1,4 +1,4 @@ -;;; macroexp.el --- Additional macro-expansion support +;;; macroexp.el --- Additional macro-expansion support -*- lexical-binding: t -*- ;; ;; Copyright (C) 2004-2011 Free Software Foundation, Inc. ;; @@ -108,7 +108,14 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexpand (macroexpand-all-forms form 1) macroexpand-all-environment) ;; Normal form; get its expansion, and then expand arguments. - (setq form (macroexpand form macroexpand-all-environment)) + (let ((new-form (macroexpand form macroexpand-all-environment))) + (when (and (not (eq form new-form)) ;It was a macro call. + (car-safe form) + (symbolp (car form)) + (get (car form) 'byte-obsolete-info) + (fboundp 'byte-compile-warn-obsolete)) + (byte-compile-warn-obsolete (car form))) + (setq form new-form)) (pcase form (`(cond . ,clauses) (maybe-cons 'cond (macroexpand-all-clauses clauses) form)) diff --git a/lisp/follow.el b/lisp/follow.el index 7e6d4e7ee35..7f4093dd442 100644 --- a/lisp/follow.el +++ b/lisp/follow.el @@ -871,8 +871,7 @@ Returns (end-pos end-of-buffer-p)" ;; XEmacs can calculate the end of the window by using ;; the 'guarantee options. GOOD! (let ((end (window-end win t))) - (if (= end (funcall (symbol-function 'point-max) - (window-buffer win))) + (if (= end (point-max (window-buffer win))) (list end t) (list (+ end 1) nil))) ;; Emacs: We have to calculate the end by ourselves. diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 13d10f02b41..59e442a89c3 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -1,4 +1,4 @@ -;;; diff-mode.el --- a mode for viewing/editing context diffs +;;; diff-mode.el --- a mode for viewing/editing context diffs -*- lexical-binding: t -*- ;; Copyright (C) 1998-2011 Free Software Foundation, Inc. @@ -1278,7 +1278,7 @@ a diff with \\[diff-reverse-direction]. (add-hook 'after-change-functions 'diff-after-change-function nil t) (add-hook 'post-command-hook 'diff-post-command-hook nil t)) ;; Neat trick from Dave Love to add more bindings in read-only mode: - (lexical-let ((ro-bind (cons 'buffer-read-only diff-mode-shared-map))) + (let ((ro-bind (cons 'buffer-read-only diff-mode-shared-map))) (add-to-list 'minor-mode-overriding-map-alist ro-bind) ;; Turn off this little trick in case the buffer is put in view-mode. (add-hook 'view-mode-hook diff --git a/src/bytecode.c b/src/bytecode.c index 464bc3d12de..9693a5a9196 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -51,7 +51,7 @@ by Hallvard: * * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. */ -/* #define BYTE_CODE_SAFE */ +#define BYTE_CODE_SAFE 1 /* #define BYTE_CODE_METER */ From 39605a343b566a1a72e0afb61f96d085c2ef8054 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 26 Feb 2011 16:01:02 -0500 Subject: [PATCH 23/45] =?UTF-8?q?*=20lisp/emacs-lisp/cconv.el=20(cconv-clo?= =?UTF-8?q?sure-convert-rec):=20Fix=20last=20change=20for=20=CE=BB-lift=20?= =?UTF-8?q?candidates=20that=20end=20up=20not=20=CE=BB-lifted.?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit --- lisp/ChangeLog | 3 +++ lisp/emacs-lisp/cconv.el | 13 +++++++++---- 2 files changed, 12 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 1b5e9400a8c..4a22b148469 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,8 @@ 2011-02-26 Stefan Monnier + * emacs-lisp/cconv.el (cconv-closure-convert-rec): Fix last change for + λ-lift candidates that end up not λ-lifted. + * emacs-lisp/cconv.el: Compute freevars in cconv-analyse. (cconv-mutated, cconv-captured): Remove. (cconv-captured+mutated, cconv-lambda-candidates): Don't give them diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 0e4b5d31699..006e2ef904c 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -1,4 +1,4 @@ -;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t -*- +;;; cconv.el --- Closure conversion for statically scoped Emacs lisp. -*- lexical-binding: t; coding: utf-8 -*- ;; Copyright (C) 2011 Free Software Foundation, Inc. @@ -261,7 +261,8 @@ Returns a form where all lambdas don't have any free variables." (eq (car (cadr value)) 'lambda))) (assert (equal (cddr (cadr value)) (caar cconv-freevars-alist))) - (let* ((fv (cdr (pop cconv-freevars-alist))) + ;; Peek at the freevars to decide whether to λ-lift. + (let* ((fv (cdr (car cconv-freevars-alist))) (funargs (cadr (cadr value))) (funcvars (append fv funargs)) (funcbodies (cddadr value)) ; function bodies @@ -269,10 +270,14 @@ Returns a form where all lambdas don't have any free variables." ; lambda lifting condition (if (or (not fv) (< cconv-liftwhen (length funcvars))) ; do not lift - (cconv-closure-convert-rec - value emvrs fvrs envs lmenvs) + (cconv-closure-convert-rec + value emvrs fvrs envs lmenvs) ; lift (progn + (setq cconv-freevars-alist + ;; Now that we know we'll λ-lift, consume the + ;; freevar data. + (cdr cconv-freevars-alist)) (dolist (elm2 funcbodies) (push ; convert function bodies (cconv-closure-convert-rec From d032d5e7dfabfae60f3304da02c97cd1e189b9a2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 1 Mar 2011 00:03:24 -0500 Subject: [PATCH 24/45] * doc/lispref/variables.texi (Scope): Mention the availability of lexbind. (Lexical Binding): New node. * doc/lispref/eval.texi (Eval): Add `eval's new `lexical' arg. * lisp/emacs-lisp/cconv.el (cconv-liftwhen): Increase threshold. (cconv-closure-convert-rec): Convert interactive spec in empty lexenv. (cconv-analyse-use): Improve unused vars warnings. (cconv-analyse-form): Analyze interactive spec in empty lexenv. * lisp/emacs-lisp/bytecomp.el (byte-compile-lambda): Always byte-compile the interactive spec in lexical-binding mode. (byte-compile-refresh-preloaded): Don't reload byte-compiler files. * lisp/custom.el (custom-initialize-default): Use defvar. (custom-declare-variable): Set the special-variable-p flag. * lisp/help-fns.el (help-make-usage): Drop leading underscores. * lisp/dired.el (dired-revert, dired-make-relative): Mark unused args. (dired-unmark-all-files): Remove unused var `query'. (dired-overwrite-confirmed): Declare. (dired-restore-desktop-buffer): Don't use dynamically scoped arg names. * lisp/mpc.el: Mark unused args. (mpc--faster-toggle): Remove unused var `songnb'. * lisp/server.el (server-kill-buffer-running): Move before first use. * lisp/minibuffer.el: Mark unused args. * src/callint.c (quotify_arg): Simplify the logic. (Fcall_interactively): Use lexical binding when evaluating the interactive spec of a lexically bound function. --- aclocal.m4 | 4 +- configure | 795 +++++++++++++++++++----------------- doc/lispref/ChangeLog | 6 + doc/lispref/elisp.texi | 3 +- doc/lispref/eval.texi | 10 +- doc/lispref/variables.texi | 111 +++-- lisp/ChangeLog | 30 ++ lisp/ChangeLog.funvec | 10 - lisp/Makefile.in | 3 + lisp/custom.el | 39 +- lisp/dired.el | 22 +- lisp/emacs-lisp/byte-opt.el | 4 + lisp/emacs-lisp/bytecomp.el | 28 +- lisp/emacs-lisp/cconv.el | 126 ++++-- lisp/emacs-lisp/pcase.el | 4 +- lisp/help-fns.el | 7 +- lisp/minibuffer.el | 24 +- lisp/mpc.el | 21 +- lisp/server.el | 15 +- src/ChangeLog | 6 + src/callint.c | 13 +- 21 files changed, 750 insertions(+), 531 deletions(-) delete mode 100644 lisp/ChangeLog.funvec diff --git a/aclocal.m4 b/aclocal.m4 index f66e6979882..880166dc34e 100644 --- a/aclocal.m4 +++ b/aclocal.m4 @@ -13,8 +13,8 @@ m4_ifndef([AC_AUTOCONF_VERSION], [m4_copy([m4_PACKAGE_VERSION], [AC_AUTOCONF_VERSION])])dnl -m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.67],, -[m4_warning([this file was generated for autoconf 2.67. +m4_if(m4_defn([AC_AUTOCONF_VERSION]), [2.68],, +[m4_warning([this file was generated for autoconf 2.68. You have another version of autoconf. It may work, but is not guaranteed to. If you have problems, you may need to regenerate the build system entirely. To do so, use the procedure documented by the package, typically `autoreconf'.])]) diff --git a/configure b/configure index 66a7ca44a80..16673f2ca79 100755 --- a/configure +++ b/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.67 for emacs 24.0.50. +# Generated by GNU Autoconf 2.68 for emacs 24.0.50. # # # Copyright (C) 1992, 1993, 1994, 1995, 1996, 1998, 1999, 2000, 2001, @@ -89,6 +89,7 @@ fi IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. +as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -214,11 +215,18 @@ IFS=$as_save_IFS # We cannot yet assume a decent shell, so we have to provide a # neutralization value for shells without unset; and this also # works around shells that cannot unset nonexistent variables. + # Preserve -v and -x to the replacement shell. BASH_ENV=/dev/null ENV=/dev/null (unset BASH_ENV) >/dev/null 2>&1 && unset BASH_ENV ENV export CONFIG_SHELL - exec "$CONFIG_SHELL" "$as_myself" ${1+"$@"} + case $- in # (((( + *v*x* | *x*v* ) as_opts=-vx ;; + *v* ) as_opts=-v ;; + *x* ) as_opts=-x ;; + * ) as_opts= ;; + esac + exec "$CONFIG_SHELL" $as_opts "$as_myself" ${1+"$@"} fi if test x$as_have_required = xno; then : @@ -1153,6 +1161,9 @@ LDFLAGS LIBS CPPFLAGS CPP +CPPFLAGS +CPP +CPPFLAGS XMKMF' @@ -1558,7 +1569,7 @@ Try \`$0 --help' for more information" $as_echo "$as_me: WARNING: you should use --build, --host, --target" >&2 expr "x$ac_option" : ".*[^-._$as_cr_alnum]" >/dev/null && $as_echo "$as_me: WARNING: invalid host type: $ac_option" >&2 - : ${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option} + : "${build_alias=$ac_option} ${host_alias=$ac_option} ${target_alias=$ac_option}" ;; esac @@ -1932,7 +1943,7 @@ test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF emacs configure 24.0.50 -generated by GNU Autoconf 2.67 +generated by GNU Autoconf 2.68 Copyright (C) 2010 Free Software Foundation, Inc. This configure script is free software; the Free Software Foundation @@ -1978,7 +1989,7 @@ sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_compile @@ -2015,7 +2026,7 @@ sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=1 fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_cpp @@ -2028,10 +2039,10 @@ fi ac_fn_c_check_header_mongrel () { as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack - if eval "test \"\${$3+set}\"" = set; then : + if eval \${$3+:} false; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval "test \"\${$3+set}\"" = set; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 fi eval ac_res=\$$3 @@ -2094,7 +2105,7 @@ $as_echo "$as_me: WARNING: $2: proceeding with the compiler's result" >&2;} esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval "test \"\${$3+set}\"" = set; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else eval "$3=\$ac_header_compiler" @@ -2103,7 +2114,7 @@ eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_mongrel @@ -2144,7 +2155,7 @@ sed 's/^/| /' conftest.$ac_ext >&5 ac_retval=$ac_status fi rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_run @@ -2158,7 +2169,7 @@ ac_fn_c_check_header_compile () as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval "test \"\${$3+set}\"" = set; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2176,7 +2187,7 @@ fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_compile @@ -2221,7 +2232,7 @@ fi # interfere with the next link command; also delete a directory that is # left behind by Apple's compiler. We do this before executing the actions. rm -rf conftest.dSYM conftest_ipa8_conftest.oo - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_try_link @@ -2237,7 +2248,7 @@ ac_fn_c_check_decl () as_decl_use=`echo $2|sed -e 's/(/((/' -e 's/)/) 0&/' -e 's/,/) 0& (/g'` { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $as_decl_name is declared" >&5 $as_echo_n "checking whether $as_decl_name is declared... " >&6; } -if eval "test \"\${$3+set}\"" = set; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2268,7 +2279,7 @@ fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_decl @@ -2280,7 +2291,7 @@ ac_fn_c_check_header_preproc () as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval "test \"\${$3+set}\"" = set; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2297,7 +2308,7 @@ fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_header_preproc @@ -2310,7 +2321,7 @@ ac_fn_c_check_member () as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2.$3" >&5 $as_echo_n "checking for $2.$3... " >&6; } -if eval "test \"\${$4+set}\"" = set; then : +if eval \${$4+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2354,7 +2365,7 @@ fi eval ac_res=\$$4 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_member @@ -2366,7 +2377,7 @@ ac_fn_c_check_func () as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval "test \"\${$3+set}\"" = set; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -2421,7 +2432,7 @@ fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_func @@ -2434,7 +2445,7 @@ ac_fn_c_check_type () as_lineno=${as_lineno-"$1"} as_lineno_stack=as_lineno_stack=$as_lineno_stack { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $2" >&5 $as_echo_n "checking for $2... " >&6; } -if eval "test \"\${$3+set}\"" = set; then : +if eval \${$3+:} false; then : $as_echo_n "(cached) " >&6 else eval "$3=no" @@ -2475,7 +2486,7 @@ fi eval ac_res=\$$3 { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_res" >&5 $as_echo "$ac_res" >&6; } - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno } # ac_fn_c_check_type @@ -2652,7 +2663,7 @@ rm -f core *.core core.conftest.* gmon.out bb.out conftest$ac_exeext \ rm -f conftest.val fi - eval $as_lineno_stack; test "x$as_lineno_stack" = x && { as_lineno=; unset as_lineno;} + eval $as_lineno_stack; ${as_lineno_stack:+:} unset as_lineno as_fn_set_status $ac_retval } # ac_fn_c_compute_int @@ -2661,7 +2672,7 @@ This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. It was created by emacs $as_me 24.0.50, which was -generated by GNU Autoconf 2.67. Invocation command line was +generated by GNU Autoconf 2.68. Invocation command line was $ $0 $@ @@ -2919,7 +2930,7 @@ $as_echo "$as_me: loading site script $ac_site_file" >&6;} || { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "failed to load site script $ac_site_file -See \`config.log' for more details" "$LINENO" 5 ; } +See \`config.log' for more details" "$LINENO" 5; } fi done @@ -3071,7 +3082,7 @@ ac_configure="$SHELL $ac_aux_dir/configure" # Please don't use this var. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a BSD-compatible install" >&5 $as_echo_n "checking for a BSD-compatible install... " >&6; } if test -z "$INSTALL"; then -if test "${ac_cv_path_install+set}" = set; then : +if ${ac_cv_path_install+:} false; then : $as_echo_n "(cached) " >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3158,11 +3169,11 @@ am_lf=' ' case `pwd` in *[\\\"\#\$\&\'\`$am_lf]*) - as_fn_error $? "unsafe absolute working directory name" "$LINENO" 5 ;; + as_fn_error $? "unsafe absolute working directory name" "$LINENO" 5;; esac case $srcdir in *[\\\"\#\$\&\'\`$am_lf\ \ ]*) - as_fn_error $? "unsafe srcdir value: \`$srcdir'" "$LINENO" 5 ;; + as_fn_error $? "unsafe srcdir value: \`$srcdir'" "$LINENO" 5;; esac # Do `set' in a subshell so we don't clobber the current shell's @@ -3248,7 +3259,7 @@ if test "$cross_compiling" != no; then set dummy ${ac_tool_prefix}strip; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_STRIP+set}" = set; then : +if ${ac_cv_prog_STRIP+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$STRIP"; then @@ -3288,7 +3299,7 @@ if test -z "$ac_cv_prog_STRIP"; then set dummy strip; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_STRIP+set}" = set; then : +if ${ac_cv_prog_ac_ct_STRIP+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_STRIP"; then @@ -3341,7 +3352,7 @@ INSTALL_STRIP_PROGRAM="\$(install_sh) -c -s" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for a thread-safe mkdir -p" >&5 $as_echo_n "checking for a thread-safe mkdir -p... " >&6; } if test -z "$MKDIR_P"; then - if test "${ac_cv_path_mkdir+set}" = set; then : + if ${ac_cv_path_mkdir+:} false; then : $as_echo_n "(cached) " >&6 else as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -3393,7 +3404,7 @@ do set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_AWK+set}" = set; then : +if ${ac_cv_prog_AWK+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$AWK"; then @@ -3433,7 +3444,7 @@ done $as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } set x ${MAKE-make} ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` -if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\"" = set; then : +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : $as_echo_n "(cached) " >&6 else cat >conftest.make <<\_ACEOF @@ -3991,7 +4002,7 @@ do stringfreelist) ac_gc_check_string_free_list=1 ;; xmallocoverrun) ac_xmalloc_overrun=1 ;; conslist) ac_gc_check_cons_list=1 ;; - *) as_fn_error $? "unknown check category $check" "$LINENO" 5 ;; + *) as_fn_error $? "unknown check category $check" "$LINENO" 5 ;; esac done IFS="$ac_save_IFS" @@ -4110,7 +4121,7 @@ $SHELL "$ac_aux_dir/config.sub" sun4 >/dev/null 2>&1 || { $as_echo "$as_me:${as_lineno-$LINENO}: checking build system type" >&5 $as_echo_n "checking build system type... " >&6; } -if test "${ac_cv_build+set}" = set; then : +if ${ac_cv_build+:} false; then : $as_echo_n "(cached) " >&6 else ac_build_alias=$build_alias @@ -4126,7 +4137,7 @@ fi $as_echo "$ac_cv_build" >&6; } case $ac_cv_build in *-*-*) ;; -*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5 ;; +*) as_fn_error $? "invalid value of canonical build" "$LINENO" 5;; esac build=$ac_cv_build ac_save_IFS=$IFS; IFS='-' @@ -4144,7 +4155,7 @@ case $build_os in *\ *) build_os=`echo "$build_os" | sed 's/ /-/g'`;; esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking host system type" >&5 $as_echo_n "checking host system type... " >&6; } -if test "${ac_cv_host+set}" = set; then : +if ${ac_cv_host+:} false; then : $as_echo_n "(cached) " >&6 else if test "x$host_alias" = x; then @@ -4159,7 +4170,7 @@ fi $as_echo "$ac_cv_host" >&6; } case $ac_cv_host in *-*-*) ;; -*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5 ;; +*) as_fn_error $? "invalid value of canonical host" "$LINENO" 5;; esac host=$ac_cv_host ac_save_IFS=$IFS; IFS='-' @@ -4441,7 +4452,7 @@ if test -n "$ac_tool_prefix"; then set dummy ${ac_tool_prefix}gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -4481,7 +4492,7 @@ if test -z "$ac_cv_prog_CC"; then set dummy gcc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -4534,7 +4545,7 @@ if test -z "$CC"; then set dummy ${ac_tool_prefix}cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -4574,7 +4585,7 @@ if test -z "$CC"; then set dummy cc; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -4633,7 +4644,7 @@ if test -z "$CC"; then set dummy $ac_tool_prefix$ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_CC+set}" = set; then : +if ${ac_cv_prog_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$CC"; then @@ -4677,7 +4688,7 @@ do set dummy $ac_prog; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_CC+set}" = set; then : +if ${ac_cv_prog_ac_ct_CC+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_CC"; then @@ -4732,7 +4743,7 @@ fi test -z "$CC" && { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "no acceptable C compiler found in \$PATH -See \`config.log' for more details" "$LINENO" 5 ; } +See \`config.log' for more details" "$LINENO" 5; } # Provide some information about the compiler. $as_echo "$as_me:${as_lineno-$LINENO}: checking for C compiler version" >&5 @@ -4847,7 +4858,7 @@ sed 's/^/| /' conftest.$ac_ext >&5 { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error 77 "C compiler cannot create executables -See \`config.log' for more details" "$LINENO" 5 ; } +See \`config.log' for more details" "$LINENO" 5; } else { $as_echo "$as_me:${as_lineno-$LINENO}: result: yes" >&5 $as_echo "yes" >&6; } @@ -4890,7 +4901,7 @@ else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of executables: cannot compile and link -See \`config.log' for more details" "$LINENO" 5 ; } +See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest conftest$ac_cv_exeext { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_exeext" >&5 @@ -4949,7 +4960,7 @@ $as_echo "$ac_try_echo"; } >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot run C compiled programs. If you meant to cross compile, use \`--host'. -See \`config.log' for more details" "$LINENO" 5 ; } +See \`config.log' for more details" "$LINENO" 5; } fi fi fi @@ -4960,7 +4971,7 @@ rm -f conftest.$ac_ext conftest$ac_cv_exeext conftest.out ac_clean_files=$ac_clean_files_save { $as_echo "$as_me:${as_lineno-$LINENO}: checking for suffix of object files" >&5 $as_echo_n "checking for suffix of object files... " >&6; } -if test "${ac_cv_objext+set}" = set; then : +if ${ac_cv_objext+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -5001,7 +5012,7 @@ sed 's/^/| /' conftest.$ac_ext >&5 { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "cannot compute suffix of object files: cannot compile -See \`config.log' for more details" "$LINENO" 5 ; } +See \`config.log' for more details" "$LINENO" 5; } fi rm -f conftest.$ac_cv_objext conftest.$ac_ext fi @@ -5011,7 +5022,7 @@ OBJEXT=$ac_cv_objext ac_objext=$OBJEXT { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using the GNU C compiler" >&5 $as_echo_n "checking whether we are using the GNU C compiler... " >&6; } -if test "${ac_cv_c_compiler_gnu+set}" = set; then : +if ${ac_cv_c_compiler_gnu+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -5048,7 +5059,7 @@ ac_test_CFLAGS=${CFLAGS+set} ac_save_CFLAGS=$CFLAGS { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $CC accepts -g" >&5 $as_echo_n "checking whether $CC accepts -g... " >&6; } -if test "${ac_cv_prog_cc_g+set}" = set; then : +if ${ac_cv_prog_cc_g+:} false; then : $as_echo_n "(cached) " >&6 else ac_save_c_werror_flag=$ac_c_werror_flag @@ -5126,7 +5137,7 @@ else fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $CC option to accept ISO C89" >&5 $as_echo_n "checking for $CC option to accept ISO C89... " >&6; } -if test "${ac_cv_prog_cc_c89+set}" = set; then : +if ${ac_cv_prog_cc_c89+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_prog_cc_c89=no @@ -5287,7 +5298,7 @@ depcc="$CC" am_compiler_list= { $as_echo "$as_me:${as_lineno-$LINENO}: checking dependency style of $depcc" >&5 $as_echo_n "checking dependency style of $depcc... " >&6; } -if test "${am_cv_CC_dependencies_compiler_type+set}" = set; then : +if ${am_cv_CC_dependencies_compiler_type+:} false; then : $as_echo_n "(cached) " >&6 else if test -z "$AMDEP_TRUE" && test -f "$am_depcomp"; then @@ -5419,7 +5430,7 @@ $as_echo_n "checking whether cc understands -c and -o together... " >&6; } fi set dummy $CC; ac_cc=`$as_echo "$2" | sed 's/[^a-zA-Z0-9_]/_/g;s/^[0-9]/_/'` -if eval "test \"\${ac_cv_prog_cc_${ac_cc}_c_o+set}\"" = set; then : +if eval \${ac_cv_prog_cc_${ac_cc}_c_o+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -5543,7 +5554,7 @@ if test -n "$ac_tool_prefix"; then set dummy ${ac_tool_prefix}ranlib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_RANLIB+set}" = set; then : +if ${ac_cv_prog_RANLIB+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$RANLIB"; then @@ -5583,7 +5594,7 @@ if test -z "$ac_cv_prog_RANLIB"; then set dummy ranlib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then : +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_RANLIB"; then @@ -5643,7 +5654,7 @@ if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then - if test "${ac_cv_prog_CPP+set}" = set; then : + if ${ac_cv_prog_CPP+:} false; then : $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded @@ -5759,7 +5770,7 @@ else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5 ; } +See \`config.log' for more details" "$LINENO" 5; } fi ac_ext=c @@ -5771,7 +5782,7 @@ ac_compiler_gnu=$ac_cv_c_compiler_gnu { $as_echo "$as_me:${as_lineno-$LINENO}: checking for grep that handles long lines and -e" >&5 $as_echo_n "checking for grep that handles long lines and -e... " >&6; } -if test "${ac_cv_path_GREP+set}" = set; then : +if ${ac_cv_path_GREP+:} false; then : $as_echo_n "(cached) " >&6 else if test -z "$GREP"; then @@ -5834,7 +5845,7 @@ $as_echo "$ac_cv_path_GREP" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: checking for egrep" >&5 $as_echo_n "checking for egrep... " >&6; } -if test "${ac_cv_path_EGREP+set}" = set; then : +if ${ac_cv_path_EGREP+:} false; then : $as_echo_n "(cached) " >&6 else if echo a | $GREP -E '(a|b)' >/dev/null 2>&1 @@ -5901,7 +5912,7 @@ $as_echo "$ac_cv_path_EGREP" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 $as_echo_n "checking for ANSI C header files... " >&6; } -if test "${ac_cv_header_stdc+set}" = set; then : +if ${ac_cv_header_stdc+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6032,7 +6043,7 @@ done ac_fn_c_check_header_mongrel "$LINENO" "minix/config.h" "ac_cv_header_minix_config_h" "$ac_includes_default" -if test "x$ac_cv_header_minix_config_h" = x""yes; then : +if test "x$ac_cv_header_minix_config_h" = xyes; then : MINIX=yes else MINIX= @@ -6062,7 +6073,7 @@ $as_echo "#define _XOPEN_SOURCE 500" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether it is safe to define __EXTENSIONS__" >&5 $as_echo_n "checking whether it is safe to define __EXTENSIONS__... " >&6; } -if test "${ac_cv_safe_to_define___extensions__+set}" = set; then : +if ${ac_cv_safe_to_define___extensions__+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6146,7 +6157,7 @@ if test x"$GCC" != xyes && test x"$emacs_check_sunpro_c" = xyes && \ test x"$CPP" = x; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether we are using a Sun C compiler" >&5 $as_echo_n "checking whether we are using a Sun C compiler... " >&6; } - if test "${emacs_cv_sunpro_c+set}" = set; then : + if ${emacs_cv_sunpro_c+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -6314,7 +6325,7 @@ if test -n "$CPP" && test -d "$CPP"; then CPP= fi if test -z "$CPP"; then - if test "${ac_cv_prog_CPP+set}" = set; then : + if ${ac_cv_prog_CPP+:} false; then : $as_echo_n "(cached) " >&6 else # Double quotes because CPP needs to be expanded @@ -6430,7 +6441,7 @@ else { { $as_echo "$as_me:${as_lineno-$LINENO}: error: in \`$ac_pwd':" >&5 $as_echo "$as_me: error: in \`$ac_pwd':" >&2;} as_fn_error $? "C preprocessor \"$CPP\" fails sanity check -See \`config.log' for more details" "$LINENO" 5 ; } +See \`config.log' for more details" "$LINENO" 5; } fi ac_ext=c @@ -6446,7 +6457,7 @@ if test "x$RANLIB" = x; then set dummy ${ac_tool_prefix}ranlib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_RANLIB+set}" = set; then : +if ${ac_cv_prog_RANLIB+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$RANLIB"; then @@ -6486,7 +6497,7 @@ if test -z "$ac_cv_prog_RANLIB"; then set dummy ranlib; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_ac_ct_RANLIB+set}" = set; then : +if ${ac_cv_prog_ac_ct_RANLIB+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$ac_ct_RANLIB"; then @@ -6541,7 +6552,7 @@ fi ## is running in i386 mode, we can help them out. if test "$machine" = "amdx86-64"; then ac_fn_c_check_decl "$LINENO" "i386" "ac_cv_have_decl_i386" "$ac_includes_default" -if test "x$ac_cv_have_decl_i386" = x""yes; then : +if test "x$ac_cv_have_decl_i386" = xyes; then : fi @@ -6556,7 +6567,7 @@ fi set dummy install-info; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_INSTALL_INFO+set}" = set; then : +if ${ac_cv_path_INSTALL_INFO+:} false; then : $as_echo_n "(cached) " >&6 else case $INSTALL_INFO in @@ -6596,7 +6607,7 @@ fi set dummy install-info; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_INSTALL_INFO+set}" = set; then : +if ${ac_cv_path_INSTALL_INFO+:} false; then : $as_echo_n "(cached) " >&6 else case $INSTALL_INFO in @@ -6636,7 +6647,7 @@ fi set dummy install-info; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_INSTALL_INFO+set}" = set; then : +if ${ac_cv_path_INSTALL_INFO+:} false; then : $as_echo_n "(cached) " >&6 else case $INSTALL_INFO in @@ -6677,7 +6688,7 @@ fi set dummy gzip; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_GZIP_PROG+set}" = set; then : +if ${ac_cv_path_GZIP_PROG+:} false; then : $as_echo_n "(cached) " >&6 else case $GZIP_PROG in @@ -6720,7 +6731,7 @@ fi set dummy makeinfo; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_MAKEINFO+set}" = set; then : +if ${ac_cv_path_MAKEINFO+:} false; then : $as_echo_n "(cached) " >&6 else case $MAKEINFO in @@ -6926,7 +6937,7 @@ esac C_SWITCH_MACHINE= if test "$machine" = "alpha"; then ac_fn_c_check_decl "$LINENO" "__ELF__" "ac_cv_have_decl___ELF__" "$ac_includes_default" -if test "x$ac_cv_have_decl___ELF__" = x""yes; then : +if test "x$ac_cv_have_decl___ELF__" = xyes; then : fi @@ -6994,7 +7005,7 @@ if test "$enable_largefile" != no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for special C compiler options needed for large files" >&5 $as_echo_n "checking for special C compiler options needed for large files... " >&6; } -if test "${ac_cv_sys_largefile_CC+set}" = set; then : +if ${ac_cv_sys_largefile_CC+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_sys_largefile_CC=no @@ -7045,7 +7056,7 @@ $as_echo "$ac_cv_sys_largefile_CC" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _FILE_OFFSET_BITS value needed for large files" >&5 $as_echo_n "checking for _FILE_OFFSET_BITS value needed for large files... " >&6; } -if test "${ac_cv_sys_file_offset_bits+set}" = set; then : +if ${ac_cv_sys_file_offset_bits+:} false; then : $as_echo_n "(cached) " >&6 else while :; do @@ -7114,7 +7125,7 @@ rm -rf conftest* if test $ac_cv_sys_file_offset_bits = unknown; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGE_FILES value needed for large files" >&5 $as_echo_n "checking for _LARGE_FILES value needed for large files... " >&6; } -if test "${ac_cv_sys_large_files+set}" = set; then : +if ${ac_cv_sys_large_files+:} false; then : $as_echo_n "(cached) " >&6 else while :; do @@ -7282,7 +7293,7 @@ done # Emulation library used on NetBSD. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _oss_ioctl in -lossaudio" >&5 $as_echo_n "checking for _oss_ioctl in -lossaudio... " >&6; } -if test "${ac_cv_lib_ossaudio__oss_ioctl+set}" = set; then : +if ${ac_cv_lib_ossaudio__oss_ioctl+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -7316,7 +7327,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ossaudio__oss_ioctl" >&5 $as_echo "$ac_cv_lib_ossaudio__oss_ioctl" >&6; } -if test "x$ac_cv_lib_ossaudio__oss_ioctl" = x""yes; then : +if test "x$ac_cv_lib_ossaudio__oss_ioctl" = xyes; then : LIBSOUND=-lossaudio else LIBSOUND= @@ -7333,7 +7344,7 @@ fi set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -7537,7 +7548,7 @@ fi for ac_header in term.h do : ac_fn_c_check_header_preproc "$LINENO" "term.h" "ac_cv_header_term_h" -if test "x$ac_cv_header_term_h" = x""yes; then : +if test "x$ac_cv_header_term_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_TERM_H 1 _ACEOF @@ -7548,7 +7559,7 @@ done { $as_echo "$as_me:${as_lineno-$LINENO}: checking for ANSI C header files" >&5 $as_echo_n "checking for ANSI C header files... " >&6; } -if test "${ac_cv_header_stdc+set}" = set; then : +if ${ac_cv_header_stdc+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7660,7 +7671,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether time.h and sys/time.h may both be included" >&5 $as_echo_n "checking whether time.h and sys/time.h may both be included... " >&6; } -if test "${ac_cv_header_time+set}" = set; then : +if ${ac_cv_header_time+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7694,7 +7705,7 @@ $as_echo "#define TIME_WITH_SYS_TIME 1" >>confdefs.h fi ac_fn_c_check_decl "$LINENO" "sys_siglist" "ac_cv_have_decl_sys_siglist" "$ac_includes_default" -if test "x$ac_cv_have_decl_sys_siglist" = x""yes; then : +if test "x$ac_cv_have_decl_sys_siglist" = xyes; then : ac_have_decl=1 else ac_have_decl=0 @@ -7707,7 +7718,7 @@ _ACEOF if test $ac_cv_have_decl_sys_siglist != yes; then # For Tru64, at least: ac_fn_c_check_decl "$LINENO" "__sys_siglist" "ac_cv_have_decl___sys_siglist" "$ac_includes_default" -if test "x$ac_cv_have_decl___sys_siglist" = x""yes; then : +if test "x$ac_cv_have_decl___sys_siglist" = xyes; then : ac_have_decl=1 else ac_have_decl=0 @@ -7725,7 +7736,7 @@ $as_echo "#define sys_siglist __sys_siglist" >>confdefs.h fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sys/wait.h that is POSIX.1 compatible" >&5 $as_echo_n "checking for sys/wait.h that is POSIX.1 compatible... " >&6; } -if test "${ac_cv_header_sys_wait_h+set}" = set; then : +if ${ac_cv_header_sys_wait_h+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7767,7 +7778,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct utimbuf" >&5 $as_echo_n "checking for struct utimbuf... " >&6; } -if test "${emacs_cv_struct_utimbuf+set}" = set; then : +if ${emacs_cv_struct_utimbuf+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7810,7 +7821,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking return type of signal handlers" >&5 $as_echo_n "checking return type of signal handlers... " >&6; } -if test "${ac_cv_type_signal+set}" = set; then : +if ${ac_cv_type_signal+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7844,7 +7855,7 @@ _ACEOF { $as_echo "$as_me:${as_lineno-$LINENO}: checking for speed_t" >&5 $as_echo_n "checking for speed_t... " >&6; } -if test "${emacs_cv_speed_t+set}" = set; then : +if ${emacs_cv_speed_t+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7875,7 +7886,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timeval" >&5 $as_echo_n "checking for struct timeval... " >&6; } -if test "${emacs_cv_struct_timeval+set}" = set; then : +if ${emacs_cv_struct_timeval+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7916,7 +7927,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct exception" >&5 $as_echo_n "checking for struct exception... " >&6; } -if test "${emacs_cv_struct_exception+set}" = set; then : +if ${emacs_cv_struct_exception+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -7949,7 +7960,7 @@ fi for ac_header in sys/socket.h do : ac_fn_c_check_header_mongrel "$LINENO" "sys/socket.h" "ac_cv_header_sys_socket_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_socket_h" = x""yes; then : +if test "x$ac_cv_header_sys_socket_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SYS_SOCKET_H 1 _ACEOF @@ -7965,7 +7976,7 @@ do : #include #endif " -if test "x$ac_cv_header_net_if_h" = x""yes; then : +if test "x$ac_cv_header_net_if_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_NET_IF_H 1 _ACEOF @@ -7977,7 +7988,7 @@ done { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether struct tm is in sys/time.h or time.h" >&5 $as_echo_n "checking whether struct tm is in sys/time.h or time.h... " >&6; } -if test "${ac_cv_struct_tm+set}" = set; then : +if ${ac_cv_struct_tm+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -8014,7 +8025,7 @@ ac_fn_c_check_member "$LINENO" "struct tm" "tm_zone" "ac_cv_member_struct_tm_tm_ #include <$ac_cv_struct_tm> " -if test "x$ac_cv_member_struct_tm_tm_zone" = x""yes; then : +if test "x$ac_cv_member_struct_tm_tm_zone" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_TM_TM_ZONE 1 @@ -8030,7 +8041,7 @@ $as_echo "#define HAVE_TM_ZONE 1" >>confdefs.h else ac_fn_c_check_decl "$LINENO" "tzname" "ac_cv_have_decl_tzname" "#include " -if test "x$ac_cv_have_decl_tzname" = x""yes; then : +if test "x$ac_cv_have_decl_tzname" = xyes; then : ac_have_decl=1 else ac_have_decl=0 @@ -8042,7 +8053,7 @@ _ACEOF { $as_echo "$as_me:${as_lineno-$LINENO}: checking for tzname" >&5 $as_echo_n "checking for tzname... " >&6; } -if test "${ac_cv_var_tzname+set}" = set; then : +if ${ac_cv_var_tzname+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -8079,7 +8090,7 @@ fi ac_fn_c_check_member "$LINENO" "struct tm" "tm_gmtoff" "ac_cv_member_struct_tm_tm_gmtoff" "#include " -if test "x$ac_cv_member_struct_tm_tm_gmtoff" = x""yes; then : +if test "x$ac_cv_member_struct_tm_tm_gmtoff" = xyes; then : $as_echo "#define HAVE_TM_GMTOFF 1" >>confdefs.h @@ -8093,7 +8104,7 @@ ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_flags" "ac_cv_member_struct_i #include #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_flags" = x""yes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_flags" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_FLAGS 1 @@ -8109,7 +8120,7 @@ ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_hwaddr" "ac_cv_member_struct_ #include #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_hwaddr" = x""yes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_hwaddr" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_HWADDR 1 @@ -8125,7 +8136,7 @@ ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_netmask" "ac_cv_member_struct #include #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_netmask" = x""yes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_netmask" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_NETMASK 1 @@ -8141,7 +8152,7 @@ ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_broadaddr" "ac_cv_member_stru #include #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_broadaddr" = x""yes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_broadaddr" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_BROADADDR 1 @@ -8157,7 +8168,7 @@ ac_fn_c_check_member "$LINENO" "struct ifreq" "ifr_addr" "ac_cv_member_struct_if #include #endif " -if test "x$ac_cv_member_struct_ifreq_ifr_addr" = x""yes; then : +if test "x$ac_cv_member_struct_ifreq_ifr_addr" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_IFREQ_IFR_ADDR 1 @@ -8186,7 +8197,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working volatile" >&5 $as_echo_n "checking for working volatile... " >&6; } -if test "${ac_cv_c_volatile+set}" = set; then : +if ${ac_cv_c_volatile+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -8220,7 +8231,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for an ANSI C-conforming const" >&5 $as_echo_n "checking for an ANSI C-conforming const... " >&6; } -if test "${ac_cv_c_const+set}" = set; then : +if ${ac_cv_c_const+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -8300,7 +8311,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for void * support" >&5 $as_echo_n "checking for void * support... " >&6; } -if test "${emacs_cv_void_star+set}" = set; then : +if ${emacs_cv_void_star+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -8333,7 +8344,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 $as_echo_n "checking whether byte ordering is bigendian... " >&6; } -if test "${ac_cv_c_bigendian+set}" = set; then : +if ${ac_cv_c_bigendian+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_c_bigendian=unknown @@ -8552,13 +8563,13 @@ $as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h ;; #( *) as_fn_error $? "unknown endianness - presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; + presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __attribute__ ((__aligned__ (expr)))" >&5 $as_echo_n "checking for __attribute__ ((__aligned__ (expr)))... " >&6; } -if test "${emacs_cv_attribute_aligned+set}" = set; then : +if ${emacs_cv_attribute_aligned+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -8591,7 +8602,7 @@ fi $as_echo_n "checking whether ${MAKE-make} sets \$(MAKE)... " >&6; } set x ${MAKE-make} ac_make=`$as_echo "$2" | sed 's/+/p/g; s/[^a-zA-Z0-9_]/_/g'` -if eval "test \"\${ac_cv_prog_make_${ac_make}_set+set}\"" = set; then : +if eval \${ac_cv_prog_make_${ac_make}_set+:} false; then : $as_echo_n "(cached) " >&6 else cat >conftest.make <<\_ACEOF @@ -8679,7 +8690,7 @@ deps_frag=$srcdir/src/$deps_frag { $as_echo "$as_me:${as_lineno-$LINENO}: checking for long file names" >&5 $as_echo_n "checking for long file names... " >&6; } -if test "${ac_cv_sys_long_file_names+set}" = set; then : +if ${ac_cv_sys_long_file_names+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_sys_long_file_names=yes @@ -8735,8 +8746,8 @@ if test "x$with_x" = xno; then have_x=disabled else case $x_includes,$x_libraries in #( - *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5 ;; #( - *,NONE | NONE,*) if test "${ac_cv_have_x+set}" = set; then : + *\'*) as_fn_error $? "cannot use X directory names containing '" "$LINENO" 5;; #( + *,NONE | NONE,*) if ${ac_cv_have_x+:} false; then : $as_echo_n "(cached) " >&6 else # One or both of the vars are not set, and there is no cached value. @@ -9019,7 +9030,7 @@ if test "${with_ns}" != no; then TEMACS_LDFLAGS2= fi ac_fn_c_check_header_mongrel "$LINENO" "AppKit/AppKit.h" "ac_cv_header_AppKit_AppKit_h" "$ac_includes_default" -if test "x$ac_cv_header_AppKit_AppKit_h" = x""yes; then : +if test "x$ac_cv_header_AppKit_AppKit_h" = xyes; then : HAVE_NS=yes else as_fn_error $? "\`--with-ns' was specified, but the include @@ -9104,7 +9115,7 @@ if test "$window_system" = none && test "X$with_x" != "Xno"; then set dummy X; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_HAVE_XSERVER+set}" = set; then : +if ${ac_cv_prog_HAVE_XSERVER+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$HAVE_XSERVER"; then @@ -9163,14 +9174,14 @@ esac GNU_MALLOC=yes doug_lea_malloc=yes ac_fn_c_check_func "$LINENO" "malloc_get_state" "ac_cv_func_malloc_get_state" -if test "x$ac_cv_func_malloc_get_state" = x""yes; then : +if test "x$ac_cv_func_malloc_get_state" = xyes; then : else doug_lea_malloc=no fi ac_fn_c_check_func "$LINENO" "malloc_set_state" "ac_cv_func_malloc_set_state" -if test "x$ac_cv_func_malloc_set_state" = x""yes; then : +if test "x$ac_cv_func_malloc_set_state" = xyes; then : else doug_lea_malloc=no @@ -9178,7 +9189,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether __after_morecore_hook exists" >&5 $as_echo_n "checking whether __after_morecore_hook exists... " >&6; } -if test "${emacs_cv_var___after_morecore_hook+set}" = set; then : +if ${emacs_cv_var___after_morecore_hook+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -9283,7 +9294,7 @@ done for ac_func in getpagesize do : ac_fn_c_check_func "$LINENO" "getpagesize" "ac_cv_func_getpagesize" -if test "x$ac_cv_func_getpagesize" = x""yes; then : +if test "x$ac_cv_func_getpagesize" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETPAGESIZE 1 _ACEOF @@ -9293,7 +9304,7 @@ done { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mmap" >&5 $as_echo_n "checking for working mmap... " >&6; } -if test "${ac_cv_func_mmap_fixed_mapped+set}" = set; then : +if ${ac_cv_func_mmap_fixed_mapped+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -9468,7 +9479,7 @@ LIBS="$LIBS_SYSTEM $LIBS" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dnet_ntoa in -ldnet" >&5 $as_echo_n "checking for dnet_ntoa in -ldnet... " >&6; } -if test "${ac_cv_lib_dnet_dnet_ntoa+set}" = set; then : +if ${ac_cv_lib_dnet_dnet_ntoa+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9502,7 +9513,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dnet_dnet_ntoa" >&5 $as_echo "$ac_cv_lib_dnet_dnet_ntoa" >&6; } -if test "x$ac_cv_lib_dnet_dnet_ntoa" = x""yes; then : +if test "x$ac_cv_lib_dnet_dnet_ntoa" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBDNET 1 _ACEOF @@ -9514,7 +9525,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for main in -lXbsd" >&5 $as_echo_n "checking for main in -lXbsd... " >&6; } -if test "${ac_cv_lib_Xbsd_main+set}" = set; then : +if ${ac_cv_lib_Xbsd_main+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9542,14 +9553,14 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xbsd_main" >&5 $as_echo "$ac_cv_lib_Xbsd_main" >&6; } -if test "x$ac_cv_lib_Xbsd_main" = x""yes; then : +if test "x$ac_cv_lib_Xbsd_main" = xyes; then : LD_SWITCH_X_SITE="$LD_SWITCH_X_SITE -lXbsd" fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for cma_open in -lpthreads" >&5 $as_echo_n "checking for cma_open in -lpthreads... " >&6; } -if test "${ac_cv_lib_pthreads_cma_open+set}" = set; then : +if ${ac_cv_lib_pthreads_cma_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -9583,7 +9594,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthreads_cma_open" >&5 $as_echo "$ac_cv_lib_pthreads_cma_open" >&6; } -if test "x$ac_cv_lib_pthreads_cma_open" = x""yes; then : +if test "x$ac_cv_lib_pthreads_cma_open" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBPTHREADS 1 _ACEOF @@ -9610,7 +9621,7 @@ case ${host_os} in aix*) { $as_echo "$as_me:${as_lineno-$LINENO}: checking for -bbigtoc option" >&5 $as_echo_n "checking for -bbigtoc option... " >&6; } -if test "${gdb_cv_bigtoc+set}" = set; then : +if ${gdb_cv_bigtoc+:} false; then : $as_echo_n "(cached) " >&6 else @@ -9784,7 +9795,7 @@ fi if test "${window_system}" = "x11"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking X11 version 6" >&5 $as_echo_n "checking X11 version 6... " >&6; } - if test "${emacs_cv_x11_version_6+set}" = set; then : + if ${emacs_cv_x11_version_6+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -9849,7 +9860,7 @@ if test "${HAVE_X11}" = "yes" || test "${NS_IMPL_GNUSTEP}" = "yes"; then set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -9960,7 +9971,7 @@ if test "${HAVE_X11}" = "yes"; then set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10059,7 +10070,7 @@ $as_echo "#define HAVE_IMAGEMAGICK 1" >>confdefs.h for ac_func in MagickExportImagePixels do : ac_fn_c_check_func "$LINENO" "MagickExportImagePixels" "ac_cv_func_MagickExportImagePixels" -if test "x$ac_cv_func_MagickExportImagePixels" = x""yes; then : +if test "x$ac_cv_func_MagickExportImagePixels" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_MAGICKEXPORTIMAGEPIXELS 1 _ACEOF @@ -10085,7 +10096,7 @@ if test "${with_gtk3}" = "yes"; then set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10191,7 +10202,7 @@ if test "${with_gtk}" = "yes" || test "$USE_X_TOOLKIT" = "maybe"; then set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10296,7 +10307,7 @@ if test x"$pkg_check_gtk" = xyes; then for ac_func in gtk_main do : ac_fn_c_check_func "$LINENO" "gtk_main" "ac_cv_func_gtk_main" -if test "x$ac_cv_func_gtk_main" = x""yes; then : +if test "x$ac_cv_func_gtk_main" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GTK_MAIN 1 _ACEOF @@ -10306,7 +10317,7 @@ done if test "${GTK_COMPILES}" != "yes"; then if test "$USE_X_TOOLKIT" != "maybe"; then - as_fn_error $? "Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?" "$LINENO" 5 ; + as_fn_error $? "Gtk+ wanted, but it does not compile, see config.log. Maybe some x11-devel files missing?" "$LINENO" 5; fi else HAVE_GTK=yes @@ -10344,7 +10355,7 @@ if test "${HAVE_GTK}" = "yes"; then ac_fn_c_check_decl "$LINENO" "GTK_TYPE_FILE_SELECTION" "ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" "$ac_includes_default #include " -if test "x$ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" = x""yes; then : +if test "x$ac_cv_have_decl_GTK_TYPE_FILE_SELECTION" = xyes; then : HAVE_GTK_FILE_SELECTION=yes else HAVE_GTK_FILE_SELECTION=no @@ -10354,7 +10365,7 @@ fi for ac_func in gtk_file_selection_new do : ac_fn_c_check_func "$LINENO" "gtk_file_selection_new" "ac_cv_func_gtk_file_selection_new" -if test "x$ac_cv_func_gtk_file_selection_new" = x""yes; then : +if test "x$ac_cv_func_gtk_file_selection_new" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GTK_FILE_SELECTION_NEW 1 _ACEOF @@ -10368,7 +10379,7 @@ done for ac_header in pthread.h do : ac_fn_c_check_header_mongrel "$LINENO" "pthread.h" "ac_cv_header_pthread_h" "$ac_includes_default" -if test "x$ac_cv_header_pthread_h" = x""yes; then : +if test "x$ac_cv_header_pthread_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_PTHREAD_H 1 _ACEOF @@ -10380,7 +10391,7 @@ done if test "$ac_cv_header_pthread_h"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for pthread_self in -lpthread" >&5 $as_echo_n "checking for pthread_self in -lpthread... " >&6; } -if test "${ac_cv_lib_pthread_pthread_self+set}" = set; then : +if ${ac_cv_lib_pthread_pthread_self+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10414,7 +10425,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_pthread_pthread_self" >&5 $as_echo "$ac_cv_lib_pthread_pthread_self" >&6; } -if test "x$ac_cv_lib_pthread_pthread_self" = x""yes; then : +if test "x$ac_cv_lib_pthread_pthread_self" = xyes; then : HAVE_GTK_AND_PTHREAD=yes fi @@ -10457,7 +10468,7 @@ if test "${with_dbus}" = "yes"; then set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10552,7 +10563,7 @@ $as_echo "#define HAVE_DBUS 1" >>confdefs.h for ac_func in dbus_watch_get_unix_fd do : ac_fn_c_check_func "$LINENO" "dbus_watch_get_unix_fd" "ac_cv_func_dbus_watch_get_unix_fd" -if test "x$ac_cv_func_dbus_watch_get_unix_fd" = x""yes; then : +if test "x$ac_cv_func_dbus_watch_get_unix_fd" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_DBUS_WATCH_GET_UNIX_FD 1 _ACEOF @@ -10574,7 +10585,7 @@ if test "${HAVE_X11}" = "yes" && test "${with_gconf}" = "yes"; then set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10668,7 +10679,7 @@ $as_echo "#define HAVE_GCONF 1" >>confdefs.h for ac_func in g_type_init do : ac_fn_c_check_func "$LINENO" "g_type_init" "ac_cv_func_g_type_init" -if test "x$ac_cv_func_g_type_init" = x""yes; then : +if test "x$ac_cv_func_g_type_init" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_G_TYPE_INIT 1 _ACEOF @@ -10684,7 +10695,7 @@ LIBSELINUX_LIBS= if test "${with_selinux}" = "yes"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for lgetfilecon in -lselinux" >&5 $as_echo_n "checking for lgetfilecon in -lselinux... " >&6; } -if test "${ac_cv_lib_selinux_lgetfilecon+set}" = set; then : +if ${ac_cv_lib_selinux_lgetfilecon+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10718,7 +10729,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_selinux_lgetfilecon" >&5 $as_echo "$ac_cv_lib_selinux_lgetfilecon" >&6; } -if test "x$ac_cv_lib_selinux_lgetfilecon" = x""yes; then : +if test "x$ac_cv_lib_selinux_lgetfilecon" = xyes; then : HAVE_LIBSELINUX=yes else HAVE_LIBSELINUX=no @@ -10742,7 +10753,7 @@ if test "${with_gnutls}" = "yes" ; then set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -10844,7 +10855,7 @@ if test x"${USE_X_TOOLKIT}" = xmaybe || test x"${USE_X_TOOLKIT}" = xLUCID; then if test "$with_xaw3d" != no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for xaw3d" >&5 $as_echo_n "checking for xaw3d... " >&6; } - if test "${emacs_cv_xaw3d+set}" = set; then : + if ${emacs_cv_xaw3d+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -10863,7 +10874,7 @@ _ACEOF if ac_fn_c_try_link "$LINENO"; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XawScrollbarSetThumb in -lXaw3d" >&5 $as_echo_n "checking for XawScrollbarSetThumb in -lXaw3d... " >&6; } -if test "${ac_cv_lib_Xaw3d_XawScrollbarSetThumb+set}" = set; then : +if ${ac_cv_lib_Xaw3d_XawScrollbarSetThumb+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -10897,7 +10908,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xaw3d_XawScrollbarSetThumb" >&5 $as_echo "$ac_cv_lib_Xaw3d_XawScrollbarSetThumb" >&6; } -if test "x$ac_cv_lib_Xaw3d_XawScrollbarSetThumb" = x""yes; then : +if test "x$ac_cv_lib_Xaw3d_XawScrollbarSetThumb" = xyes; then : emacs_cv_xaw3d=yes else emacs_cv_xaw3d=no @@ -10927,7 +10938,7 @@ $as_echo "#define HAVE_XAW3D 1" >>confdefs.h $as_echo "no" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: checking for libXaw" >&5 $as_echo_n "checking for libXaw... " >&6; } - if test "${emacs_cv_xaw+set}" = set; then : + if ${emacs_cv_xaw+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -10973,7 +10984,7 @@ LIBXTR6= if test "${USE_X_TOOLKIT}" != "none"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking X11 toolkit version" >&5 $as_echo_n "checking X11 toolkit version... " >&6; } - if test "${emacs_cv_x11_toolkit_version_6+set}" = set; then : + if ${emacs_cv_x11_toolkit_version_6+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11024,7 +11035,7 @@ $as_echo "before 6" >&6; } fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XmuConvertStandardSelection in -lXmu" >&5 $as_echo_n "checking for XmuConvertStandardSelection in -lXmu... " >&6; } -if test "${ac_cv_lib_Xmu_XmuConvertStandardSelection+set}" = set; then : +if ${ac_cv_lib_Xmu_XmuConvertStandardSelection+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11058,7 +11069,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xmu_XmuConvertStandardSelection" >&5 $as_echo "$ac_cv_lib_Xmu_XmuConvertStandardSelection" >&6; } -if test "x$ac_cv_lib_Xmu_XmuConvertStandardSelection" = x""yes; then : +if test "x$ac_cv_lib_Xmu_XmuConvertStandardSelection" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBXMU 1 _ACEOF @@ -11085,7 +11096,7 @@ if test "${HAVE_X11}" = "yes"; then if test "${USE_X_TOOLKIT}" != "none"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XShapeQueryExtension in -lXext" >&5 $as_echo_n "checking for XShapeQueryExtension in -lXext... " >&6; } -if test "${ac_cv_lib_Xext_XShapeQueryExtension+set}" = set; then : +if ${ac_cv_lib_Xext_XShapeQueryExtension+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11119,7 +11130,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xext_XShapeQueryExtension" >&5 $as_echo "$ac_cv_lib_Xext_XShapeQueryExtension" >&6; } -if test "x$ac_cv_lib_Xext_XShapeQueryExtension" = x""yes; then : +if test "x$ac_cv_lib_Xext_XShapeQueryExtension" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBXEXT 1 _ACEOF @@ -11135,7 +11146,7 @@ LIBXP= if test "${USE_X_TOOLKIT}" = "MOTIF"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Motif version 2.1" >&5 $as_echo_n "checking for Motif version 2.1... " >&6; } -if test "${emacs_cv_motif_version_2_1+set}" = set; then : +if ${emacs_cv_motif_version_2_1+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -11165,7 +11176,7 @@ $as_echo "$emacs_cv_motif_version_2_1" >&6; } if test $emacs_cv_motif_version_2_1 = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpCreateContext in -lXp" >&5 $as_echo_n "checking for XpCreateContext in -lXp... " >&6; } -if test "${ac_cv_lib_Xp_XpCreateContext+set}" = set; then : +if ${ac_cv_lib_Xp_XpCreateContext+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11199,14 +11210,14 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xp_XpCreateContext" >&5 $as_echo "$ac_cv_lib_Xp_XpCreateContext" >&6; } -if test "x$ac_cv_lib_Xp_XpCreateContext" = x""yes; then : +if test "x$ac_cv_lib_Xp_XpCreateContext" = xyes; then : LIBXP=-lXp fi else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for LessTif where some systems put it" >&5 $as_echo_n "checking for LessTif where some systems put it... " >&6; } -if test "${emacs_cv_lesstif+set}" = set; then : +if ${emacs_cv_lesstif+:} false; then : $as_echo_n "(cached) " >&6 else # We put this in CFLAGS temporarily to precede other -I options @@ -11365,7 +11376,7 @@ if test "${HAVE_X11}" = "yes"; then set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -11467,7 +11478,7 @@ $as_echo "no" >&6; } set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -11559,7 +11570,7 @@ $as_echo "no" >&6; } HAVE_XRENDER=no { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XRenderQueryExtension in -lXrender" >&5 $as_echo_n "checking for XRenderQueryExtension in -lXrender... " >&6; } -if test "${ac_cv_lib_Xrender_XRenderQueryExtension+set}" = set; then : +if ${ac_cv_lib_Xrender_XRenderQueryExtension+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11593,7 +11604,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xrender_XRenderQueryExtension" >&5 $as_echo "$ac_cv_lib_Xrender_XRenderQueryExtension" >&6; } -if test "x$ac_cv_lib_Xrender_XRenderQueryExtension" = x""yes; then : +if test "x$ac_cv_lib_Xrender_XRenderQueryExtension" = xyes; then : HAVE_XRENDER=yes fi @@ -11606,10 +11617,10 @@ fi XFT_LIBS="-lXrender $XFT_LIBS" LIBS="$XFT_LIBS $LIBS" ac_fn_c_check_header_mongrel "$LINENO" "X11/Xft/Xft.h" "ac_cv_header_X11_Xft_Xft_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_Xft_Xft_h" = x""yes; then : +if test "x$ac_cv_header_X11_Xft_Xft_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XftFontOpen in -lXft" >&5 $as_echo_n "checking for XftFontOpen in -lXft... " >&6; } -if test "${ac_cv_lib_Xft_XftFontOpen+set}" = set; then : +if ${ac_cv_lib_Xft_XftFontOpen+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11643,7 +11654,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xft_XftFontOpen" >&5 $as_echo "$ac_cv_lib_Xft_XftFontOpen" >&6; } -if test "x$ac_cv_lib_Xft_XftFontOpen" = x""yes; then : +if test "x$ac_cv_lib_Xft_XftFontOpen" = xyes; then : HAVE_XFT=yes fi @@ -11686,7 +11697,7 @@ $as_echo "#define HAVE_FREETYPE 1" >>confdefs.h set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -11779,7 +11790,7 @@ $as_echo "#define HAVE_LIBOTF 1" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: checking for OTF_get_variation_glyphs in -lotf" >&5 $as_echo_n "checking for OTF_get_variation_glyphs in -lotf... " >&6; } -if test "${ac_cv_lib_otf_OTF_get_variation_glyphs+set}" = set; then : +if ${ac_cv_lib_otf_OTF_get_variation_glyphs+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11813,7 +11824,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_otf_OTF_get_variation_glyphs" >&5 $as_echo "$ac_cv_lib_otf_OTF_get_variation_glyphs" >&6; } -if test "x$ac_cv_lib_otf_OTF_get_variation_glyphs" = x""yes; then : +if test "x$ac_cv_lib_otf_OTF_get_variation_glyphs" = xyes; then : HAVE_OTF_GET_VARIATION_GLYPHS=yes else HAVE_OTF_GET_VARIATION_GLYPHS=no @@ -11838,7 +11849,7 @@ $as_echo "#define HAVE_OTF_GET_VARIATION_GLYPHS 1" >>confdefs.h set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -11956,10 +11967,10 @@ LIBXPM= if test "${HAVE_X11}" = "yes"; then if test "${with_xpm}" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "X11/xpm.h" "ac_cv_header_X11_xpm_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_xpm_h" = x""yes; then : +if test "x$ac_cv_header_X11_xpm_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for XpmReadFileToPixmap in -lXpm" >&5 $as_echo_n "checking for XpmReadFileToPixmap in -lXpm... " >&6; } -if test "${ac_cv_lib_Xpm_XpmReadFileToPixmap+set}" = set; then : +if ${ac_cv_lib_Xpm_XpmReadFileToPixmap+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -11993,7 +12004,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_Xpm_XpmReadFileToPixmap" >&5 $as_echo "$ac_cv_lib_Xpm_XpmReadFileToPixmap" >&6; } -if test "x$ac_cv_lib_Xpm_XpmReadFileToPixmap" = x""yes; then : +if test "x$ac_cv_lib_Xpm_XpmReadFileToPixmap" = xyes; then : HAVE_XPM=yes fi @@ -12045,10 +12056,10 @@ LIBJPEG= if test "${HAVE_X11}" = "yes"; then if test "${with_jpeg}" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "jerror.h" "ac_cv_header_jerror_h" "$ac_includes_default" -if test "x$ac_cv_header_jerror_h" = x""yes; then : +if test "x$ac_cv_header_jerror_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for jpeg_destroy_compress in -ljpeg" >&5 $as_echo_n "checking for jpeg_destroy_compress in -ljpeg... " >&6; } -if test "${ac_cv_lib_jpeg_jpeg_destroy_compress+set}" = set; then : +if ${ac_cv_lib_jpeg_jpeg_destroy_compress+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12082,7 +12093,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_jpeg_jpeg_destroy_compress" >&5 $as_echo "$ac_cv_lib_jpeg_jpeg_destroy_compress" >&6; } -if test "x$ac_cv_lib_jpeg_jpeg_destroy_compress" = x""yes; then : +if test "x$ac_cv_lib_jpeg_jpeg_destroy_compress" = xyes; then : HAVE_JPEG=yes fi @@ -12141,7 +12152,7 @@ done if test "$ac_cv_header_png_h" = yes || test "$ac_cv_header_libpng_png_h" = yes ; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for png_get_channels in -lpng" >&5 $as_echo_n "checking for png_get_channels in -lpng... " >&6; } -if test "${ac_cv_lib_png_png_get_channels+set}" = set; then : +if ${ac_cv_lib_png_png_get_channels+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12175,7 +12186,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_png_png_get_channels" >&5 $as_echo "$ac_cv_lib_png_png_get_channels" >&6; } -if test "x$ac_cv_lib_png_png_get_channels" = x""yes; then : +if test "x$ac_cv_lib_png_png_get_channels" = xyes; then : HAVE_PNG=yes fi @@ -12197,13 +12208,13 @@ LIBTIFF= if test "${HAVE_X11}" = "yes"; then if test "${with_tiff}" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "tiffio.h" "ac_cv_header_tiffio_h" "$ac_includes_default" -if test "x$ac_cv_header_tiffio_h" = x""yes; then : +if test "x$ac_cv_header_tiffio_h" = xyes; then : tifflibs="-lz -lm" # At least one tiff package requires the jpeg library. if test "${HAVE_JPEG}" = yes; then tifflibs="-ljpeg $tifflibs"; fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for TIFFGetVersion in -ltiff" >&5 $as_echo_n "checking for TIFFGetVersion in -ltiff... " >&6; } -if test "${ac_cv_lib_tiff_TIFFGetVersion+set}" = set; then : +if ${ac_cv_lib_tiff_TIFFGetVersion+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12237,7 +12248,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_tiff_TIFFGetVersion" >&5 $as_echo "$ac_cv_lib_tiff_TIFFGetVersion" >&6; } -if test "x$ac_cv_lib_tiff_TIFFGetVersion" = x""yes; then : +if test "x$ac_cv_lib_tiff_TIFFGetVersion" = xyes; then : HAVE_TIFF=yes fi @@ -12260,12 +12271,12 @@ HAVE_GIF=no LIBGIF= if test "${HAVE_X11}" = "yes" && test "${with_gif}" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "gif_lib.h" "ac_cv_header_gif_lib_h" "$ac_includes_default" -if test "x$ac_cv_header_gif_lib_h" = x""yes; then : +if test "x$ac_cv_header_gif_lib_h" = xyes; then : # EGifPutExtensionLast only exists from version libungif-4.1.0b1. # Earlier versions can crash Emacs. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lgif" >&5 $as_echo_n "checking for EGifPutExtensionLast in -lgif... " >&6; } -if test "${ac_cv_lib_gif_EGifPutExtensionLast+set}" = set; then : +if ${ac_cv_lib_gif_EGifPutExtensionLast+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12299,7 +12310,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gif_EGifPutExtensionLast" >&5 $as_echo "$ac_cv_lib_gif_EGifPutExtensionLast" >&6; } -if test "x$ac_cv_lib_gif_EGifPutExtensionLast" = x""yes; then : +if test "x$ac_cv_lib_gif_EGifPutExtensionLast" = xyes; then : HAVE_GIF=yes else HAVE_GIF=maybe @@ -12315,7 +12326,7 @@ fi # If gif_lib.h but no libgif, try libungif. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for EGifPutExtensionLast in -lungif" >&5 $as_echo_n "checking for EGifPutExtensionLast in -lungif... " >&6; } -if test "${ac_cv_lib_ungif_EGifPutExtensionLast+set}" = set; then : +if ${ac_cv_lib_ungif_EGifPutExtensionLast+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12349,7 +12360,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_ungif_EGifPutExtensionLast" >&5 $as_echo "$ac_cv_lib_ungif_EGifPutExtensionLast" >&6; } -if test "x$ac_cv_lib_ungif_EGifPutExtensionLast" = x""yes; then : +if test "x$ac_cv_lib_ungif_EGifPutExtensionLast" = xyes; then : HAVE_GIF=yes else HAVE_GIF=no @@ -12396,10 +12407,10 @@ LIBGPM= MOUSE_SUPPORT= if test "${with_gpm}" != "no"; then ac_fn_c_check_header_mongrel "$LINENO" "gpm.h" "ac_cv_header_gpm_h" "$ac_includes_default" -if test "x$ac_cv_header_gpm_h" = x""yes; then : +if test "x$ac_cv_header_gpm_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for Gpm_Open in -lgpm" >&5 $as_echo_n "checking for Gpm_Open in -lgpm... " >&6; } -if test "${ac_cv_lib_gpm_Gpm_Open+set}" = set; then : +if ${ac_cv_lib_gpm_Gpm_Open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12433,7 +12444,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_gpm_Gpm_Open" >&5 $as_echo "$ac_cv_lib_gpm_Gpm_Open" >&6; } -if test "x$ac_cv_lib_gpm_Gpm_Open" = x""yes; then : +if test "x$ac_cv_lib_gpm_Gpm_Open" = xyes; then : HAVE_GPM=yes fi @@ -12453,7 +12464,7 @@ fi ac_fn_c_check_header_mongrel "$LINENO" "malloc/malloc.h" "ac_cv_header_malloc_malloc_h" "$ac_includes_default" -if test "x$ac_cv_header_malloc_malloc_h" = x""yes; then : +if test "x$ac_cv_header_malloc_malloc_h" = xyes; then : $as_echo "#define HAVE_MALLOC_MALLOC_H 1" >>confdefs.h @@ -12498,10 +12509,10 @@ HAVE_X_SM=no LIBXSM= if test "${HAVE_X11}" = "yes"; then ac_fn_c_check_header_mongrel "$LINENO" "X11/SM/SMlib.h" "ac_cv_header_X11_SM_SMlib_h" "$ac_includes_default" -if test "x$ac_cv_header_X11_SM_SMlib_h" = x""yes; then : +if test "x$ac_cv_header_X11_SM_SMlib_h" = xyes; then : { $as_echo "$as_me:${as_lineno-$LINENO}: checking for SmcOpenConnection in -lSM" >&5 $as_echo_n "checking for SmcOpenConnection in -lSM... " >&6; } -if test "${ac_cv_lib_SM_SmcOpenConnection+set}" = set; then : +if ${ac_cv_lib_SM_SmcOpenConnection+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12535,7 +12546,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_SM_SmcOpenConnection" >&5 $as_echo "$ac_cv_lib_SM_SmcOpenConnection" >&6; } -if test "x$ac_cv_lib_SM_SmcOpenConnection" = x""yes; then : +if test "x$ac_cv_lib_SM_SmcOpenConnection" = xyes; then : HAVE_X_SM=yes fi @@ -12566,7 +12577,7 @@ if test "${with_xml2}" != "no"; then set dummy pkg-config; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_path_PKG_CONFIG+set}" = set; then : +if ${ac_cv_path_PKG_CONFIG+:} false; then : $as_echo_n "(cached) " >&6 else case $PKG_CONFIG in @@ -12657,7 +12668,7 @@ $as_echo "no" >&6; } LIBS="$LIBXML2_LIBS $LIBS" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for htmlReadMemory in -lxml2" >&5 $as_echo_n "checking for htmlReadMemory in -lxml2... " >&6; } -if test "${ac_cv_lib_xml2_htmlReadMemory+set}" = set; then : +if ${ac_cv_lib_xml2_htmlReadMemory+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12691,7 +12702,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_xml2_htmlReadMemory" >&5 $as_echo "$ac_cv_lib_xml2_htmlReadMemory" >&6; } -if test "x$ac_cv_lib_xml2_htmlReadMemory" = x""yes; then : +if test "x$ac_cv_lib_xml2_htmlReadMemory" = xyes; then : HAVE_LIBXML2=yes else HAVE_LIBXML2=no @@ -12713,7 +12724,7 @@ fi # If netdb.h doesn't declare h_errno, we must declare it by hand. { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether netdb declares h_errno" >&5 $as_echo_n "checking whether netdb declares h_errno... " >&6; } -if test "${emacs_cv_netdb_declares_h_errno+set}" = set; then : +if ${emacs_cv_netdb_declares_h_errno+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -12743,11 +12754,22 @@ $as_echo "#define HAVE_H_ERRNO 1" >>confdefs.h fi +ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" +if test "x$ac_cv_type_size_t" = xyes; then : + +else + +cat >>confdefs.h <<_ACEOF +#define size_t unsigned int +_ACEOF + +fi + # The Ultrix 4.2 mips builtin alloca declared by alloca.h only works # for constant arguments. Useless! { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working alloca.h" >&5 $as_echo_n "checking for working alloca.h... " >&6; } -if test "${ac_cv_working_alloca_h+set}" = set; then : +if ${ac_cv_working_alloca_h+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -12780,7 +12802,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for alloca" >&5 $as_echo_n "checking for alloca... " >&6; } -if test "${ac_cv_func_alloca_works+set}" = set; then : +if ${ac_cv_func_alloca_works+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -12799,7 +12821,7 @@ else #pragma alloca # else # ifndef alloca /* predefined by HP cc +Olibcalls */ -char *alloca (); +void *alloca (size_t); # endif # endif # endif @@ -12843,7 +12865,7 @@ $as_echo "#define C_ALLOCA 1" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether \`alloca.c' needs Cray hooks" >&5 $as_echo_n "checking whether \`alloca.c' needs Cray hooks... " >&6; } -if test "${ac_cv_os_cray+set}" = set; then : +if ${ac_cv_os_cray+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -12884,7 +12906,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking stack direction for C alloca" >&5 $as_echo_n "checking stack direction for C alloca... " >&6; } -if test "${ac_cv_c_stack_direction+set}" = set; then : +if ${ac_cv_c_stack_direction+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -12941,7 +12963,7 @@ fi # On HPUX 9.01, -lm does not contain logb, so check for sqrt. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for sqrt in -lm" >&5 $as_echo_n "checking for sqrt in -lm... " >&6; } -if test "${ac_cv_lib_m_sqrt+set}" = set; then : +if ${ac_cv_lib_m_sqrt+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -12975,7 +12997,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_m_sqrt" >&5 $as_echo "$ac_cv_lib_m_sqrt" >&6; } -if test "x$ac_cv_lib_m_sqrt" = x""yes; then : +if test "x$ac_cv_lib_m_sqrt" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBM 1 _ACEOF @@ -12989,7 +13011,7 @@ fi # have the same check as for liblockfile below. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for maillock in -lmail" >&5 $as_echo_n "checking for maillock in -lmail... " >&6; } -if test "${ac_cv_lib_mail_maillock+set}" = set; then : +if ${ac_cv_lib_mail_maillock+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13023,7 +13045,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_mail_maillock" >&5 $as_echo "$ac_cv_lib_mail_maillock" >&6; } -if test "x$ac_cv_lib_mail_maillock" = x""yes; then : +if test "x$ac_cv_lib_mail_maillock" = xyes; then : have_mail=yes else have_mail=no @@ -13040,7 +13062,7 @@ else fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for maillock in -llockfile" >&5 $as_echo_n "checking for maillock in -llockfile... " >&6; } -if test "${ac_cv_lib_lockfile_maillock+set}" = set; then : +if ${ac_cv_lib_lockfile_maillock+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -13074,7 +13096,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_lockfile_maillock" >&5 $as_echo "$ac_cv_lib_lockfile_maillock" >&6; } -if test "x$ac_cv_lib_lockfile_maillock" = x""yes; then : +if test "x$ac_cv_lib_lockfile_maillock" = xyes; then : have_lockfile=yes else have_lockfile=no @@ -13094,7 +13116,7 @@ else set dummy liblockfile.so; ac_word=$2 { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $ac_word" >&5 $as_echo_n "checking for $ac_word... " >&6; } -if test "${ac_cv_prog_liblockfile+set}" = set; then : +if ${ac_cv_prog_liblockfile+:} false; then : $as_echo_n "(cached) " >&6 else if test -n "$liblockfile"; then @@ -13138,7 +13160,7 @@ fi for ac_func in touchlock do : ac_fn_c_check_func "$LINENO" "touchlock" "ac_cv_func_touchlock" -if test "x$ac_cv_func_touchlock" = x""yes; then : +if test "x$ac_cv_func_touchlock" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_TOUCHLOCK 1 _ACEOF @@ -13149,7 +13171,7 @@ done for ac_header in maillock.h do : ac_fn_c_check_header_mongrel "$LINENO" "maillock.h" "ac_cv_header_maillock_h" "$ac_includes_default" -if test "x$ac_cv_header_maillock_h" = x""yes; then : +if test "x$ac_cv_header_maillock_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_MAILLOCK_H 1 _ACEOF @@ -13230,7 +13252,7 @@ done { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __builtin_unwind_init" >&5 $as_echo_n "checking for __builtin_unwind_init... " >&6; } -if test "${emacs_cv_func___builtin_unwind_init+set}" = set; then : +if ${emacs_cv_func___builtin_unwind_init+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -13263,7 +13285,7 @@ fi for ac_header in sys/un.h do : ac_fn_c_check_header_mongrel "$LINENO" "sys/un.h" "ac_cv_header_sys_un_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_un_h" = x""yes; then : +if test "x$ac_cv_header_sys_un_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SYS_UN_H 1 _ACEOF @@ -13275,7 +13297,7 @@ done { $as_echo "$as_me:${as_lineno-$LINENO}: checking for _LARGEFILE_SOURCE value needed for large files" >&5 $as_echo_n "checking for _LARGEFILE_SOURCE value needed for large files... " >&6; } -if test "${ac_cv_sys_largefile_source+set}" = set; then : +if ${ac_cv_sys_largefile_source+:} false; then : $as_echo_n "(cached) " >&6 else while :; do @@ -13344,7 +13366,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getpgrp requires zero arguments" >&5 $as_echo_n "checking whether getpgrp requires zero arguments... " >&6; } -if test "${ac_cv_func_getpgrp_void+set}" = set; then : +if ${ac_cv_func_getpgrp_void+:} false; then : $as_echo_n "(cached) " >&6 else # Use it with a single arg. @@ -13393,7 +13415,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether byte ordering is bigendian" >&5 $as_echo_n "checking whether byte ordering is bigendian... " >&6; } -if test "${ac_cv_c_bigendian+set}" = set; then : +if ${ac_cv_c_bigendian+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_c_bigendian=unknown @@ -13612,13 +13634,13 @@ $as_echo "#define AC_APPLE_UNIVERSAL_BUILD 1" >>confdefs.h ;; #( *) as_fn_error $? "unknown endianness - presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; + presetting ac_cv_c_bigendian=no (or yes) will help" "$LINENO" 5 ;; esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking for inline" >&5 $as_echo_n "checking for inline... " >&6; } -if test "${ac_cv_c_inline+set}" = set; then : +if ${ac_cv_c_inline+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_c_inline=no @@ -13661,7 +13683,7 @@ esac { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether strtold conforms to C99" >&5 $as_echo_n "checking whether strtold conforms to C99... " >&6; } -if test "${gl_cv_func_c99_strtold+set}" = set; then : +if ${gl_cv_func_c99_strtold+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -13704,7 +13726,7 @@ $as_echo "#define HAVE_C99_STRTOLD 1" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: checking for st_dm_mode in struct stat" >&5 $as_echo_n "checking for st_dm_mode in struct stat... " >&6; } -if test "${ac_cv_struct_st_dm_mode+set}" = set; then : +if ${ac_cv_struct_st_dm_mode+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -13738,7 +13760,7 @@ $as_echo "#define HAVE_ST_DM_MODE 1" >>confdefs.h ac_fn_c_check_decl "$LINENO" "strmode" "ac_cv_have_decl_strmode" "$ac_includes_default" -if test "x$ac_cv_have_decl_strmode" = x""yes; then : +if test "x$ac_cv_have_decl_strmode" = xyes; then : ac_have_decl=1 else ac_have_decl=0 @@ -13923,7 +13945,7 @@ _ACEOF { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether the preprocessor supports include_next" >&5 $as_echo_n "checking whether the preprocessor supports include_next... " >&6; } -if test "${gl_cv_have_include_next+set}" = set; then : +if ${gl_cv_have_include_next+:} false; then : $as_echo_n "(cached) " >&6 else rm -rf conftestd1a conftestd1b conftestd2 @@ -14003,7 +14025,7 @@ $as_echo "$gl_cv_have_include_next" >&6; } { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether system header files limit the line length" >&5 $as_echo_n "checking whether system header files limit the line length... " >&6; } -if test "${gl_cv_pragma_columns+set}" = set; then : +if ${gl_cv_pragma_columns+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14053,7 +14075,7 @@ $as_echo "$gl_cv_pragma_columns" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 $as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_getopt_h+set}" = set; then : +if ${gl_cv_next_getopt_h+:} false; then : $as_echo_n "(cached) " >&6 else @@ -14112,7 +14134,7 @@ $as_echo "$gl_cv_next_getopt_h" >&6; } for ac_header in getopt.h do : ac_fn_c_check_header_mongrel "$LINENO" "getopt.h" "ac_cv_header_getopt_h" "$ac_includes_default" -if test "x$ac_cv_header_getopt_h" = x""yes; then : +if test "x$ac_cv_header_getopt_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETOPT_H 1 _ACEOF @@ -14129,7 +14151,7 @@ done for ac_func in getopt_long_only do : ac_fn_c_check_func "$LINENO" "getopt_long_only" "ac_cv_func_getopt_long_only" -if test "x$ac_cv_func_getopt_long_only" = x""yes; then : +if test "x$ac_cv_func_getopt_long_only" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETOPT_LONG_ONLY 1 _ACEOF @@ -14144,7 +14166,7 @@ done if test -z "$gl_replace_getopt"; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether getopt is POSIX compatible" >&5 $as_echo_n "checking whether getopt is POSIX compatible... " >&6; } -if test "${gl_cv_func_getopt_posix+set}" = set; then : +if ${gl_cv_func_getopt_posix+:} false; then : $as_echo_n "(cached) " >&6 else @@ -14302,7 +14324,7 @@ $as_echo "$gl_cv_func_getopt_posix" >&6; } if test -z "$gl_replace_getopt" && test $gl_getopt_required = GNU; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working GNU getopt function" >&5 $as_echo_n "checking for working GNU getopt function... " >&6; } -if test "${gl_cv_func_getopt_gnu+set}" = set; then : +if ${gl_cv_func_getopt_gnu+:} false; then : $as_echo_n "(cached) " >&6 else # Even with POSIXLY_CORRECT, the GNU extension of leading '-' in the @@ -14414,7 +14436,7 @@ $as_echo "$gl_cv_func_getopt_gnu" >&6; } fi ac_fn_c_check_decl "$LINENO" "getenv" "ac_cv_have_decl_getenv" "$ac_includes_default" -if test "x$ac_cv_have_decl_getenv" = x""yes; then : +if test "x$ac_cv_have_decl_getenv" = xyes; then : ac_have_decl=1 else ac_have_decl=0 @@ -14544,7 +14566,7 @@ rm -f core conftest.err conftest.$ac_objext conftest.$ac_ext { $as_echo "$as_me:${as_lineno-$LINENO}: checking for stdbool.h that conforms to C99" >&5 $as_echo_n "checking for stdbool.h that conforms to C99... " >&6; } -if test "${ac_cv_header_stdbool_h+set}" = set; then : +if ${ac_cv_header_stdbool_h+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14619,7 +14641,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_header_stdbool_h" >&5 $as_echo "$ac_cv_header_stdbool_h" >&6; } ac_fn_c_check_type "$LINENO" "_Bool" "ac_cv_type__Bool" "$ac_includes_default" -if test "x$ac_cv_type__Bool" = x""yes; then : +if test "x$ac_cv_type__Bool" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE__BOOL 1 @@ -14637,7 +14659,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for wchar_t" >&5 $as_echo_n "checking for wchar_t... " >&6; } -if test "${gt_cv_c_wchar_t+set}" = set; then : +if ${gt_cv_c_wchar_t+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14670,7 +14692,7 @@ $as_echo "#define HAVE_WCHAR_T 1" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: checking for unsigned long long int" >&5 $as_echo_n "checking for unsigned long long int... " >&6; } -if test "${ac_cv_type_unsigned_long_long_int+set}" = set; then : +if ${ac_cv_type_unsigned_long_long_int+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_type_unsigned_long_long_int=yes @@ -14728,7 +14750,7 @@ $as_echo "#define HAVE_UNSIGNED_LONG_LONG_INT 1" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: checking for long long int" >&5 $as_echo_n "checking for long long int... " >&6; } -if test "${ac_cv_type_long_long_int+set}" = set; then : +if ${ac_cv_type_long_long_int+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_type_long_long_int=yes @@ -14791,7 +14813,7 @@ $as_echo "#define HAVE_LONG_LONG_INT 1" >>confdefs.h ac_fn_c_check_member "$LINENO" "struct tm" "tm_gmtoff" "ac_cv_member_struct_tm_tm_gmtoff" "#include " -if test "x$ac_cv_member_struct_tm_tm_gmtoff" = x""yes; then : +if test "x$ac_cv_member_struct_tm_tm_gmtoff" = xyes; then : $as_echo "#define HAVE_TM_GMTOFF 1" >>confdefs.h @@ -14836,7 +14858,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stat file-mode macros are broken" >&5 $as_echo_n "checking whether stat file-mode macros are broken... " >&6; } -if test "${ac_cv_header_stat_broken+set}" = set; then : +if ${ac_cv_header_stat_broken+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14880,7 +14902,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for C/C++ restrict keyword" >&5 $as_echo_n "checking for C/C++ restrict keyword... " >&6; } -if test "${ac_cv_c_restrict+set}" = set; then : +if ${ac_cv_c_restrict+:} false; then : $as_echo_n "(cached) " >&6 else ac_cv_c_restrict=no @@ -14930,7 +14952,7 @@ _ACEOF { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timespec in " >&5 $as_echo_n "checking for struct timespec in ... " >&6; } -if test "${gl_cv_sys_struct_timespec_in_time_h+set}" = set; then : +if ${gl_cv_sys_struct_timespec_in_time_h+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14963,7 +14985,7 @@ $as_echo "$gl_cv_sys_struct_timespec_in_time_h" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timespec in " >&5 $as_echo_n "checking for struct timespec in ... " >&6; } -if test "${gl_cv_sys_struct_timespec_in_sys_time_h+set}" = set; then : +if ${gl_cv_sys_struct_timespec_in_sys_time_h+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -14992,7 +15014,7 @@ $as_echo "$gl_cv_sys_struct_timespec_in_sys_time_h" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for struct timespec in " >&5 $as_echo_n "checking for struct timespec in ... " >&6; } -if test "${gl_cv_sys_struct_timespec_in_pthread_h+set}" = set; then : +if ${gl_cv_sys_struct_timespec_in_pthread_h+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -15041,7 +15063,7 @@ $as_echo "$gl_cv_sys_struct_timespec_in_pthread_h" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 $as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_time_h+set}" = set; then : +if ${gl_cv_next_time_h+:} false; then : $as_echo_n "(cached) " >&6 else @@ -15084,7 +15106,7 @@ $as_echo "$gl_cv_next_time_h" >&6; } ac_fn_c_check_decl "$LINENO" "localtime_r" "ac_cv_have_decl_localtime_r" "$ac_includes_default" -if test "x$ac_cv_have_decl_localtime_r" = x""yes; then : +if test "x$ac_cv_have_decl_localtime_r" = xyes; then : ac_have_decl=1 else ac_have_decl=0 @@ -15171,7 +15193,7 @@ gl_save_LIBS=$LIBS # getloadvg is present in libc on glibc >= 2.2, MacOS X, FreeBSD >= 2.0, # NetBSD >= 0.9, OpenBSD >= 2.0, Solaris >= 7. ac_fn_c_check_func "$LINENO" "getloadavg" "ac_cv_func_getloadavg" -if test "x$ac_cv_func_getloadavg" = x""yes; then : +if test "x$ac_cv_func_getloadavg" = xyes; then : else gl_have_func=no @@ -15184,7 +15206,7 @@ else if test $gl_have_func = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for elf_begin in -lelf" >&5 $as_echo_n "checking for elf_begin in -lelf... " >&6; } -if test "${ac_cv_lib_elf_elf_begin+set}" = set; then : +if ${ac_cv_lib_elf_elf_begin+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15218,13 +15240,13 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_elf_elf_begin" >&5 $as_echo "$ac_cv_lib_elf_elf_begin" >&6; } -if test "x$ac_cv_lib_elf_elf_begin" = x""yes; then : +if test "x$ac_cv_lib_elf_elf_begin" = xyes; then : LIBS="-lelf $LIBS" fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kvm_open in -lkvm" >&5 $as_echo_n "checking for kvm_open in -lkvm... " >&6; } -if test "${ac_cv_lib_kvm_kvm_open+set}" = set; then : +if ${ac_cv_lib_kvm_kvm_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15258,14 +15280,14 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kvm_kvm_open" >&5 $as_echo "$ac_cv_lib_kvm_kvm_open" >&6; } -if test "x$ac_cv_lib_kvm_kvm_open" = x""yes; then : +if test "x$ac_cv_lib_kvm_kvm_open" = xyes; then : LIBS="-lkvm $LIBS" fi # Check for the 4.4BSD definition of getloadavg. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lutil" >&5 $as_echo_n "checking for getloadavg in -lutil... " >&6; } -if test "${ac_cv_lib_util_getloadavg+set}" = set; then : +if ${ac_cv_lib_util_getloadavg+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15299,7 +15321,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_util_getloadavg" >&5 $as_echo "$ac_cv_lib_util_getloadavg" >&6; } -if test "x$ac_cv_lib_util_getloadavg" = x""yes; then : +if test "x$ac_cv_lib_util_getloadavg" = xyes; then : LIBS="-lutil $LIBS" gl_have_func=yes fi @@ -15312,7 +15334,7 @@ fi LIBS="-L/usr/local/lib $LIBS" { $as_echo "$as_me:${as_lineno-$LINENO}: checking for getloadavg in -lgetloadavg" >&5 $as_echo_n "checking for getloadavg in -lgetloadavg... " >&6; } -if test "${ac_cv_lib_getloadavg_getloadavg+set}" = set; then : +if ${ac_cv_lib_getloadavg_getloadavg+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15346,7 +15368,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_getloadavg_getloadavg" >&5 $as_echo "$ac_cv_lib_getloadavg_getloadavg" >&6; } -if test "x$ac_cv_lib_getloadavg_getloadavg" = x""yes; then : +if test "x$ac_cv_lib_getloadavg_getloadavg" = xyes; then : LIBS="-lgetloadavg $LIBS" gl_have_func=yes else LIBS=$gl_getloadavg_LIBS @@ -15372,7 +15394,7 @@ fi # Solaris has libkstat which does not require root. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for kstat_open in -lkstat" >&5 $as_echo_n "checking for kstat_open in -lkstat... " >&6; } -if test "${ac_cv_lib_kstat_kstat_open+set}" = set; then : +if ${ac_cv_lib_kstat_kstat_open+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15406,7 +15428,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_kstat_kstat_open" >&5 $as_echo "$ac_cv_lib_kstat_kstat_open" >&6; } -if test "x$ac_cv_lib_kstat_kstat_open" = x""yes; then : +if test "x$ac_cv_lib_kstat_kstat_open" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBKSTAT 1 _ACEOF @@ -15422,7 +15444,7 @@ if test $gl_have_func = no; then for ac_func in pstat_getdynamic do : ac_fn_c_check_func "$LINENO" "pstat_getdynamic" "ac_cv_func_pstat_getdynamic" -if test "x$ac_cv_func_pstat_getdynamic" = x""yes; then : +if test "x$ac_cv_func_pstat_getdynamic" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_PSTAT_GETDYNAMIC 1 _ACEOF @@ -15436,7 +15458,7 @@ fi if test $gl_have_func = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for perfstat_cpu_total in -lperfstat" >&5 $as_echo_n "checking for perfstat_cpu_total in -lperfstat... " >&6; } -if test "${ac_cv_lib_perfstat_perfstat_cpu_total+set}" = set; then : +if ${ac_cv_lib_perfstat_perfstat_cpu_total+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15470,7 +15492,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_perfstat_perfstat_cpu_total" >&5 $as_echo "$ac_cv_lib_perfstat_perfstat_cpu_total" >&6; } -if test "x$ac_cv_lib_perfstat_perfstat_cpu_total" = x""yes; then : +if test "x$ac_cv_lib_perfstat_perfstat_cpu_total" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBPERFSTAT 1 _ACEOF @@ -15484,14 +15506,14 @@ fi if test $gl_have_func = no; then ac_fn_c_check_header_mongrel "$LINENO" "sys/dg_sys_info.h" "ac_cv_header_sys_dg_sys_info_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_dg_sys_info_h" = x""yes; then : +if test "x$ac_cv_header_sys_dg_sys_info_h" = xyes; then : gl_have_func=yes $as_echo "#define DGUX 1" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dg_sys_info in -ldgc" >&5 $as_echo_n "checking for dg_sys_info in -ldgc... " >&6; } -if test "${ac_cv_lib_dgc_dg_sys_info+set}" = set; then : +if ${ac_cv_lib_dgc_dg_sys_info+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -15525,7 +15547,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_dgc_dg_sys_info" >&5 $as_echo "$ac_cv_lib_dgc_dg_sys_info" >&6; } -if test "x$ac_cv_lib_dgc_dg_sys_info" = x""yes; then : +if test "x$ac_cv_lib_dgc_dg_sys_info" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBDGC 1 _ACEOF @@ -15552,7 +15574,7 @@ fi if test $gl_have_func = no; then ac_fn_c_check_header_mongrel "$LINENO" "inq_stats/cpustats.h" "ac_cv_header_inq_stats_cpustats_h" "$ac_includes_default" -if test "x$ac_cv_header_inq_stats_cpustats_h" = x""yes; then : +if test "x$ac_cv_header_inq_stats_cpustats_h" = xyes; then : gl_have_func=yes $as_echo "#define UMAX 1" >>confdefs.h @@ -15567,7 +15589,7 @@ fi if test $gl_have_func = no; then ac_fn_c_check_header_mongrel "$LINENO" "sys/cpustats.h" "ac_cv_header_sys_cpustats_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_cpustats_h" = x""yes; then : +if test "x$ac_cv_header_sys_cpustats_h" = xyes; then : gl_have_func=yes; $as_echo "#define UMAX 1" >>confdefs.h fi @@ -15579,7 +15601,7 @@ if test $gl_have_func = no; then for ac_header in mach/mach.h do : ac_fn_c_check_header_mongrel "$LINENO" "mach/mach.h" "ac_cv_header_mach_mach_h" "$ac_includes_default" -if test "x$ac_cv_header_mach_mach_h" = x""yes; then : +if test "x$ac_cv_header_mach_mach_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_MACH_MACH_H 1 _ACEOF @@ -15593,13 +15615,13 @@ fi for ac_header in nlist.h do : ac_fn_c_check_header_mongrel "$LINENO" "nlist.h" "ac_cv_header_nlist_h" "$ac_includes_default" -if test "x$ac_cv_header_nlist_h" = x""yes; then : +if test "x$ac_cv_header_nlist_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_NLIST_H 1 _ACEOF ac_fn_c_check_member "$LINENO" "struct nlist" "n_un.n_name" "ac_cv_member_struct_nlist_n_un_n_name" "#include " -if test "x$ac_cv_member_struct_nlist_n_un_n_name" = x""yes; then : +if test "x$ac_cv_member_struct_nlist_n_un_n_name" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_STRUCT_NLIST_N_UN_N_NAME 1 @@ -15653,7 +15675,7 @@ LIBS=$gl_save_LIBS for ac_header in sys/loadavg.h do : ac_fn_c_check_header_mongrel "$LINENO" "sys/loadavg.h" "ac_cv_header_sys_loadavg_h" "$ac_includes_default" -if test "x$ac_cv_header_sys_loadavg_h" = x""yes; then : +if test "x$ac_cv_header_sys_loadavg_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SYS_LOADAVG_H 1 _ACEOF @@ -15672,7 +15694,7 @@ ac_fn_c_check_decl "$LINENO" "getloadavg" "ac_cv_have_decl_getloadavg" "#if HAVE #endif #include " -if test "x$ac_cv_have_decl_getloadavg" = x""yes; then : +if test "x$ac_cv_have_decl_getloadavg" = xyes; then : else HAVE_DECL_GETLOADAVG=0 @@ -15759,7 +15781,7 @@ if test $APPLE_UNIVERSAL_BUILD = 1; then fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working mktime" >&5 $as_echo_n "checking for working mktime... " >&6; } -if test "${ac_cv_func_working_mktime+set}" = set; then : +if ${ac_cv_func_working_mktime+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -16032,7 +16054,7 @@ fi fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether NULL can be used in arbitrary expressions" >&5 $as_echo_n "checking whether NULL can be used in arbitrary expressions... " >&6; } -if test "${gl_cv_decl_null_works+set}" = set; then : +if ${gl_cv_decl_null_works+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -16075,7 +16097,7 @@ $as_echo "$gl_cv_decl_null_works" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 $as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_stddef_h+set}" = set; then : +if ${gl_cv_next_stddef_h+:} false; then : $as_echo_n "(cached) " >&6 else @@ -16171,7 +16193,7 @@ $as_echo "$gl_cv_next_stddef_h" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 $as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_stdint_h+set}" = set; then : +if ${gl_cv_next_stdint_h+:} false; then : $as_echo_n "(cached) " >&6 else @@ -16227,7 +16249,7 @@ $as_echo "$gl_cv_next_stdint_h" >&6; } if test $ac_cv_header_stdint_h = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether stdint.h conforms to C99" >&5 $as_echo_n "checking whether stdint.h conforms to C99... " >&6; } -if test "${gl_cv_header_working_stdint_h+set}" = set; then : +if ${gl_cv_header_working_stdint_h+:} false; then : $as_echo_n "(cached) " >&6 else gl_cv_header_working_stdint_h=no @@ -16530,7 +16552,7 @@ done for gltype in ptrdiff_t size_t ; do { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bit size of $gltype" >&5 $as_echo_n "checking for bit size of $gltype... " >&6; } -if eval "test \"\${gl_cv_bitsizeof_${gltype}+set}\"" = set; then : +if eval \${gl_cv_bitsizeof_${gltype}+:} false; then : $as_echo_n "(cached) " >&6 else if ac_fn_c_compute_int "$LINENO" "sizeof ($gltype) * CHAR_BIT" "result" " @@ -16575,7 +16597,7 @@ _ACEOF for gltype in sig_atomic_t wchar_t wint_t ; do { $as_echo "$as_me:${as_lineno-$LINENO}: checking for bit size of $gltype" >&5 $as_echo_n "checking for bit size of $gltype... " >&6; } -if eval "test \"\${gl_cv_bitsizeof_${gltype}+set}\"" = set; then : +if eval \${gl_cv_bitsizeof_${gltype}+:} false; then : $as_echo_n "(cached) " >&6 else if ac_fn_c_compute_int "$LINENO" "sizeof ($gltype) * CHAR_BIT" "result" " @@ -16619,7 +16641,7 @@ _ACEOF for gltype in sig_atomic_t wchar_t wint_t ; do { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether $gltype is signed" >&5 $as_echo_n "checking whether $gltype is signed... " >&6; } -if eval "test \"\${gl_cv_type_${gltype}_signed+set}\"" = set; then : +if eval \${gl_cv_type_${gltype}_signed+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -16678,7 +16700,7 @@ _ACEOF for gltype in ptrdiff_t size_t ; do { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $gltype integer literal suffix" >&5 $as_echo_n "checking for $gltype integer literal suffix... " >&6; } -if eval "test \"\${gl_cv_type_${gltype}_suffix+set}\"" = set; then : +if eval \${gl_cv_type_${gltype}_suffix+:} false; then : $as_echo_n "(cached) " >&6 else eval gl_cv_type_${gltype}_suffix=no @@ -16750,7 +16772,7 @@ _ACEOF for gltype in sig_atomic_t wchar_t wint_t ; do { $as_echo "$as_me:${as_lineno-$LINENO}: checking for $gltype integer literal suffix" >&5 $as_echo_n "checking for $gltype integer literal suffix... " >&6; } -if eval "test \"\${gl_cv_type_${gltype}_suffix+set}\"" = set; then : +if eval \${gl_cv_type_${gltype}_suffix+:} false; then : $as_echo_n "(cached) " >&6 else eval gl_cv_type_${gltype}_suffix=no @@ -16837,7 +16859,7 @@ _ACEOF else { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 $as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_stdlib_h+set}" = set; then : +if ${gl_cv_next_stdlib_h+:} false; then : $as_echo_n "(cached) " >&6 else @@ -16928,7 +16950,7 @@ $as_echo "#define my_strftime nstrftime" >>confdefs.h else { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 $as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_sys_stat_h+set}" = set; then : +if ${gl_cv_next_sys_stat_h+:} false; then : $as_echo_n "(cached) " >&6 else @@ -16978,7 +17000,7 @@ $as_echo "$gl_cv_next_sys_stat_h" >&6; } ac_fn_c_check_type "$LINENO" "nlink_t" "ac_cv_type_nlink_t" "#include #include " -if test "x$ac_cv_type_nlink_t" = x""yes; then : +if test "x$ac_cv_type_nlink_t" = xyes; then : else @@ -17011,7 +17033,7 @@ fi HAVE_LOCALTIME_R=1 { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether localtime_r is compatible with its POSIX signature" >&5 $as_echo_n "checking whether localtime_r is compatible with its POSIX signature... " >&6; } -if test "${gl_cv_time_r_posix+set}" = set; then : +if ${gl_cv_time_r_posix+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -17093,7 +17115,7 @@ $as_echo "$gl_cv_time_r_posix" >&6; } else { $as_echo "$as_me:${as_lineno-$LINENO}: checking absolute name of " >&5 $as_echo_n "checking absolute name of ... " >&6; } -if test "${gl_cv_next_unistd_h+set}" = set; then : +if ${gl_cv_next_unistd_h+:} false; then : $as_echo_n "(cached) " >&6 else @@ -17193,7 +17215,7 @@ $as_echo "$gl_cv_next_unistd_h" >&6; } for ac_func in grantpt do : ac_fn_c_check_func "$LINENO" "grantpt" "ac_cv_func_grantpt" -if test "x$ac_cv_func_grantpt" = x""yes; then : +if test "x$ac_cv_func_grantpt" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GRANTPT 1 _ACEOF @@ -17206,7 +17228,7 @@ done for ac_func in getpt do : ac_fn_c_check_func "$LINENO" "getpt" "ac_cv_func_getpt" -if test "x$ac_cv_func_getpt" = x""yes; then : +if test "x$ac_cv_func_getpt" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETPT 1 _ACEOF @@ -17223,7 +17245,7 @@ done have_tputs_et_al=true { $as_echo "$as_me:${as_lineno-$LINENO}: checking for library containing tputs" >&5 $as_echo_n "checking for library containing tputs... " >&6; } -if test "${ac_cv_search_tputs+set}" = set; then : +if ${ac_cv_search_tputs+:} false; then : $as_echo_n "(cached) " >&6 else ac_func_search_save_LIBS=$LIBS @@ -17257,11 +17279,11 @@ for ac_lib in '' ncurses terminfo termcap; do fi rm -f core conftest.err conftest.$ac_objext \ conftest$ac_exeext - if test "${ac_cv_search_tputs+set}" = set; then : + if ${ac_cv_search_tputs+:} false; then : break fi done -if test "${ac_cv_search_tputs+set}" = set; then : +if ${ac_cv_search_tputs+:} false; then : else ac_cv_search_tputs=no @@ -17320,7 +17342,7 @@ case "$opsys" in freebsd) { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether FreeBSD is new enough to use terminfo" >&5 $as_echo_n "checking whether FreeBSD is new enough to use terminfo... " >&6; } - if test "${emacs_cv_freebsd_terminfo+set}" = set; then : + if ${emacs_cv_freebsd_terminfo+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -17462,16 +17484,16 @@ LIBHESIOD= if test "$with_hesiod" != no ; then # Don't set $LIBS here -- see comments above. FIXME which comments? ac_fn_c_check_func "$LINENO" "res_send" "ac_cv_func_res_send" -if test "x$ac_cv_func_res_send" = x""yes; then : +if test "x$ac_cv_func_res_send" = xyes; then : else ac_fn_c_check_func "$LINENO" "__res_send" "ac_cv_func___res_send" -if test "x$ac_cv_func___res_send" = x""yes; then : +if test "x$ac_cv_func___res_send" = xyes; then : else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for res_send in -lresolv" >&5 $as_echo_n "checking for res_send in -lresolv... " >&6; } -if test "${ac_cv_lib_resolv_res_send+set}" = set; then : +if ${ac_cv_lib_resolv_res_send+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17505,12 +17527,12 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_resolv_res_send" >&5 $as_echo "$ac_cv_lib_resolv_res_send" >&6; } -if test "x$ac_cv_lib_resolv_res_send" = x""yes; then : +if test "x$ac_cv_lib_resolv_res_send" = xyes; then : resolv=yes else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for __res_send in -lresolv" >&5 $as_echo_n "checking for __res_send in -lresolv... " >&6; } -if test "${ac_cv_lib_resolv___res_send+set}" = set; then : +if ${ac_cv_lib_resolv___res_send+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17544,7 +17566,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_resolv___res_send" >&5 $as_echo "$ac_cv_lib_resolv___res_send" >&6; } -if test "x$ac_cv_lib_resolv___res_send" = x""yes; then : +if test "x$ac_cv_lib_resolv___res_send" = xyes; then : resolv=yes fi @@ -17560,12 +17582,12 @@ fi RESOLVLIB= fi ac_fn_c_check_func "$LINENO" "hes_getmailhost" "ac_cv_func_hes_getmailhost" -if test "x$ac_cv_func_hes_getmailhost" = x""yes; then : +if test "x$ac_cv_func_hes_getmailhost" = xyes; then : else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for hes_getmailhost in -lhesiod" >&5 $as_echo_n "checking for hes_getmailhost in -lhesiod... " >&6; } -if test "${ac_cv_lib_hesiod_hes_getmailhost+set}" = set; then : +if ${ac_cv_lib_hesiod_hes_getmailhost+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17599,7 +17621,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_hesiod_hes_getmailhost" >&5 $as_echo "$ac_cv_lib_hesiod_hes_getmailhost" >&6; } -if test "x$ac_cv_lib_hesiod_hes_getmailhost" = x""yes; then : +if test "x$ac_cv_lib_hesiod_hes_getmailhost" = xyes; then : hesiod=yes else : @@ -17638,7 +17660,7 @@ KRB4LIB= if test "${with_kerberos}" != no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for com_err in -lcom_err" >&5 $as_echo_n "checking for com_err in -lcom_err... " >&6; } -if test "${ac_cv_lib_com_err_com_err+set}" = set; then : +if ${ac_cv_lib_com_err_com_err+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17672,7 +17694,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_com_err_com_err" >&5 $as_echo "$ac_cv_lib_com_err_com_err" >&6; } -if test "x$ac_cv_lib_com_err_com_err" = x""yes; then : +if test "x$ac_cv_lib_com_err_com_err" = xyes; then : have_com_err=yes else have_com_err=no @@ -17687,7 +17709,7 @@ $as_echo "#define HAVE_LIBCOM_ERR 1" >>confdefs.h fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lcrypto" >&5 $as_echo_n "checking for mit_des_cbc_encrypt in -lcrypto... " >&6; } -if test "${ac_cv_lib_crypto_mit_des_cbc_encrypt+set}" = set; then : +if ${ac_cv_lib_crypto_mit_des_cbc_encrypt+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17721,7 +17743,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_crypto_mit_des_cbc_encrypt" >&5 $as_echo "$ac_cv_lib_crypto_mit_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_crypto_mit_des_cbc_encrypt" = x""yes; then : +if test "x$ac_cv_lib_crypto_mit_des_cbc_encrypt" = xyes; then : have_crypto=yes else have_crypto=no @@ -17736,7 +17758,7 @@ $as_echo "#define HAVE_LIBCRYPTO 1" >>confdefs.h fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mit_des_cbc_encrypt in -lk5crypto" >&5 $as_echo_n "checking for mit_des_cbc_encrypt in -lk5crypto... " >&6; } -if test "${ac_cv_lib_k5crypto_mit_des_cbc_encrypt+set}" = set; then : +if ${ac_cv_lib_k5crypto_mit_des_cbc_encrypt+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17770,7 +17792,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_k5crypto_mit_des_cbc_encrypt" >&5 $as_echo "$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" = x""yes; then : +if test "x$ac_cv_lib_k5crypto_mit_des_cbc_encrypt" = xyes; then : have_k5crypto=yes else have_k5crypto=no @@ -17785,7 +17807,7 @@ $as_echo "#define HAVE_LIBK5CRYPTO 1" >>confdefs.h fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb5_init_context in -lkrb5" >&5 $as_echo_n "checking for krb5_init_context in -lkrb5... " >&6; } -if test "${ac_cv_lib_krb5_krb5_init_context+set}" = set; then : +if ${ac_cv_lib_krb5_krb5_init_context+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17819,7 +17841,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb5_krb5_init_context" >&5 $as_echo "$ac_cv_lib_krb5_krb5_init_context" >&6; } -if test "x$ac_cv_lib_krb5_krb5_init_context" = x""yes; then : +if test "x$ac_cv_lib_krb5_krb5_init_context" = xyes; then : have_krb5=yes else have_krb5=no @@ -17835,7 +17857,7 @@ $as_echo "#define HAVE_LIBKRB5 1" >>confdefs.h if test "${with_kerberos5}" = no; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes425" >&5 $as_echo_n "checking for des_cbc_encrypt in -ldes425... " >&6; } -if test "${ac_cv_lib_des425_des_cbc_encrypt+set}" = set; then : +if ${ac_cv_lib_des425_des_cbc_encrypt+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17869,7 +17891,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_des425_des_cbc_encrypt" >&5 $as_echo "$ac_cv_lib_des425_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_des425_des_cbc_encrypt" = x""yes; then : +if test "x$ac_cv_lib_des425_des_cbc_encrypt" = xyes; then : have_des425=yes else have_des425=no @@ -17884,7 +17906,7 @@ $as_echo "#define HAVE_LIBDES425 1" >>confdefs.h else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for des_cbc_encrypt in -ldes" >&5 $as_echo_n "checking for des_cbc_encrypt in -ldes... " >&6; } -if test "${ac_cv_lib_des_des_cbc_encrypt+set}" = set; then : +if ${ac_cv_lib_des_des_cbc_encrypt+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17918,7 +17940,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_des_des_cbc_encrypt" >&5 $as_echo "$ac_cv_lib_des_des_cbc_encrypt" >&6; } -if test "x$ac_cv_lib_des_des_cbc_encrypt" = x""yes; then : +if test "x$ac_cv_lib_des_des_cbc_encrypt" = xyes; then : have_des=yes else have_des=no @@ -17934,7 +17956,7 @@ $as_echo "#define HAVE_LIBDES 1" >>confdefs.h fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb4" >&5 $as_echo_n "checking for krb_get_cred in -lkrb4... " >&6; } -if test "${ac_cv_lib_krb4_krb_get_cred+set}" = set; then : +if ${ac_cv_lib_krb4_krb_get_cred+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -17968,7 +17990,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb4_krb_get_cred" >&5 $as_echo "$ac_cv_lib_krb4_krb_get_cred" >&6; } -if test "x$ac_cv_lib_krb4_krb_get_cred" = x""yes; then : +if test "x$ac_cv_lib_krb4_krb_get_cred" = xyes; then : have_krb4=yes else have_krb4=no @@ -17983,7 +18005,7 @@ $as_echo "#define HAVE_LIBKRB4 1" >>confdefs.h else { $as_echo "$as_me:${as_lineno-$LINENO}: checking for krb_get_cred in -lkrb" >&5 $as_echo_n "checking for krb_get_cred in -lkrb... " >&6; } -if test "${ac_cv_lib_krb_krb_get_cred+set}" = set; then : +if ${ac_cv_lib_krb_krb_get_cred+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -18017,7 +18039,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_krb_krb_get_cred" >&5 $as_echo "$ac_cv_lib_krb_krb_get_cred" >&6; } -if test "x$ac_cv_lib_krb_krb_get_cred" = x""yes; then : +if test "x$ac_cv_lib_krb_krb_get_cred" = xyes; then : have_krb=yes else have_krb=no @@ -18037,13 +18059,13 @@ $as_echo "#define HAVE_LIBKRB 1" >>confdefs.h for ac_header in krb5.h do : ac_fn_c_check_header_mongrel "$LINENO" "krb5.h" "ac_cv_header_krb5_h" "$ac_includes_default" -if test "x$ac_cv_header_krb5_h" = x""yes; then : +if test "x$ac_cv_header_krb5_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KRB5_H 1 _ACEOF ac_fn_c_check_member "$LINENO" "krb5_error" "text" "ac_cv_member_krb5_error_text" "#include " -if test "x$ac_cv_member_krb5_error_text" = x""yes; then : +if test "x$ac_cv_member_krb5_error_text" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KRB5_ERROR_TEXT 1 @@ -18053,7 +18075,7 @@ _ACEOF fi ac_fn_c_check_member "$LINENO" "krb5_error" "e_text" "ac_cv_member_krb5_error_e_text" "#include " -if test "x$ac_cv_member_krb5_error_e_text" = x""yes; then : +if test "x$ac_cv_member_krb5_error_e_text" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KRB5_ERROR_E_TEXT 1 @@ -18070,7 +18092,7 @@ done for ac_header in des.h do : ac_fn_c_check_header_mongrel "$LINENO" "des.h" "ac_cv_header_des_h" "$ac_includes_default" -if test "x$ac_cv_header_des_h" = x""yes; then : +if test "x$ac_cv_header_des_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_DES_H 1 _ACEOF @@ -18079,7 +18101,7 @@ else for ac_header in kerberosIV/des.h do : ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/des.h" "ac_cv_header_kerberosIV_des_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberosIV_des_h" = x""yes; then : +if test "x$ac_cv_header_kerberosIV_des_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROSIV_DES_H 1 _ACEOF @@ -18088,7 +18110,7 @@ else for ac_header in kerberos/des.h do : ac_fn_c_check_header_mongrel "$LINENO" "kerberos/des.h" "ac_cv_header_kerberos_des_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberos_des_h" = x""yes; then : +if test "x$ac_cv_header_kerberos_des_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROS_DES_H 1 _ACEOF @@ -18108,7 +18130,7 @@ done for ac_header in krb.h do : ac_fn_c_check_header_mongrel "$LINENO" "krb.h" "ac_cv_header_krb_h" "$ac_includes_default" -if test "x$ac_cv_header_krb_h" = x""yes; then : +if test "x$ac_cv_header_krb_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KRB_H 1 _ACEOF @@ -18117,7 +18139,7 @@ else for ac_header in kerberosIV/krb.h do : ac_fn_c_check_header_mongrel "$LINENO" "kerberosIV/krb.h" "ac_cv_header_kerberosIV_krb_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberosIV_krb_h" = x""yes; then : +if test "x$ac_cv_header_kerberosIV_krb_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROSIV_KRB_H 1 _ACEOF @@ -18126,7 +18148,7 @@ else for ac_header in kerberos/krb.h do : ac_fn_c_check_header_mongrel "$LINENO" "kerberos/krb.h" "ac_cv_header_kerberos_krb_h" "$ac_includes_default" -if test "x$ac_cv_header_kerberos_krb_h" = x""yes; then : +if test "x$ac_cv_header_kerberos_krb_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_KERBEROS_KRB_H 1 _ACEOF @@ -18147,7 +18169,7 @@ done for ac_header in com_err.h do : ac_fn_c_check_header_mongrel "$LINENO" "com_err.h" "ac_cv_header_com_err_h" "$ac_includes_default" -if test "x$ac_cv_header_com_err_h" = x""yes; then : +if test "x$ac_cv_header_com_err_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_COM_ERR_H 1 _ACEOF @@ -18168,7 +18190,7 @@ fi # to return localized messages. { $as_echo "$as_me:${as_lineno-$LINENO}: checking for dgettext in -lintl" >&5 $as_echo_n "checking for dgettext in -lintl... " >&6; } -if test "${ac_cv_lib_intl_dgettext+set}" = set; then : +if ${ac_cv_lib_intl_dgettext+:} false; then : $as_echo_n "(cached) " >&6 else ac_check_lib_save_LIBS=$LIBS @@ -18202,7 +18224,7 @@ LIBS=$ac_check_lib_save_LIBS fi { $as_echo "$as_me:${as_lineno-$LINENO}: result: $ac_cv_lib_intl_dgettext" >&5 $as_echo "$ac_cv_lib_intl_dgettext" >&6; } -if test "x$ac_cv_lib_intl_dgettext" = x""yes; then : +if test "x$ac_cv_lib_intl_dgettext" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_LIBINTL 1 _ACEOF @@ -18214,7 +18236,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether localtime caches TZ" >&5 $as_echo_n "checking whether localtime caches TZ... " >&6; } -if test "${emacs_cv_localtime_cache+set}" = set; then : +if ${emacs_cv_localtime_cache+:} false; then : $as_echo_n "(cached) " >&6 else if test x$ac_cv_func_tzset = xyes; then @@ -18273,7 +18295,7 @@ if test "x$HAVE_TIMEVAL" = xyes; then for ac_func in gettimeofday do : ac_fn_c_check_func "$LINENO" "gettimeofday" "ac_cv_func_gettimeofday" -if test "x$ac_cv_func_gettimeofday" = x""yes; then : +if test "x$ac_cv_func_gettimeofday" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_GETTIMEOFDAY 1 _ACEOF @@ -18284,7 +18306,7 @@ done if test $ac_cv_func_gettimeofday = yes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking whether gettimeofday can accept two arguments" >&5 $as_echo_n "checking whether gettimeofday can accept two arguments... " >&6; } -if test "${emacs_cv_gettimeofday_two_arguments+set}" = set; then : +if ${emacs_cv_gettimeofday_two_arguments+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -18328,7 +18350,7 @@ fi ok_so_far=yes ac_fn_c_check_func "$LINENO" "socket" "ac_cv_func_socket" -if test "x$ac_cv_func_socket" = x""yes; then : +if test "x$ac_cv_func_socket" = xyes; then : else ok_so_far=no @@ -18336,7 +18358,7 @@ fi if test $ok_so_far = yes; then ac_fn_c_check_header_mongrel "$LINENO" "netinet/in.h" "ac_cv_header_netinet_in_h" "$ac_includes_default" -if test "x$ac_cv_header_netinet_in_h" = x""yes; then : +if test "x$ac_cv_header_netinet_in_h" = xyes; then : else ok_so_far=no @@ -18346,7 +18368,7 @@ fi fi if test $ok_so_far = yes; then ac_fn_c_check_header_mongrel "$LINENO" "arpa/inet.h" "ac_cv_header_arpa_inet_h" "$ac_includes_default" -if test "x$ac_cv_header_arpa_inet_h" = x""yes; then : +if test "x$ac_cv_header_arpa_inet_h" = xyes; then : else ok_so_far=no @@ -18380,7 +18402,7 @@ $as_echo "no" >&6; } fi ac_fn_c_check_type "$LINENO" "pid_t" "ac_cv_type_pid_t" "$ac_includes_default" -if test "x$ac_cv_type_pid_t" = x""yes; then : +if test "x$ac_cv_type_pid_t" = xyes; then : else @@ -18393,7 +18415,7 @@ fi for ac_header in vfork.h do : ac_fn_c_check_header_mongrel "$LINENO" "vfork.h" "ac_cv_header_vfork_h" "$ac_includes_default" -if test "x$ac_cv_header_vfork_h" = x""yes; then : +if test "x$ac_cv_header_vfork_h" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_VFORK_H 1 _ACEOF @@ -18417,7 +18439,7 @@ done if test "x$ac_cv_func_fork" = xyes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working fork" >&5 $as_echo_n "checking for working fork... " >&6; } -if test "${ac_cv_func_fork_works+set}" = set; then : +if ${ac_cv_func_fork_works+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -18470,7 +18492,7 @@ ac_cv_func_vfork_works=$ac_cv_func_vfork if test "x$ac_cv_func_vfork" = xyes; then { $as_echo "$as_me:${as_lineno-$LINENO}: checking for working vfork" >&5 $as_echo_n "checking for working vfork... " >&6; } -if test "${ac_cv_func_vfork_works+set}" = set; then : +if ${ac_cv_func_vfork_works+:} false; then : $as_echo_n "(cached) " >&6 else if test "$cross_compiling" = yes; then : @@ -18606,7 +18628,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for nl_langinfo and CODESET" >&5 $as_echo_n "checking for nl_langinfo and CODESET... " >&6; } -if test "${emacs_cv_langinfo_codeset+set}" = set; then : +if ${emacs_cv_langinfo_codeset+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -18638,7 +18660,7 @@ $as_echo "#define HAVE_LANGINFO_CODESET 1" >>confdefs.h fi ac_fn_c_check_type "$LINENO" "size_t" "ac_cv_type_size_t" "$ac_includes_default" -if test "x$ac_cv_type_size_t" = x""yes; then : +if test "x$ac_cv_type_size_t" = xyes; then : cat >>confdefs.h <<_ACEOF #define HAVE_SIZE_T 1 @@ -18650,7 +18672,7 @@ fi { $as_echo "$as_me:${as_lineno-$LINENO}: checking for mbstate_t" >&5 $as_echo_n "checking for mbstate_t... " >&6; } -if test "${ac_cv_type_mbstate_t+set}" = set; then : +if ${ac_cv_type_mbstate_t+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -18686,7 +18708,7 @@ $as_echo "#define mbstate_t int" >>confdefs.h { $as_echo "$as_me:${as_lineno-$LINENO}: checking for C restricted array declarations" >&5 $as_echo_n "checking for C restricted array declarations... " >&6; } -if test "${emacs_cv_c_restrict_arr+set}" = set; then : +if ${emacs_cv_c_restrict_arr+:} false; then : $as_echo_n "(cached) " >&6 else cat confdefs.h - <<_ACEOF >conftest.$ac_ext @@ -19275,10 +19297,21 @@ $as_echo "$as_me: WARNING: cache variable $ac_var contains a newline" >&2;} ;; :end' >>confcache if diff "$cache_file" confcache >/dev/null 2>&1; then :; else if test -w "$cache_file"; then - test "x$cache_file" != "x/dev/null" && + if test "x$cache_file" != "x/dev/null"; then { $as_echo "$as_me:${as_lineno-$LINENO}: updating cache $cache_file" >&5 $as_echo "$as_me: updating cache $cache_file" >&6;} - cat confcache >$cache_file + if test ! -f "$cache_file" || test -h "$cache_file"; then + cat confcache >"$cache_file" + else + case $cache_file in #( + */* | ?:*) + mv -f confcache "$cache_file"$$ && + mv -f "$cache_file"$$ "$cache_file" ;; #( + *) + mv -f confcache "$cache_file" ;; + esac + fi + fi else { $as_echo "$as_me:${as_lineno-$LINENO}: not updating unwritable cache $cache_file" >&5 $as_echo "$as_me: not updating unwritable cache $cache_file" >&6;} @@ -19364,7 +19397,7 @@ fi -: ${CONFIG_STATUS=./config.status} +: "${CONFIG_STATUS=./config.status}" ac_write_fail=0 ac_clean_files_save=$ac_clean_files ac_clean_files="$ac_clean_files $CONFIG_STATUS" @@ -19465,6 +19498,7 @@ fi IFS=" "" $as_nl" # Find who we are. Look in the path if we contain no directory separator. +as_myself= case $0 in #(( *[\\/]* ) as_myself=$0 ;; *) as_save_IFS=$IFS; IFS=$PATH_SEPARATOR @@ -19772,7 +19806,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # values after options handling. ac_log=" This file was extended by emacs $as_me 24.0.50, which was -generated by GNU Autoconf 2.67. Invocation command line was +generated by GNU Autoconf 2.68. Invocation command line was CONFIG_FILES = $CONFIG_FILES CONFIG_HEADERS = $CONFIG_HEADERS @@ -19838,7 +19872,7 @@ cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ emacs config.status 24.0.50 -configured by $0, generated by GNU Autoconf 2.67, +configured by $0, generated by GNU Autoconf 2.68, with options \\"\$ac_cs_config\\" Copyright (C) 2010 Free Software Foundation, Inc. @@ -19984,7 +20018,7 @@ do "test/automated/Makefile") CONFIG_FILES="$CONFIG_FILES test/automated/Makefile" ;; "default") CONFIG_COMMANDS="$CONFIG_COMMANDS default" ;; - *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5 ;; + *) as_fn_error $? "invalid argument: \`$ac_config_target'" "$LINENO" 5;; esac done @@ -20007,9 +20041,10 @@ fi # after its creation but before its name has been assigned to `$tmp'. $debug || { - tmp= + tmp= ac_tmp= trap 'exit_status=$? - { test -z "$tmp" || test ! -d "$tmp" || rm -fr "$tmp"; } && exit $exit_status + : "${ac_tmp:=$tmp}" + { test ! -d "$ac_tmp" || rm -fr "$ac_tmp"; } && exit $exit_status ' 0 trap 'as_fn_exit 1' 1 2 13 15 } @@ -20017,12 +20052,13 @@ $debug || { tmp=`(umask 077 && mktemp -d "./confXXXXXX") 2>/dev/null` && - test -n "$tmp" && test -d "$tmp" + test -d "$tmp" } || { tmp=./conf$$-$RANDOM (umask 077 && mkdir "$tmp") } || as_fn_error $? "cannot create a temporary directory in ." "$LINENO" 5 +ac_tmp=$tmp # Set up the scripts for CONFIG_FILES section. # No need to generate them if there are no CONFIG_FILES. @@ -20061,13 +20097,13 @@ else ac_cs_awk_cr=$ac_cr fi -echo 'BEGIN {' >"$tmp/subs1.awk" && +echo 'BEGIN {' >"$ac_tmp/subs1.awk" && _ACEOF # Create commands to substitute file output variables. { echo "cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1" && - echo 'cat >>"\$tmp/subs1.awk" <<\\_ACAWK &&' && + echo 'cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK &&' && echo "$ac_subst_files" | sed 's/.*/F["&"]="$&"/' && echo "_ACAWK" && echo "_ACEOF" @@ -20100,7 +20136,7 @@ done rm -f conf$$subs.sh cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 -cat >>"\$tmp/subs1.awk" <<\\_ACAWK && +cat >>"\$ac_tmp/subs1.awk" <<\\_ACAWK && _ACEOF sed -n ' h @@ -20148,7 +20184,7 @@ t delim rm -f conf$$subs.awk cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 _ACAWK -cat >>"\$tmp/subs1.awk" <<_ACAWK && +cat >>"\$ac_tmp/subs1.awk" <<_ACAWK && for (key in S) S_is_set[key] = 1 FS = "" \$ac_cs_awk_pipe_init @@ -20186,7 +20222,7 @@ if sed "s/$ac_cr//" < /dev/null > /dev/null 2>&1; then sed "s/$ac_cr\$//; s/$ac_cr/$ac_cs_awk_cr/g" else cat -fi < "$tmp/subs1.awk" > "$tmp/subs.awk" \ +fi < "$ac_tmp/subs1.awk" > "$ac_tmp/subs.awk" \ || as_fn_error $? "could not setup config files machinery" "$LINENO" 5 _ACEOF @@ -20220,7 +20256,7 @@ fi # test -n "$CONFIG_FILES" # No need to generate them if there are no CONFIG_HEADERS. # This happens for instance with `./config.status Makefile'. if test -n "$CONFIG_HEADERS"; then -cat >"$tmp/defines.awk" <<\_ACAWK || +cat >"$ac_tmp/defines.awk" <<\_ACAWK || BEGIN { _ACEOF @@ -20232,8 +20268,8 @@ _ACEOF # handling of long lines. ac_delim='%!_!# ' for ac_last_try in false false :; do - ac_t=`sed -n "/$ac_delim/p" confdefs.h` - if test -z "$ac_t"; then + ac_tt=`sed -n "/$ac_delim/p" confdefs.h` + if test -z "$ac_tt"; then break elif $ac_last_try; then as_fn_error $? "could not make $CONFIG_HEADERS" "$LINENO" 5 @@ -20334,7 +20370,7 @@ do esac case $ac_mode$ac_tag in :[FHL]*:*);; - :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5 ;; + :L* | :C*:*) as_fn_error $? "invalid tag \`$ac_tag'" "$LINENO" 5;; :[FH]-) ac_tag=-:-;; :[FH]*) ac_tag=$ac_tag:$ac_tag.in;; esac @@ -20353,7 +20389,7 @@ do for ac_f do case $ac_f in - -) ac_f="$tmp/stdin";; + -) ac_f="$ac_tmp/stdin";; *) # Look for the file first in the build tree, then in the source tree # (if the path is not absolute). The absolute path cannot be DOS-style, # because $ac_f cannot contain `:'. @@ -20362,7 +20398,7 @@ do [\\/$]*) false;; *) test -f "$srcdir/$ac_f" && ac_f="$srcdir/$ac_f";; esac || - as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5 ;; + as_fn_error 1 "cannot find input file: \`$ac_f'" "$LINENO" 5;; esac case $ac_f in *\'*) ac_f=`$as_echo "$ac_f" | sed "s/'/'\\\\\\\\''/g"`;; esac as_fn_append ac_file_inputs " '$ac_f'" @@ -20388,8 +20424,8 @@ $as_echo "$as_me: creating $ac_file" >&6;} esac case $ac_tag in - *:-:* | *:-) cat >"$tmp/stdin" \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; + *:-:* | *:-) cat >"$ac_tmp/stdin" \ + || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; esac ;; esac @@ -20527,24 +20563,25 @@ $ac_datarootdir_hack " eval sed \"\$ac_sed_extra\" "$ac_file_inputs" | if $ac_cs_awk_getline; then - $AWK -f "$tmp/subs.awk" + $AWK -f "$ac_tmp/subs.awk" else - $AWK -f "$tmp/subs.awk" | $SHELL -fi >$tmp/out \ - || as_fn_error $? "could not create $ac_file" "$LINENO" 5 + $AWK -f "$ac_tmp/subs.awk" | $SHELL +fi \ + >$ac_tmp/out || as_fn_error $? "could not create $ac_file" "$LINENO" 5 test -z "$ac_datarootdir_hack$ac_datarootdir_seen" && - { ac_out=`sed -n '/\${datarootdir}/p' "$tmp/out"`; test -n "$ac_out"; } && - { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' "$tmp/out"`; test -z "$ac_out"; } && + { ac_out=`sed -n '/\${datarootdir}/p' "$ac_tmp/out"`; test -n "$ac_out"; } && + { ac_out=`sed -n '/^[ ]*datarootdir[ ]*:*=/p' \ + "$ac_tmp/out"`; test -z "$ac_out"; } && { $as_echo "$as_me:${as_lineno-$LINENO}: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&5 $as_echo "$as_me: WARNING: $ac_file contains a reference to the variable \`datarootdir' which seems to be undefined. Please make sure it is defined" >&2;} - rm -f "$tmp/stdin" + rm -f "$ac_tmp/stdin" case $ac_file in - -) cat "$tmp/out" && rm -f "$tmp/out";; - *) rm -f "$ac_file" && mv "$tmp/out" "$ac_file";; + -) cat "$ac_tmp/out" && rm -f "$ac_tmp/out";; + *) rm -f "$ac_file" && mv "$ac_tmp/out" "$ac_file";; esac \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 ;; @@ -20555,20 +20592,20 @@ which seems to be undefined. Please make sure it is defined" >&2;} if test x"$ac_file" != x-; then { $as_echo "/* $configure_input */" \ - && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" - } >"$tmp/config.h" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" + } >"$ac_tmp/config.h" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 - if diff "$ac_file" "$tmp/config.h" >/dev/null 2>&1; then + if diff "$ac_file" "$ac_tmp/config.h" >/dev/null 2>&1; then { $as_echo "$as_me:${as_lineno-$LINENO}: $ac_file is unchanged" >&5 $as_echo "$as_me: $ac_file is unchanged" >&6;} else rm -f "$ac_file" - mv "$tmp/config.h" "$ac_file" \ + mv "$ac_tmp/config.h" "$ac_file" \ || as_fn_error $? "could not create $ac_file" "$LINENO" 5 fi else $as_echo "/* $configure_input */" \ - && eval '$AWK -f "$tmp/defines.awk"' "$ac_file_inputs" \ + && eval '$AWK -f "$ac_tmp/defines.awk"' "$ac_file_inputs" \ || as_fn_error $? "could not create -" "$LINENO" 5 fi # Compute "$ac_file"'s index in $config_headers. diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index c5e445cec38..338dbb5e7fd 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,9 @@ +2011-03-01 Stefan Monnier + + * variables.texi (Scope): Mention the availability of lexical scoping. + (Lexical Binding): New node. + * eval.texi (Eval): Add `eval's new `lexical' arg. + 2011-02-25 Stefan Monnier * vol2.texi (Top): diff --git a/doc/lispref/elisp.texi b/doc/lispref/elisp.texi index f7c1d55f6ae..cc3ceb8003c 100644 --- a/doc/lispref/elisp.texi +++ b/doc/lispref/elisp.texi @@ -466,7 +466,8 @@ Functions * 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 - 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/eval.texi b/doc/lispref/eval.texi index d44fe5bb95b..74f3d9c48b9 100644 --- a/doc/lispref/eval.texi +++ b/doc/lispref/eval.texi @@ -585,6 +585,11 @@ occurrence in a program being run. On rare occasions, you may need to write code that evaluates a form that is computed at run time, such as after reading a form from text being edited or getting one from a property list. On these occasions, use the @code{eval} function. +Often @code{eval} is not needed and something else should be used instead. +For example, to get the value of a variable, while @code{eval} works, +@code{symbol-value} is preferable; or rather than store expressions +in a property list that then need to go through @code{eval}, it is better to +store functions instead that are then passed to @code{funcall}. The functions and variables described in this section evaluate forms, specify limits to the evaluation process, or record recently returned @@ -596,10 +601,13 @@ to store an expression in the data structure and evaluate it. Using functions provides the ability to pass information to them as arguments. -@defun eval form +@defun eval form &optional lexical This is the basic function evaluating an expression. It evaluates @var{form} in the current environment and returns the result. How the evaluation proceeds depends on the type of the object (@pxref{Forms}). +@var{lexical} if non-nil means to evaluate @var{form} using lexical scoping +rules (@pxref{Lexical Binding}) instead of the default dynamic scoping used +historically in Emacs Lisp. Since @code{eval} is a function, the argument expression that appears in a call to @code{eval} is evaluated twice: once as preparation before diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 0cdcaa84d58..edffb4742ec 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -25,22 +25,22 @@ textual Lisp program is written using the read syntax for the symbol representing the variable. @menu -* Global Variables:: Variable values that exist permanently, everywhere. -* Constant Variables:: Certain "variables" have values that never change. -* Local Variables:: Variable values that exist only temporarily. -* Void Variables:: Symbols that lack values. -* Defining Variables:: A definition says a symbol is used as a variable. -* Tips for Defining:: Things you should think about when you +* Global Variables:: Variable values that exist permanently, everywhere. +* Constant Variables:: Certain "variables" have values that never change. +* Local Variables:: Variable values that exist only temporarily. +* Void Variables:: Symbols that lack values. +* Defining Variables:: A definition says a symbol is used as a variable. +* Tips for Defining:: Things you should think about when you define a variable. -* Accessing Variables:: Examining values of variables whose names +* Accessing Variables:: Examining values of variables whose names are known only at run time. -* Setting Variables:: Storing new values in variables. -* Variable Scoping:: How Lisp chooses among local and global values. -* Buffer-Local Variables:: Variable values in effect only in one buffer. -* File Local Variables:: Handling local variable lists in files. -* Directory Local Variables:: Local variables common to all files in a directory. -* Frame-Local Variables:: Frame-local bindings for variables. -* Variable Aliases:: Variables that are aliases for other variables. +* Setting Variables:: Storing new values in variables. +* Variable Scoping:: How Lisp chooses among local and global values. +* Buffer-Local Variables:: Variable values in effect only in one buffer. +* File Local Variables:: Handling local variable lists in files. +* Directory Local Variables:: Local variables common to all files in a directory. +* Frame-Local Variables:: Frame-local bindings for variables. +* Variable Aliases:: Variables that are aliases for other variables. * Variables with Restricted Values:: Non-constant variables whose value can @emph{not} be an arbitrary Lisp object. @end menu @@ -437,14 +437,18 @@ this reason, user options must be defined with @code{defvar}. This special form defines @var{symbol} as a variable and can also initialize and document it. The definition informs a person reading your code that @var{symbol} is used as a variable that might be set or -changed. Note that @var{symbol} is not evaluated; the symbol to be -defined must appear explicitly in the @code{defvar}. +changed. It also declares this variable as @dfn{special}, meaning that it +should always use dynamic scoping rules. Note that @var{symbol} is not +evaluated; the symbol to be defined must appear explicitly in the +@code{defvar}. If @var{symbol} is void and @var{value} is specified, @code{defvar} evaluates it and sets @var{symbol} to the result. But if @var{symbol} already has a value (i.e., it is not void), @var{value} is not even -evaluated, and @var{symbol}'s value remains unchanged. If @var{value} -is omitted, the value of @var{symbol} is not changed in any case. +evaluated, and @var{symbol}'s value remains unchanged. +If @var{value} is omitted, the value of @var{symbol} is not changed in any +case; instead, the only effect of @code{defvar} is to declare locally that this +variable exists elsewhere and should hence always use dynamic scoping rules. If @var{symbol} has a buffer-local binding in the current buffer, @code{defvar} operates on the default value, which is buffer-independent, @@ -881,7 +885,7 @@ the others. @cindex extent @cindex dynamic scoping @cindex lexical scoping - Local bindings in Emacs Lisp have @dfn{indefinite scope} and + By default, local bindings in Emacs Lisp have @dfn{indefinite scope} and @dfn{dynamic extent}. @dfn{Scope} refers to @emph{where} textually in the source code the binding can be accessed. ``Indefinite scope'' means that any part of the program can potentially access the variable @@ -893,6 +897,8 @@ lasts as long as the activation of the construct that established it. @dfn{dynamic scoping}. By contrast, most programming languages use @dfn{lexical scoping}, in which references to a local variable must be located textually within the function or block that binds the variable. +Emacs can also support lexical scoping, upon request (@pxref{Lexical +Binding}). @cindex CL note---special variables @quotation @@ -901,11 +907,12 @@ dynamically scoped, like all variables in Emacs Lisp. @end quotation @menu -* Scope:: Scope means where in the program a value is visible. +* Scope:: Scope means where in the program a value is visible. Comparison with other languages. -* Extent:: Extent means how long in time a value exists. -* Impl of Scope:: Two ways to implement dynamic scoping. -* Using Scoping:: How to use dynamic scoping carefully and avoid problems. +* Extent:: Extent means how long in time a value exists. +* Impl of Scope:: Two ways to implement dynamic scoping. +* Using Scoping:: How to use dynamic scoping carefully and avoid problems. +* Lexical Binding:: @end menu @node Scope @@ -969,12 +976,12 @@ Here, when @code{foo} is called by @code{binder}, it binds @code{x}. by @code{foo} instead of the one bound by @code{binder}. @end itemize -Emacs Lisp uses dynamic scoping because simple implementations of +Emacs Lisp used dynamic scoping by default because simple implementations of lexical scoping are slow. In addition, every Lisp system needs to offer -dynamic scoping at least as an option; if lexical scoping is the norm, -there must be a way to specify dynamic scoping instead for a particular -variable. It might not be a bad thing for Emacs to offer both, but -implementing it with dynamic scoping only was much easier. +dynamic scoping at least as an option; if lexical scoping is the norm, there +must be a way to specify dynamic scoping instead for a particular variable. +Nowadays, Emacs offers both, but the default is still to use exclusively +dynamic scoping. @node Extent @subsection Extent @@ -1088,6 +1095,48 @@ for inter-function usage. It also avoids a warning from the byte compiler. Choose the variable's name to avoid name conflicts---don't use short names like @code{x}. + +@node Lexical Binding +@subsection Use of Lexical Scoping + +Emacs Lisp can be evaluated in two different modes: in dynamic binding mode or +lexical binding mode. In dynamic binding mode, all local variables use dynamic +scoping, whereas in lexical binding mode variables that have been declared +@dfn{special} (i.e., declared with @code{defvar} or @code{defconst}) use +dynamic scoping and all others use lexical scoping. + +@defvar lexical-binding +When non-nil, evaluation of Lisp code uses lexical scoping for non-special +local variables instead of dynamic scoping. If nil, dynamic scoping is used +for all local variables. This variable is typically set for a whole Elisp file +via file local variables (@pxref{File Local Variables}). +@end defvar + +@defun special-variable-p SYMBOL +Return whether SYMBOL has been declared as a special variable, via +@code{defvar} or @code{defconst}. +@end defun + +The use of a special variable as a formal argument in a function is generally +discouraged and its behavior in lexical binding mode is unspecified (it may use +lexical scoping sometimes and dynamic scoping other times). + +Functions like @code{symbol-value}, @code{boundp}, or @code{set} only know +about dynamically scoped variables, so you cannot get the value of a lexical +variable via @code{symbol-value} and neither can you change it via @code{set}. +Another particularity is that code in the body of a @code{defun} or +@code{defmacro} cannot refer to surrounding lexical variables. + +Evaluation of a @code{lambda} expression in lexical binding mode will not just +return that lambda expression unchanged, as in the dynamic binding case, but +will instead construct a new object that remembers the current lexical +environment in which that lambda expression was defined, so that the function +body can later be evaluated in the proper context. Those objects are called +@dfn{closures}. They are also functions, in the sense that they are accepted +by @code{funcall}, and they are represented by a cons cell whose @code{car} is +the symbol @code{closure}. + + @node Buffer-Local Variables @section Buffer-Local Variables @cindex variable, buffer-local @@ -1103,9 +1152,9 @@ local to each terminal, or to each frame. @xref{Multiple Terminals}, and @xref{Frame-Local Variables}.) @menu -* Intro to Buffer-Local:: Introduction and concepts. -* Creating Buffer-Local:: Creating and destroying buffer-local bindings. -* Default Value:: The default value is seen in buffers +* Intro to Buffer-Local:: Introduction and concepts. +* Creating Buffer-Local:: Creating and destroying buffer-local bindings. +* Default Value:: The default value is seen in buffers that don't have their own buffer-local values. @end menu diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 4a22b148469..10f57c2b96a 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,24 @@ +2011-03-01 Stefan Monnier + + * emacs-lisp/cconv.el (cconv-liftwhen): Increase threshold. + (cconv-closure-convert-rec): Convert interactive spec in empty lexenv. + (cconv-analyse-use): Improve unused vars warnings. + (cconv-analyse-form): Analyze interactive spec in empty lexenv. + * emacs-lisp/bytecomp.el (byte-compile-lambda): Always byte-compile + the interactive spec in lexical-binding mode. + (byte-compile-refresh-preloaded): Don't reload byte-compiler files. + * custom.el (custom-initialize-default): Use defvar. + (custom-declare-variable): Set the special-variable-p flag. + * help-fns.el (help-make-usage): Drop leading underscores. + * dired.el (dired-revert, dired-make-relative): Mark unused args. + (dired-unmark-all-files): Remove unused var `query'. + (dired-overwrite-confirmed): Declare. + (dired-restore-desktop-buffer): Don't use dynamically scoped arg names. + * mpc.el: Mark unused args. + (mpc--faster-toggle): Remove unused var `songnb'. + * server.el (server-kill-buffer-running): Move before first use. + * minibuffer.el: Mark unused args. + 2011-02-26 Stefan Monnier * emacs-lisp/cconv.el (cconv-closure-convert-rec): Fix last change for @@ -335,6 +356,15 @@ Merge funvec patch. +2004-05-20 Miles Bader + + * 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. + 2004-04-29 Miles Bader * emacs-lisp/bytecomp.el (byte-compile-top-level): Add new entries diff --git a/lisp/ChangeLog.funvec b/lisp/ChangeLog.funvec deleted file mode 100644 index 0a31b9a590f..00000000000 --- a/lisp/ChangeLog.funvec +++ /dev/null @@ -1,10 +0,0 @@ -2004-05-20 Miles Bader - - * 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/Makefile.in b/lisp/Makefile.in index 0182b7f5072..268a45d8948 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -222,6 +222,9 @@ compile-onefile: # cannot have prerequisites. .el.elc: @echo Compiling $< + @# The BIG_STACK_OPTS are only needed to byte-compile the byte-compiler + @# files, which is normally done in compile-first, but may also be + @# recompiled via this rule. @$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ -f batch-byte-compile $< diff --git a/lisp/custom.el b/lisp/custom.el index e41e7c7bdf8..d0d11610b91 100644 --- a/lisp/custom.el +++ b/lisp/custom.el @@ -55,11 +55,9 @@ Otherwise, if symbol has a `saved-value' property, it will evaluate the car of that and use it as the default binding for symbol. Otherwise, VALUE will be evaluated and used as the default binding for symbol." - (unless (default-boundp symbol) - ;; Use the saved value if it exists, otherwise the standard setting. - (set-default symbol (eval (if (get symbol 'saved-value) - (car (get symbol 'saved-value)) - value))))) + (eval `(defvar ,symbol ,(if (get symbol 'saved-value) + (car (get symbol 'saved-value)) + value)))) (defun custom-initialize-set (symbol value) "Initialize SYMBOL based on VALUE. @@ -81,15 +79,15 @@ The value is either the symbol's current value \(as obtained using the `:get' function), if any, or the value in the symbol's `saved-value' property if any, or (last of all) VALUE." - (funcall (or (get symbol 'custom-set) 'set-default) - symbol - (cond ((default-boundp symbol) - (funcall (or (get symbol 'custom-get) 'default-value) - symbol)) - ((get symbol 'saved-value) - (eval (car (get symbol 'saved-value)))) - (t - (eval value))))) + (funcall (or (get symbol 'custom-set) 'set-default) + symbol + (cond ((default-boundp symbol) + (funcall (or (get symbol 'custom-get) 'default-value) + symbol)) + ((get symbol 'saved-value) + (eval (car (get symbol 'saved-value)))) + (t + (eval value))))) (defun custom-initialize-changed (symbol value) "Initialize SYMBOL with VALUE. @@ -142,10 +140,8 @@ set to nil, as the value is no longer rogue." ;; Maybe this option was rogue in an earlier version. It no longer is. (when (get symbol 'force-value) (put symbol 'force-value nil)) - (when doc - (if (keywordp doc) - (error "Doc string is missing") - (put symbol 'variable-documentation doc))) + (if (keywordp doc) + (error "Doc string is missing")) (let ((initialize 'custom-initialize-reset) (requests nil)) (unless (memq :group args) @@ -189,6 +185,13 @@ set to nil, as the value is no longer rogue." ;; Do the actual initialization. (unless custom-dont-initialize (funcall initialize symbol default))) + ;; Use defvar to set the docstring as well as the special-variable-p flag. + ;; FIXME: We should reproduce more of `defvar's behavior, such as the warning + ;; when the var is currently let-bound. + (if (not (default-boundp symbol)) + ;; Don't use defvar to avoid setting a default-value when undesired. + (when doc (put symbol 'variable-documentation doc)) + (eval `(defvar ,symbol nil ,@(when doc (list doc))))) (push symbol current-load-list) (run-hooks 'custom-define-hook) symbol) diff --git a/lisp/dired.el b/lisp/dired.el index 4a17b443cfa..af99d4c7413 100644 --- a/lisp/dired.el +++ b/lisp/dired.el @@ -1168,7 +1168,7 @@ If HDR is non-nil, insert a header line with the directory name." ;; Reverting a dired buffer -(defun dired-revert (&optional arg noconfirm) +(defun dired-revert (&optional _arg _noconfirm) "Reread the dired buffer. Must also be called after `dired-actual-switches' have changed. Should not fail even on completely garbaged buffers. @@ -2129,7 +2129,7 @@ Optional arg GLOBAL means to replace all matches." ;; dired-get-filename. (concat (or dir default-directory) file)) -(defun dired-make-relative (file &optional dir ignore) +(defun dired-make-relative (file &optional dir _ignore) "Convert FILE (an absolute file name) to a name relative to DIR. If this is impossible, return FILE unchanged. DIR must be a directory name, not a file name." @@ -3219,7 +3219,7 @@ Type \\[help-command] at that time for help." (interactive "cRemove marks (RET means all): \nP") (save-excursion (let* ((count 0) - (inhibit-read-only t) case-fold-search query + (inhibit-read-only t) case-fold-search (string (format "\n%c" mark)) (help-form "\ Type SPC or `y' to unmark one file, DEL or `n' to skip to next, @@ -3494,6 +3494,8 @@ Anything else means ask for each directory." (declare-function dnd-get-local-file-name "dnd" (uri &optional must-exist)) (declare-function dnd-get-local-file-uri "dnd" (uri)) +(defvar dired-overwrite-confirmed) ;Defined in dired-aux. + (defun dired-dnd-handle-local-file (uri action) "Copy, move or link a file to the dired directory. URI is the file to handle, ACTION is one of copy, move, link or ask. @@ -3572,21 +3574,21 @@ Ask means pop up a menu for the user to select one of copy, move or link." (function (lambda (f) (desktop-file-name (car f) dirname))) dired-subdir-alist))))) -(defun dired-restore-desktop-buffer (desktop-buffer-file-name - desktop-buffer-name - desktop-buffer-misc) +(defun dired-restore-desktop-buffer (_file-name + _buffer-name + misc-data) "Restore a dired buffer specified in a desktop file." - ;; First element of `desktop-buffer-misc' is the value of `dired-directory'. + ;; First element of `misc-data' is the value of `dired-directory'. ;; This value is a directory name, optionally with shell wildcard or ;; a directory name followed by list of files. - (let* ((dired-dir (car desktop-buffer-misc)) + (let* ((dired-dir (car misc-data)) (dir (if (consp dired-dir) (car dired-dir) dired-dir))) (if (file-directory-p (file-name-directory dir)) (progn (dired dired-dir) - ;; The following elements of `desktop-buffer-misc' are the keys + ;; The following elements of `misc-data' are the keys ;; from `dired-subdir-alist'. - (mapc 'dired-maybe-insert-subdir (cdr desktop-buffer-misc)) + (mapc 'dired-maybe-insert-subdir (cdr misc-data)) (current-buffer)) (message "Desktop: Directory %s no longer exists." dir) (when desktop-missing-file-warning (sit-for 1)) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 342dd8b71d1..d86cb729081 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -308,6 +308,10 @@ ;; ((lambda ...) ...) (defun byte-compile-unfold-lambda (form &optional name) + ;; In lexical-binding mode, let and functions don't bind vars in the same way + ;; (let obey special-variable-p, but functions don't). This doesn't matter + ;; here, because function's behavior is underspecified so it can safely be + ;; turned into a `let', even though the reverse is not true. (or name (setq name "anonymous lambda")) (let ((lambda (car form)) (values (cdr form))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 4a53faefa3d..3575b10e1f1 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2563,6 +2563,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off. ((let (tmp) + ;; FIXME: can this happen? (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) (null (cdr (memq tmp fun)))) ;; Generate a make-byte-code call. @@ -2587,7 +2588,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (list 'quote fun)))))) ;; Turn a function into an ordinary lambda. Needed for v18 files. -(defun byte-compile-byte-code-unmake (function) +(defun byte-compile-byte-code-unmake (function) ;FIXME: what is it? (if (consp function) function;;It already is a lambda. (setq function (append function nil)) ; turn it into a list @@ -2685,16 +2686,19 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; compile it, because `call-interactively' looks at the ;; args of `list'. Actually, compile it to get warnings, ;; but don't use the result. - (let ((form (nth 1 bytecomp-int))) + (let* ((form (nth 1 bytecomp-int)) + (newform (byte-compile-top-level form))) (while (memq (car-safe form) '(let let* progn save-excursion)) (while (consp (cdr form)) (setq form (cdr form))) (setq form (car form))) - (if (eq (car-safe form) 'list) - (byte-compile-top-level (nth 1 bytecomp-int)) - (setq bytecomp-int (list 'interactive - (byte-compile-top-level - (nth 1 bytecomp-int))))))) + (if (and (eq (car-safe form) 'list) + ;; The spec is evaled in callint.c in dynamic-scoping + ;; mode, so just leaving the form unchanged would mean + ;; it won't be eval'd in the right mode. + (not lexical-binding)) + nil + (setq bytecomp-int `(interactive ,newform))))) ((cdr bytecomp-int) (byte-compile-warn "malformed interactive spec: %s" (prin1-to-string bytecomp-int))))) @@ -3826,7 +3830,6 @@ Return the offset in the form (VAR . OFFSET)." (byte-compile-push-constant nil))))) (defun byte-compile-not-lexical-var-p (var) - ;; FIXME: this doesn't catch defcustoms! (or (not (symbolp var)) (special-variable-p var) (memq var byte-compile-bound-variables) @@ -4560,7 +4563,14 @@ Use with caution." (setq f (car f)) (if (string-match "elc\\'" f) (setq f (substring f 0 -1))) (when (and (file-readable-p f) - (file-newer-than-file-p f emacs-file)) + (file-newer-than-file-p f emacs-file) + ;; Don't reload the source version of the files below + ;; because that causes subsequent byte-compilation to + ;; be a lot slower and need a higher max-lisp-eval-depth, + ;; so it can cause recompilation to fail. + (not (member (file-name-nondirectory f) + '("pcase.el" "bytecomp.el" "macroexp.el" + "cconv.el" "byte-opt.el")))) (message "Reloading stale %s" (file-name-nondirectory f)) (condition-case nil (load f 'noerror nil 'nosuffix) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 006e2ef904c..7855193fa3f 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -65,21 +65,54 @@ ;; ;;; Code: -;;; TODO: -;; - pay attention to `interactive': its arg is run in an empty env. +;; TODO: ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. ;; - Change new byte-code representation, so it directly gives the ;; number of mandatory and optional arguments as well as whether or ;; not there's a &rest arg. -;; - warn about unused lexical vars. ;; - clean up cconv-closure-convert-rec, especially the `let' binding part. ;; - new byte codes for unwind-protect, catch, and condition-case so that ;; closures aren't needed at all. +;; - a reference to a var that is known statically to always hold a constant +;; should be turned into a byte-constant rather than a byte-stack-ref. +;; Hmm... right, that's called constant propagation and could be done here +;; But when that constant is a function, we have to be careful to make sure +;; the bytecomp only compiles it once. +;; - Since we know here when a variable is not mutated, we could pass that +;; info to the byte-compiler, e.g. by using a new `immutable-let'. +;; - add tail-calls to bytecode.c and the bytecompiler. + +;; (defmacro dlet (binders &rest body) +;; ;; Works in both lexical and non-lexical mode. +;; `(progn +;; ,@(mapcar (lambda (binder) +;; `(defvar ,(if (consp binder) (car binder) binder))) +;; binders) +;; (let ,binders ,@body))) + +;; (defmacro llet (binders &rest body) +;; ;; Only works in lexical-binding mode. +;; `(funcall +;; (lambda ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder)) +;; binders) +;; ,@body) +;; ,@(mapcar (lambda (binder) (if (consp binder) (cadr binder))) +;; binders))) + +;; (defmacro letrec (binders &rest body) +;; ;; Only useful in lexical-binding mode. +;; ;; As a special-form, we could implement it more efficiently (and cleanly, +;; ;; making the vars actually unbound during evaluation of the binders). +;; `(let ,(mapcar (lambda (binder) (if (consp binder) (car binder) binder)) +;; binders) +;; ,@(delq nil (mapcar (lambda (binder) (if (consp binder) `(setq ,@binder))) +;; binders)) +;; ,@body)) (eval-when-compile (require 'cl)) -(defconst cconv-liftwhen 3 +(defconst cconv-liftwhen 6 "Try to do lambda lifting if the number of arguments + free variables is less than this number.") ;; List of all the variables that are both captured by a closure @@ -212,13 +245,13 @@ Returns a form where all lambdas don't have any free variables." ;; This function actually rewrites the tree. "Eliminates all free variables of all lambdas in given forms. Arguments: --- FORM is a piece of Elisp code after macroexpansion. --- LMENVS is a list of environments used for lambda-lifting. Initially empty. --- EMVRS is a list that contains mutated variables that are visible +- FORM is a piece of Elisp code after macroexpansion. +- LMENVS is a list of environments used for lambda-lifting. Initially empty. +- EMVRS is a list that contains mutated variables that are visible within current environment. --- ENVS is an environment(list of free variables) of current closure. +- ENVS is an environment(list of free variables) of current closure. Initially empty. --- FVRS is a list of variables to substitute in each context. +- FVRS is a list of variables to substitute in each context. Initially empty. Returns a form where all lambdas don't have any free variables." @@ -270,10 +303,17 @@ Returns a form where all lambdas don't have any free variables." ; lambda lifting condition (if (or (not fv) (< cconv-liftwhen (length funcvars))) ; do not lift - (cconv-closure-convert-rec - value emvrs fvrs envs lmenvs) + (progn + ;; (byte-compile-log-warning + ;; (format "Not λ-lifting `%S': %d > %d" + ;; var (length funcvars) cconv-liftwhen)) + + (cconv-closure-convert-rec + value emvrs fvrs envs lmenvs)) ; lift (progn + ;; (byte-compile-log-warning + ;; (format "λ-lifting `%S'" var)) (setq cconv-freevars-alist ;; Now that we know we'll λ-lift, consume the ;; freevar data. @@ -579,6 +619,12 @@ Returns a form where all lambdas don't have any free variables." cdr-new)) `(,callsym . ,(reverse cdr-new)))))) + (`(interactive . ,forms) + `(interactive + ,@(mapcar (lambda (form) + (cconv-closure-convert-rec form nil nil nil nil)) + forms))) + (`(,func . ,body-forms) ; first element is function or whatever ; function-like forms are: ; or, and, if, progn, prog1, prog2, @@ -608,23 +654,34 @@ Returns a form where all lambdas don't have any free variables." ;; Only used to test the code in non-lexbind Emacs. (defalias 'byte-compile-not-lexical-var-p 'boundp)) -(defun cconv-analyse-use (vardata form) +(defun cconv-analyse-use (vardata form varkind) + "Analyse the use of a variable. +VARDATA should be (BINDER READ MUTATED CAPTURED CALLED). +VARKIND is the name of the kind of variable. +FORM is the parent form that binds this var." ;; use = `(,binder ,read ,mutated ,captured ,called) (pcase vardata - (`(,binder nil ,_ ,_ nil) - ;; FIXME: Don't warn about unused fun-args. - ;; FIXME: Don't warn about uninterned vars or _ vars. - ;; FIXME: This gives warnings in the wrong order and with wrong line - ;; number and without function name info. - (byte-compile-log-warning (format "Unused variable %S" (car binder)))) + (`(,_ nil nil nil nil) nil) + (`((,(and (pred (lambda (var) (eq ?_ (aref (symbol-name var) 0)))) var) . ,_) + ,_ ,_ ,_ ,_) + (byte-compile-log-warning (format "%s `%S' not left unused" varkind var))) + ((or `(,_ ,_ ,_ ,_ ,_) dontcare) nil)) + (pcase vardata + (`((,var . ,_) nil ,_ ,_ nil) + ;; FIXME: This gives warnings in the wrong order, with imprecise line + ;; numbers and without function name info. + (unless (or ;; Uninterned symbols typically come from macro-expansion, so + ;; it is often non-trivial for the programmer to avoid such + ;; unused vars. + (not (intern-soft var)) + (eq ?_ (aref (symbol-name var) 0))) + (byte-compile-log-warning (format "Unused lexical %s `%S'" + varkind var)))) ;; If it's unused, there's no point converting it into a cons-cell, even if - ;; it's captures and mutated. + ;; it's captured and mutated. (`(,binder ,_ t t ,_) (push (cons binder form) cconv-captured+mutated)) (`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t) - ;; This is very rare in typical Elisp code. It's probably not really - ;; worth the trouble to try and use lambda-lifting in Elisp, but - ;; since we coded it up, we might as well use it. (push (cons binder form) cconv-lambda-candidates)) (`(,_ ,_ ,_ ,_ ,_) nil) (dontcare))) @@ -654,7 +711,7 @@ Returns a form where all lambdas don't have any free variables." (cconv-analyse-form form newenv)) ;; Summarize resulting data about arguments. (dolist (vardata newvars) - (cconv-analyse-use vardata parentform)) + (cconv-analyse-use vardata parentform "argument")) ;; Transfer uses collected in `envcopy' (via `newenv') back to `env'; ;; and compute free variables. (while env @@ -673,8 +730,8 @@ Returns a form where all lambdas don't have any free variables." (defun cconv-analyse-form (form env) "Find mutated variables and variables captured by closure. Analyse lambdas if they are suitable for lambda lifting. --- FORM is a piece of Elisp code after macroexpansion. --- ENV is an alist mapping each enclosing lexical variable to its info. +- FORM is a piece of Elisp code after macroexpansion. +- ENV is an alist mapping each enclosing lexical variable to its info. I.e. each element has the form (VAR . (READ MUTATED CAPTURED CALLED)). This function does not return anything but instead fills the `cconv-captured+mutated' and `cconv-lambda-candidates' variables @@ -707,7 +764,7 @@ and updates the data stored in ENV." (cconv-analyse-form form env)) (dolist (vardata newvars) - (cconv-analyse-use vardata form)))) + (cconv-analyse-use vardata form "variable")))) ; defun special form (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms) @@ -736,8 +793,7 @@ and updates the data stored in ENV." (`(cond . ,cond-forms) ; cond special form (dolist (forms cond-forms) - (dolist (form forms) - (cconv-analyse-form form env)))) + (dolist (form forms) (cconv-analyse-form form env)))) (`(quote . ,_) nil) ; quote form (`(function . ,_) nil) ; same as quote @@ -773,12 +829,18 @@ and updates the data stored in ENV." (if fdata (setf (nth 4 fdata) t) (cconv-analyse-form fun env))) - (dolist (form args) - (cconv-analyse-form form env))) + (dolist (form args) (cconv-analyse-form form env))) + (`(interactive . ,forms) + ;; These appear within the function body but they don't have access + ;; to the function's arguments. + ;; We could extend this to allow interactive specs to refer to + ;; variables in the function's enclosing environment, but it doesn't + ;; seem worth the trouble. + (dolist (form forms) (cconv-analyse-form form nil))) + (`(,_ . ,body-forms) ; First element is a function or whatever. - (dolist (form body-forms) - (cconv-analyse-form form env))) + (dolist (form body-forms) (cconv-analyse-form form env))) ((pred symbolp) (let ((dv (assq form env))) ; dv = declared and visible diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index d795dbd390c..89bbff980c4 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -431,7 +431,7 @@ and otherwise defers to REST which is a list of branches of the form rest))))))) ((eq 'match (caar matches)) (let* ((popmatches (pop matches)) - (op (car popmatches)) (cdrpopmatches (cdr popmatches)) + (_op (car popmatches)) (cdrpopmatches (cdr popmatches)) (sym (car cdrpopmatches)) (upat (cdr cdrpopmatches))) (cond @@ -520,7 +520,7 @@ and otherwise defers to REST which is a list of branches of the form (pcase--u1 `((match ,sym . ,(cadr upat))) ;; FIXME: This codegen is not careful to share its ;; code if used several times: code blow up is likely. - (lambda (vars) + (lambda (_vars) ;; `vars' will likely contain bindings which are ;; not always available in other paths to ;; `rest', so there' no point trying to pass diff --git a/lisp/help-fns.el b/lisp/help-fns.el index b488bc40acd..87fb6a02bd3 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -119,8 +119,11 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (cdr arg)) arg) (let ((name (symbol-name arg))) - (if (string-match "\\`&" name) arg - (intern (upcase name)))))) + (cond + ((string-match "\\`&" name) arg) + ((string-match "\\`_" name) + (intern (upcase (substring name 1)))) + (t (intern (upcase name))))))) arglist))) ;; Could be this, if we make symbol-file do the work below. diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el index 392ec2d3dad..531a0e26eaf 100644 --- a/lisp/minibuffer.el +++ b/lisp/minibuffer.el @@ -210,7 +210,7 @@ You should give VAR a non-nil `risky-local-variable' property." ((vectorp table) ;Obarray. (lambda (sym) (funcall pred (concat prefix (symbol-name sym))))) ((hash-table-p table) - (lambda (s v) (funcall pred (concat prefix s)))) + (lambda (s _v) (funcall pred (concat prefix s)))) ((functionp table) (lambda (s) (funcall pred (concat prefix s)))) (t ;Lists and alists. @@ -681,7 +681,7 @@ scroll the window of possible completions." t) (t t))))) -(defun completion--flush-all-sorted-completions (&rest ignore) +(defun completion--flush-all-sorted-completions (&rest _ignore) (setq completion-cycling nil) (setq completion-all-sorted-completions nil)) @@ -1313,7 +1313,7 @@ The completion method is determined by `completion-at-point-functions'." (concat "\\(?:^\\|[^$]\\(?:\\$\\$\\)*\\)" "$\\([[:alnum:]_]*\\|{\\([^}]*\\)\\)\\'")) -(defun completion--embedded-envvar-table (string pred action) +(defun completion--embedded-envvar-table (string _pred action) "Completion table for envvars embedded in a string. The envvar syntax (and escaping) rules followed by this table are the same as `substitute-in-file-name'." @@ -1726,13 +1726,13 @@ Like `internal-complete-buffer', but removes BUFFER from the completion list." ;;; Old-style completion, used in Emacs-21 and Emacs-22. -(defun completion-emacs21-try-completion (string table pred point) +(defun completion-emacs21-try-completion (string table pred _point) (let ((completion (try-completion string table pred))) (if (stringp completion) (cons completion (length completion)) completion))) -(defun completion-emacs21-all-completions (string table pred point) +(defun completion-emacs21-all-completions (string table pred _point) (completion-hilit-commonality (all-completions string table pred) (length string) @@ -1817,7 +1817,7 @@ Return the new suffix." (let* ((beforepoint (substring string 0 point)) (afterpoint (substring string point)) (bounds (completion-boundaries beforepoint table pred afterpoint)) - (suffix (substring afterpoint (cdr bounds))) + ;; (suffix (substring afterpoint (cdr bounds))) (prefix (substring beforepoint 0 (car bounds))) (pattern (delete "" (list (substring beforepoint (car bounds)) @@ -2006,7 +2006,7 @@ filter out additional entries (because TABLE migth not obey PRED)." ;; The prefix has no completions at all, so we should try and fix ;; that first. (let ((substring (substring prefix 0 -1))) - (destructuring-bind (subpat suball subprefix subsuffix) + (destructuring-bind (subpat suball subprefix _subsuffix) (completion-pcm--find-all-completions substring table pred (length substring) filter) (let ((sep (aref prefix (1- (length prefix)))) @@ -2071,7 +2071,7 @@ filter out additional entries (because TABLE migth not obey PRED)." (list pattern all prefix suffix))))) (defun completion-pcm-all-completions (string table pred point) - (destructuring-bind (pattern all &optional prefix suffix) + (destructuring-bind (pattern all &optional prefix _suffix) (completion-pcm--find-all-completions string table pred point) (when all (nconc (completion-pcm--hilit-commonality pattern all) @@ -2246,14 +2246,14 @@ filter out additional entries (because TABLE migth not obey PRED)." (list all pattern prefix suffix (car bounds)))) (defun completion-substring-try-completion (string table pred point) - (destructuring-bind (all pattern prefix suffix carbounds) + (destructuring-bind (all pattern prefix suffix _carbounds) (completion-substring--all-completions string table pred point) (if minibuffer-completing-file-name (setq all (completion-pcm--filename-try-filter all))) (completion-pcm--merge-try pattern all prefix suffix))) (defun completion-substring-all-completions (string table pred point) - (destructuring-bind (all pattern prefix suffix carbounds) + (destructuring-bind (all pattern prefix _suffix _carbounds) (completion-substring--all-completions string table pred point) (when all (nconc (completion-pcm--hilit-commonality pattern all) @@ -2290,12 +2290,12 @@ filter out additional entries (because TABLE migth not obey PRED)." (concat (substring str 0 (car bounds)) (mapconcat 'string (substring str (car bounds)) sep)))))))) -(defun completion-initials-all-completions (string table pred point) +(defun completion-initials-all-completions (string table pred _point) (let ((newstr (completion-initials-expand string table pred))) (when newstr (completion-pcm-all-completions newstr table pred (length newstr))))) -(defun completion-initials-try-completion (string table pred point) +(defun completion-initials-try-completion (string table pred _point) (let ((newstr (completion-initials-expand string table pred))) (when newstr (completion-pcm-try-completion newstr table pred (length newstr))))) diff --git a/lisp/mpc.el b/lisp/mpc.el index 548fd17d038..10e8c9d7688 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -357,14 +357,14 @@ which will be concatenated with proper quoting before passing them to MPD." (mapconcat 'mpc--proc-quote-string cmd " ")) "\n"))) (if callback - (let ((buf (current-buffer))) + ;; (let ((buf (current-buffer))) (process-put proc 'callback callback ;; (lambda () ;; (funcall callback ;; (prog1 (current-buffer) - ;; (set-buffer buf)))) - )) + ;; (set-buffer buf))))) + ) ;; If `callback' is nil, we're executing synchronously. (process-put proc 'callback 'ignore) ;; This returns the process's buffer. @@ -600,7 +600,7 @@ The songs are returned as alists." (cond ((eq tag 'Playlist) ;; Special case for pseudo-tag playlist. - (let ((l (condition-case err + (let ((l (condition-case nil (mpc-proc-buf-to-alists (mpc-proc-cmd (list "listplaylistinfo" value))) (mpc-proc-error @@ -633,7 +633,7 @@ The songs are returned as alists." (mpc-union (mpc-cmd-find tag1 value) (mpc-cmd-find tag2 value)))) (t - (condition-case err + (condition-case nil (mpc-proc-buf-to-alists (mpc-proc-cmd (list "find" (symbol-name tag) value))) (mpc-proc-error @@ -935,7 +935,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (defun mpc-tempfiles-clean () (let ((live ())) - (maphash (lambda (k v) (push v live)) mpc-tempfiles-reftable) + (maphash (lambda (_k v) (push v live)) mpc-tempfiles-reftable) (dolist (f mpc-tempfiles) (unless (member f live) (ignore-errors (delete-file f)))) (setq mpc-tempfiles live))) @@ -1159,7 +1159,7 @@ If PLAYLIST is t or nil or missing, use the main playlist." (mpc-status-mode)) (mpc-proc-buffer (mpc-proc) 'status buf)) (if (null songs-win) (pop-to-buffer buf) - (let ((win (split-window songs-win 20 t))) + (let ((_win (split-window songs-win 20 t))) (set-window-dedicated-p songs-win nil) (set-window-buffer songs-win buf) (set-window-dedicated-p songs-win 'soft))))) @@ -2385,15 +2385,13 @@ This is used so that they can be compared with `eq', which is needed for (mpc--faster-stop) (mpc-status-refresh) (mpc-proc-sync) (let* (songid ;The ID of the currently ffwd/rewinding song. - songnb ;The position of that song in the playlist. songduration ;The duration of that song. songtime ;The time of the song last time we ran. oldtime ;The timeoftheday last time we ran. prevsongid) ;The song we're in the process leaving. (let ((fun (lambda () - (let ((newsongid (cdr (assq 'songid mpc-status))) - (newsongnb (cdr (assq 'song mpc-status)))) + (let ((newsongid (cdr (assq 'songid mpc-status)))) (if (and (equal prevsongid newsongid) (not (equal prevsongid songid))) @@ -2444,8 +2442,7 @@ This is used so that they can be compared with `eq', which is needed for (mpc-proc-cmd (list "seekid" songid songtime) 'mpc-status-refresh) - (mpc-proc-error (mpc-status-refresh))))))) - (setq songnb newsongnb))))) + (mpc-proc-error (mpc-status-refresh))))))))))) (setq mpc--faster-toggle-forward (> step 0)) (funcall fun) ;Initialize values. (setq mpc--faster-toggle-timer diff --git a/lisp/server.el b/lisp/server.el index 79204b3cb8e..019a16a43d7 100644 --- a/lisp/server.el +++ b/lisp/server.el @@ -418,10 +418,11 @@ If CLIENT is non-nil, add a description of it to the logged message." (server-delete-client proc 'noframe)))) ; Let delete-frame delete the frame later. (defun server-handle-suspend-tty (terminal) - "Notify the emacsclient process to suspend itself when its tty device is suspended." + "Notify the client process that its tty device is suspended." (dolist (proc (server-clients-with 'terminal terminal)) - (server-log (format "server-handle-suspend-tty, terminal %s" terminal) proc) - (condition-case err + (server-log (format "server-handle-suspend-tty, terminal %s" terminal) + proc) + (condition-case nil (server-send-string proc "-suspend \n") (file-error ;The pipe/socket was closed. (ignore-errors (server-delete-client proc)))))) @@ -1207,7 +1208,10 @@ so don't mark these buffers specially, just visit them normally." (process-put proc 'buffers (nconc (process-get proc 'buffers) client-record))) client-record)) - + +(defvar server-kill-buffer-running nil + "Non-nil while `server-kill-buffer' or `server-buffer-done' is running.") + (defun server-buffer-done (buffer &optional for-killing) "Mark BUFFER as \"done\" for its client(s). This buries the buffer, then returns a list of the form (NEXT-BUFFER KILLED). @@ -1329,9 +1333,6 @@ specifically for the clients and did not exist before their request for it." (setq live-client t)))) (yes-or-no-p "This Emacs session has clients; exit anyway? "))) -(defvar server-kill-buffer-running nil - "Non-nil while `server-kill-buffer' or `server-buffer-done' is running.") - (defun server-kill-buffer () "Remove the current buffer from its clients' buffer list. Designed to be added to `kill-buffer-hook'." diff --git a/src/ChangeLog b/src/ChangeLog index e7902b8c083..c638e1fa4b5 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-03-01 Stefan Monnier + + * callint.c (quotify_arg): Simplify the logic. + (Fcall_interactively): Use lexical binding when evaluating the + interactive spec of a lexically bound function. + 2011-02-25 Stefan Monnier * eval.c (Qcurry): Remove. diff --git a/src/callint.c b/src/callint.c index 253f2b9dd09..a0efc4bbfe4 100644 --- a/src/callint.c +++ b/src/callint.c @@ -121,8 +121,9 @@ usage: (interactive &optional ARGS) */) Lisp_Object quotify_arg (register Lisp_Object exp) { - if (!INTEGERP (exp) && !STRINGP (exp) - && !NILP (exp) && !EQ (exp, Qt)) + if (CONSP (exp) + || (SYMBOLP (exp) + && !NILP (exp) && !EQ (exp, Qt))) return Fcons (Qquote, Fcons (exp, Qnil)); return exp; @@ -169,6 +170,9 @@ check_mark (int for_region) static void fix_command (Lisp_Object input, Lisp_Object values) { + /* FIXME: Instead of this ugly hack, we should provide a way for an + interactive spec to return an expression that will re-build the args + without user intervention. */ if (CONSP (input)) { Lisp_Object car; @@ -331,11 +335,14 @@ invoke it. If KEYS is omitted or nil, the return value of else { Lisp_Object input; + Lisp_Object funval = Findirect_function (function, Qt); i = num_input_events; input = specs; /* Compute the arg values using the user's expression. */ GCPRO2 (input, filter_specs); - specs = Feval (specs, Qnil); /* FIXME: lexbind */ + specs = Feval (specs, + CONSP (funval) && EQ (Qclosure, XCAR (funval)) + ? Qt : Qnil); UNGCPRO; if (i != num_input_events || !NILP (record_flag)) { From e2abe5a13dffb08d6371b6a611bc39c3a9ac2bc6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 5 Mar 2011 23:48:17 -0500 Subject: [PATCH 25/45] Fix pcase memoizing; change lexbound byte-code marker. * src/bytecode.c (exec_byte_code): Remove old lexical binding slot handling and replace it with the a integer args-desc handling. * eval.c (funcall_lambda): Adjust arglist test accordingly. * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-signature): Handle integer arglist descriptor. (byte-compile-make-args-desc): Make integer arglist descriptor. (byte-compile-lambda): Use integer arglist descriptor to mark lexical byte-coded functions instead of an extra slot. * lisp/help-fns.el (help-add-fundoc-usage): Don't add a dummy doc. (help-split-fundoc): Return a nil doc if there was no actual doc. (help-function-arglist): Generate an arglist from an integer arg-desc. * lisp/emacs-lisp/pcase.el (pcase--memoize): Rename from pcase-memoize; Make only the key weak. (pcase): Change the key used in the memoization table, so it does not always get GC'd away. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Slight change to the pcase pattern to generate slightly better code. --- lisp/ChangeLog | 17 ++++++++ lisp/emacs-lisp/byte-opt.el | 3 +- lisp/emacs-lisp/bytecomp.el | 87 +++++++++++++++++++++++++------------ lisp/emacs-lisp/cconv.el | 11 +++-- lisp/emacs-lisp/macroexp.el | 9 ++-- lisp/emacs-lisp/pcase.el | 23 +++++++--- lisp/help-fns.el | 26 +++++++++-- src/ChangeLog | 6 +++ src/alloc.c | 13 +++++- src/bytecode.c | 71 +++++++++++++++++------------- 10 files changed, 188 insertions(+), 78 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 10f57c2b96a..70604238117 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,20 @@ +2011-03-06 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-arglist-signature): + Handle integer arglist descriptor. + (byte-compile-make-args-desc): Make integer arglist descriptor. + (byte-compile-lambda): Use integer arglist descriptor to mark lexical + byte-coded functions instead of an extra slot. + * help-fns.el (help-add-fundoc-usage): Don't add a dummy doc. + (help-split-fundoc): Return a nil doc if there was no actual doc. + (help-function-arglist): Generate an arglist from an integer arg-desc. + * emacs-lisp/pcase.el (pcase--memoize): Rename from pcase-memoize; + Make only the key weak. + (pcase): Change the key used in the memoization table, so it does not + always get GC'd away. + * emacs-lisp/macroexp.el (macroexpand-all-1): Slight change to the + pcase pattern to generate slightly better code. + 2011-03-01 Stefan Monnier * emacs-lisp/cconv.el (cconv-liftwhen): Increase threshold. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index d86cb729081..6d6eb68535e 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -2009,8 +2009,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setq lap0 (car rest) lap1 (nth 1 rest)) (if (memq (car lap0) byte-constref-ops) - (if (or (eq (car lap0) 'byte-constant) - (eq (car lap0) 'byte-constant2)) + (if (memq (car lap0) '(byte-constant byte-constant2)) (unless (memq (cdr lap0) byte-compile-constants) (setq byte-compile-constants (cons (cdr lap0) byte-compile-constants))) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 3575b10e1f1..297655a235a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -33,6 +33,9 @@ ;;; Code: +;; FIXME: Use lexical-binding and get rid of the atrocious "bytecomp-" +;; variable prefix. + ;; ======================================================================== ;; Entry points: ;; byte-recompile-directory, byte-compile-file, @@ -1180,22 +1183,28 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (t fn))))))) (defun byte-compile-arglist-signature (arglist) - (let ((args 0) - opts - restp) - (while arglist - (cond ((eq (car arglist) '&optional) - (or opts (setq opts 0))) - ((eq (car arglist) '&rest) - (if (cdr arglist) - (setq restp t - arglist nil))) - (t - (if opts - (setq opts (1+ opts)) + (if (integerp arglist) + ;; New style byte-code arglist. + (cons (logand arglist 127) ;Mandatory. + (if (zerop (logand arglist 128)) ;No &rest. + (lsh arglist -8))) ;Nonrest. + ;; Old style byte-code, or interpreted function. + (let ((args 0) + opts + restp) + (while arglist + (cond ((eq (car arglist) '&optional) + (or opts (setq opts 0))) + ((eq (car arglist) '&rest) + (if (cdr arglist) + (setq restp t + arglist nil))) + (t + (if opts + (setq opts (1+ opts)) (setq args (1+ args))))) - (setq arglist (cdr arglist))) - (cons args (if restp nil (if opts (+ args opts) args))))) + (setq arglist (cdr arglist))) + (cons args (if restp nil (if opts (+ args opts) args)))))) (defun byte-compile-arglist-signatures-congruent-p (old new) @@ -2645,6 +2654,26 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; Return the new lexical environment lexenv)))) +(defun byte-compile-make-args-desc (arglist) + (let ((mandatory 0) + nonrest (rest 0)) + (while (and arglist (not (memq (car arglist) '(&optional &rest)))) + (setq mandatory (1+ mandatory)) + (setq arglist (cdr arglist))) + (setq nonrest mandatory) + (when (eq (car arglist) '&optional) + (setq arglist (cdr arglist)) + (while (and arglist (not (eq (car arglist) '&rest))) + (setq nonrest (1+ nonrest)) + (setq arglist (cdr arglist)))) + (when arglist + (setq rest 1)) + (if (> mandatory 127) + (byte-compile-report-error "Too many (>127) mandatory arguments") + (logior mandatory + (lsh nonrest 8) + (lsh rest 7))))) + ;; Byte-compile a lambda-expression and return a valid function. ;; The value is usually a compiled function but may be the original ;; lambda-expression. @@ -2716,18 +2745,22 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; 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 - 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 lexical-binding + (byte-compile-make-args-desc bytecomp-arglist) + bytecomp-arglist) + (append + ;; byte-string, constants-vector, stack depth + (cdr compiled) + ;; optionally, the doc string. + (cond (lexical-binding + (require 'help-fns) + (list (help-add-fundoc-usage + bytecomp-doc bytecomp-arglist))) + ((or bytecomp-doc bytecomp-int) + (list bytecomp-doc))) + ;; optionally, the interactive spec. + (if bytecomp-int + (list (nth 1 bytecomp-int))))) (setq compiled (nconc (if bytecomp-int (list bytecomp-int)) (cond ((eq (car-safe compiled) 'progn) (cdr compiled)) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 7855193fa3f..5501c13ee4f 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -66,22 +66,21 @@ ;;; Code: ;; TODO: +;; - byte-optimize-form should be applied before cconv. +;; - maybe unify byte-optimize and compiler-macros. ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. -;; - Change new byte-code representation, so it directly gives the -;; number of mandatory and optional arguments as well as whether or -;; not there's a &rest arg. ;; - clean up cconv-closure-convert-rec, especially the `let' binding part. ;; - new byte codes for unwind-protect, catch, and condition-case so that ;; closures aren't needed at all. ;; - a reference to a var that is known statically to always hold a constant ;; should be turned into a byte-constant rather than a byte-stack-ref. -;; Hmm... right, that's called constant propagation and could be done here -;; But when that constant is a function, we have to be careful to make sure +;; Hmm... right, that's called constant propagation and could be done here, +;; but when that constant is a function, we have to be careful to make sure ;; the bytecomp only compiles it once. ;; - Since we know here when a variable is not mutated, we could pass that ;; info to the byte-compiler, e.g. by using a new `immutable-let'. -;; - add tail-calls to bytecode.c and the bytecompiler. +;; - add tail-calls to bytecode.c and the byte compiler. ;; (defmacro dlet (binders &rest body) ;; ;; Works in both lexical and non-lexical mode. diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 4377797cba8..168a430577d 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -176,10 +176,11 @@ Assumes the caller has bound `macroexpand-all-environment'." (macroexpand-all-forms args))))) ;; Macro expand compiler macros. ;; FIXME: Don't depend on CL. - (`(,(and (pred symbolp) fun - (guard (and (eq (get fun 'byte-compile) - 'cl-byte-compile-compiler-macro) - (functionp 'compiler-macroexpand)))) + (`(,(pred (lambda (fun) + (and (symbolp fun) + (eq (get fun 'byte-compile) + 'cl-byte-compile-compiler-macro) + (functionp 'compiler-macroexpand)))) . ,_) (let ((newform (compiler-macroexpand form))) (if (eq form newform) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index 89bbff980c4..2300ebf721a 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -42,7 +42,7 @@ ;; is in a loop, the repeated macro-expansion becomes terribly costly, so we ;; memoize previous macro expansions to try and avoid recomputing them ;; over and over again. -(defconst pcase-memoize (make-hash-table :weakness t :test 'equal)) +(defconst pcase--memoize (make-hash-table :weakness 'key :test 'eq)) (defconst pcase--dontcare-upats '(t _ dontcare)) @@ -78,10 +78,21 @@ E.g. you can match pairs where the cdr is larger than the car with a pattern like `(,a . ,(pred (< a))) or, with more checks: `(,(and a (pred numberp)) . ,(and (pred numberp) (pred (< a))))" (declare (indent 1) (debug case)) ;FIXME: edebug `guard' and vars. - (or (gethash (cons exp cases) pcase-memoize) - (puthash (cons exp cases) - (pcase--expand exp cases) - pcase-memoize))) + ;; We want to use a weak hash table as a cache, but the key will unavoidably + ;; be based on `exp' and `cases', yet `cases' is a fresh new list each time + ;; we're called so it'll be immediately GC'd. So we use (car cases) as key + ;; which does come straight from the source code and should hence not be GC'd + ;; so easily. + (let ((data (gethash (car cases) pcase--memoize))) + ;; data = (EXP CASES . EXPANSION) + (if (and (equal exp (car data)) (equal cases (cadr data))) + ;; We have the right expansion. + (cddr data) + (when data + (message "pcase-memoize: equal first branch, yet different")) + (let ((expansion (pcase--expand exp cases))) + (puthash (car cases) (cons exp (cons cases expansion)) pcase--memoize) + expansion)))) ;;;###autoload (defmacro pcase-let* (bindings &rest body) @@ -135,6 +146,8 @@ of the form (UPAT EXP)." (and (symbolp upat) (not (memq upat pcase--dontcare-upats)))) (defun pcase--expand (exp cases) + ;; (message "pid=%S (pcase--expand %S ...hash=%S)" + ;; (emacs-pid) exp (sxhash cases)) (let* ((defs (if (symbolp exp) '() (let ((sym (make-symbol "x"))) (prog1 `((,sym ,exp)) (setq exp sym))))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 87fb6a02bd3..58df45bc33c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -76,15 +76,18 @@ DEF is the function whose usage we're looking for in DOCSTRING." ;; Replace `fn' with the actual function name. (if (consp def) "anonymous" def) (match-string 1 docstring)) - (substring docstring 0 (match-beginning 0))))) + (unless (zerop (match-beginning 0)) + (substring docstring 0 (match-beginning 0)))))) +;; FIXME: Move to subr.el? (defun help-add-fundoc-usage (docstring arglist) "Add the usage info to DOCSTRING. If DOCSTRING already has a usage info, then just return it unchanged. The usage info is built from ARGLIST. DOCSTRING can be nil. ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." - (unless (stringp docstring) (setq docstring "Not documented")) - (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring) (eq arglist t)) + (unless (stringp docstring) (setq docstring "")) + (if (or (string-match "\n\n(fn\\(\\( .*\\)?)\\)\\'" docstring) + (eq arglist t)) docstring (concat docstring (if (string-match "\n?\n\\'" docstring) @@ -95,6 +98,7 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (concat "(fn" (match-string 1 arglist) ")") (format "%S" (help-make-usage 'fn arglist)))))) +;; FIXME: Move to subr.el? (defun help-function-arglist (def) ;; Handle symbols aliased to other symbols. (if (and (symbolp def) (fboundp def)) (setq def (indirect-function def))) @@ -103,12 +107,28 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." ;; and do the same for interpreted closures (if (eq (car-safe def) 'closure) (setq def (cddr def))) (cond + ((and (byte-code-function-p def) (integerp (aref def 0))) + (let* ((args-desc (aref def 0)) + (max (lsh args-desc -8)) + (min (logand args-desc 127)) + (rest (logand args-desc 128)) + (arglist ())) + (dotimes (i min) + (push (intern (concat "arg" (number-to-string (1+ i)))) arglist)) + (when (> max min) + (push '&optional arglist) + (dotimes (i (- max min)) + (push (intern (concat "arg" (number-to-string (+ 1 i min)))) + arglist))) + (unless (zerop rest) (push '&rest arglist) (push 'rest arglist)) + (nreverse arglist))) ((byte-code-function-p def) (aref def 0)) ((eq (car-safe def) 'lambda) (nth 1 def)) ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap))) "[Arg list not available until function definition is loaded.]") (t t))) +;; FIXME: Move to subr.el? (defun help-make-usage (function arglist) (cons (if (symbolp function) function 'anonymous) (mapcar (lambda (arg) diff --git a/src/ChangeLog b/src/ChangeLog index c638e1fa4b5..e8b3c57fbd0 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-03-06 Stefan Monnier + + * bytecode.c (exec_byte_code): Remove old lexical binding slot handling + and replace it with the a integer args-desc handling. + * eval.c (funcall_lambda): Adjust arglist test accordingly. + 2011-03-01 Stefan Monnier * callint.c (quotify_arg): Simplify the logic. diff --git a/src/alloc.c b/src/alloc.c index 0b7db7ec627..c7fd8747f74 100644 --- a/src/alloc.c +++ b/src/alloc.c @@ -2945,10 +2945,19 @@ usage: (vector &rest OBJECTS) */) 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, -stack size, (optional) doc string, and (optional) interactive spec. +The arguments should be the ARGLIST, bytecode-string BYTE-CODE, constant +vector CONSTANTS, maximum stack size DEPTH, (optional) DOCSTRING, +and (optional) INTERACTIVE-SPEC. The first four arguments are required; at most six have any significance. +The ARGLIST can be either like the one of `lambda', in which case the arguments +will be dynamically bound before executing the byte code, or it can be an +integer of the form NNNNNNNRMMMMMMM where the 7bit MMMMMMM specifies the +minimum number of arguments, the 7-bit NNNNNNN specifies the maximum number +of arguments (ignoring &rest) and the R bit specifies whether there is a &rest +argument to catch the left-over arguments. If such an integer is used, the +arguments will not be dynamically bound but will be instead pushed on the +stack before executing the byte-code. usage: (make-byte-code ARGLIST BYTE-CODE CONSTANTS DEPTH &optional DOCSTRING INTERACTIVE-SPEC &rest ELEMENTS) */) (register int nargs, Lisp_Object *args) { diff --git a/src/bytecode.c b/src/bytecode.c index 9693a5a9196..dbab02886e2 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -502,37 +502,50 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, stacke = stack.bottom - 1 + XFASTINT (maxdepth); #endif - if (! NILP (args_template)) + if (INTEGERP (args_template)) + { + int at = XINT (args_template); + int rest = at & 128; + int mandatory = at & 127; + int nonrest = at >> 8; + eassert (mandatory <= nonrest); + if (nargs <= nonrest) + { + int i; + for (i = 0 ; i < nargs; i++, args++) + PUSH (*args); + if (nargs < mandatory) + /* Too few arguments. */ + Fsignal (Qwrong_number_of_arguments, + Fcons (Fcons (make_number (mandatory), + rest ? Qand_rest : make_number (nonrest)), + Fcons (make_number (nargs), Qnil))); + else + { + for (; i < nonrest; i++) + PUSH (Qnil); + if (rest) + PUSH (Qnil); + } + } + else if (rest) + { + int i; + for (i = 0 ; i < nonrest; i++, args++) + PUSH (*args); + PUSH (Flist (nargs - nonrest, args)); + } + else + /* Too many arguments. */ + Fsignal (Qwrong_number_of_arguments, + Fcons (Fcons (make_number (mandatory), + make_number (nonrest)), + Fcons (make_number (nargs), Qnil))); + } + else 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 (pushed < nargs - ? Flist (nargs - pushed, args) - : Qnil); - 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))); + error ("Unknown args template!"); } while (1) From 798cb64441228d473f7bdd213183c70fb582595c Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 6 Mar 2011 00:07:48 -0500 Subject: [PATCH 26/45] Missing file in last commit. * src/eval.c (funcall_lambda): Adjust arglist test accordingly. --- src/eval.c | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/src/eval.c b/src/eval.c index 869d70e3d7f..1f6a5e4a1c6 100644 --- a/src/eval.c +++ b/src/eval.c @@ -3136,8 +3136,8 @@ funcall_lambda (Lisp_Object fun, int nargs, } else if (COMPILEDP (fun)) { - if ((ASIZE (fun) & PSEUDOVECTOR_SIZE_MASK) > COMPILED_PUSH_ARGS - && ! NILP (XVECTOR (fun)->contents[COMPILED_PUSH_ARGS])) + syms_left = AREF (fun, COMPILED_ARGLIST); + if (INTEGERP (syms_left)) /* 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. @@ -3154,10 +3154,9 @@ funcall_lambda (Lisp_Object fun, int nargs, return exec_byte_code (AREF (fun, COMPILED_BYTECODE), AREF (fun, COMPILED_CONSTANTS), AREF (fun, COMPILED_STACK_DEPTH), - AREF (fun, COMPILED_ARGLIST), + syms_left, nargs, arg_vector); } - syms_left = AREF (fun, COMPILED_ARGLIST); lexenv = Qnil; } else From 6c075cd7c07d8f7f2ae52ab4369e709d7664043e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 9 Mar 2011 22:48:44 -0500 Subject: [PATCH 27/45] Rewrite the cconv conversion algorithm, for clarity. * lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): Adjust check for new byte-code representation. * lisp/emacs-lisp/cconv.el (cconv--convert-function): Rename from cconv-closure-convert-function. (cconv-convert): Rename from cconv-closure-convert-rec. (cconv--analyse-use): Rename from cconv-analyse-use. (cconv--analyse-function): Rename from cconv-analyse-function. (cconv--analyse-use): Change some patterns to silence compiler. (cconv-convert, cconv--convert-function): Rewrite. * test/automated/lexbind-tests.el: New file. --- doc/lispref/ChangeLog | 68 ++-- lisp/ChangeLog | 13 + lisp/emacs-lisp/byte-opt.el | 3 +- lisp/emacs-lisp/cconv.el | 634 ++++++++++++-------------------- test/ChangeLog | 4 + test/automated/lexbind-tests.el | 75 ++++ 6 files changed, 367 insertions(+), 430 deletions(-) create mode 100644 test/automated/lexbind-tests.el diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index 2aecc5a6b4b..ab993fe35a2 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,34 +1,34 @@ -2011-03-01 Stefan Monnier - - * variables.texi (Scope): Mention the availability of lexical scoping. - (Lexical Binding): New node. - * eval.texi (Eval): Add `eval's new `lexical' arg. - -2011-02-25 Stefan Monnier - - * vol2.texi (Top): - * vol1.texi (Top): - * objects.texi (Programming Types, Funvec Type, Type Predicates): - * functions.texi (Functions, What Is a Function, Function Currying): - * elisp.texi (Top): Remove mentions of funvec and curry. - -;; Local Variables: -;; coding: utf-8 -;; End: - - Copyright (C) 2011 Free Software Foundation, Inc. - - 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 3 of the License, 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. If not, see . +2011-03-01 Stefan Monnier + + * variables.texi (Scope): Mention the availability of lexical scoping. + (Lexical Binding): New node. + * eval.texi (Eval): Add `eval's new `lexical' arg. + +2011-02-25 Stefan Monnier + + * vol2.texi (Top): + * vol1.texi (Top): + * objects.texi (Programming Types, Funvec Type, Type Predicates): + * functions.texi (Functions, What Is a Function, Function Currying): + * elisp.texi (Top): Remove mentions of funvec and curry. + +;; Local Variables: +;; coding: utf-8 +;; End: + + Copyright (C) 2011 Free Software Foundation, Inc. + + 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 3 of the License, 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. If not, see . diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 70604238117..5e38629461b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,16 @@ +2011-03-10 Stefan Monnier + + * emacs-lisp/cconv.el (cconv--convert-function): Rename from + cconv-closure-convert-function. + (cconv-convert): Rename from cconv-closure-convert-rec. + (cconv--analyse-use): Rename from cconv-analyse-use. + (cconv--analyse-function): Rename from cconv-analyse-function. + (cconv--analyse-use): Change some patterns to silence compiler. + (cconv-convert, cconv--convert-function): Rewrite. + + * emacs-lisp/byte-opt.el (byte-compile-inline-expand): Adjust check for + new byte-code representation. + 2011-03-06 Stefan Monnier * emacs-lisp/bytecomp.el (byte-compile-arglist-signature): diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 6d6eb68535e..a49218fe02d 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -287,8 +287,7 @@ ;; old-style-byte-codes, but not mixed cases (not sure ;; about new-style into new-style). (not lexical-binding) - (not (and (>= (length fn) 7) - (aref fn 6)))) ;6 = COMPILED_PUSH_ARGS + (not (integerp (aref fn 0)))) ;New lexical byte-code. ;; (message "Inlining %S byte-code" name) (fetch-bytecode fn) (let ((string (aref fn 1))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 5501c13ee4f..741bc7ce74f 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -70,7 +70,6 @@ ;; - maybe unify byte-optimize and compiler-macros. ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. -;; - clean up cconv-closure-convert-rec, especially the `let' binding part. ;; - new byte codes for unwind-protect, catch, and condition-case so that ;; closures aren't needed at all. ;; - a reference to a var that is known statically to always hold a constant @@ -81,6 +80,8 @@ ;; - Since we know here when a variable is not mutated, we could pass that ;; info to the byte-compiler, e.g. by using a new `immutable-let'. ;; - add tail-calls to bytecode.c and the byte compiler. +;; - call known non-escaping functions with gotos rather than `call'. +;; - optimize mapcar to a while loop. ;; (defmacro dlet (binders &rest body) ;; ;; Works in both lexical and non-lexical mode. @@ -142,13 +143,7 @@ Returns a form where all lambdas don't have any free variables." ;; Analyse form - fill these variables with new information. (cconv-analyse-form form '()) (setq cconv-freevars-alist (nreverse cconv-freevars-alist)) - (cconv-closure-convert-rec - form ; the tree - '() ; - '() ; fvrs initially empty - '() ; envs initially empty - '() - ))) + (cconv-convert form nil nil))) ; Env initially empty. (defconst cconv--dummy-var (make-symbol "ignored")) @@ -189,71 +184,79 @@ Returns a form where all lambdas don't have any free variables." (unless (memq (car b) s) (push b res))) (nreverse res))) -(defun cconv-closure-convert-function (fvrs vars emvrs envs lmenvs body-forms - parentform) - (assert (equal body-forms (caar cconv-freevars-alist))) - (let* ((fvrs-new (cconv--set-diff fvrs vars)) ; Remove vars from fvrs. - (fv (cdr (pop cconv-freevars-alist))) - (body-forms-new '()) +(defun cconv--convert-function (args body env parentform) + (assert (equal body (caar cconv-freevars-alist))) + (let* ((fvs (cdr (pop cconv-freevars-alist))) + (body-new '()) (letbind '()) - (envector nil)) - (when fv - ;; Here we form our environment vector. + (envector ()) + (i 0) + (new-env ())) + ;; Build the "formal and actual envs" for the closure-converted function. + (dolist (fv fvs) + (let ((exp (or (cdr (assq fv env)) fv))) + (pcase exp + ;; If `fv' is a variable that's wrapped in a cons-cell, + ;; we want to put the cons-cell itself in the closure, + ;; rather than just a copy of its current content. + (`(car ,iexp . ,_) + (push iexp envector) + (push `(,fv . (car (internal-get-closed-var ,i))) new-env)) + (_ + (push exp envector) + (push `(,fv . (internal-get-closed-var ,i)) new-env)))) + (setq i (1+ i))) + (setq envector (nreverse envector)) + (setq new-env (nreverse new-env)) - (dolist (elm fv) - (push - (cconv-closure-convert-rec - ;; Remove `elm' from `emvrs' for this call because in case - ;; `elm' is a variable that's wrapped in a cons-cell, we - ;; want to put the cons-cell itself in the closure, rather - ;; than just a copy of its current content. - elm (remq elm emvrs) fvrs envs lmenvs) - envector)) ; Process vars for closure vector. - (setq envector (reverse envector)) - (setq envs fv) - (setq fvrs-new fv)) ; Update substitution list. + (dolist (arg args) + (if (not (member (cons (list arg) parentform) cconv-captured+mutated)) + (if (assq arg new-env) (push `(,arg) new-env)) + (push `(,arg . (car ,arg)) new-env) + (push `(,arg (list ,arg)) letbind))) + + (setq body-new (mapcar (lambda (form) + (cconv-convert form new-env nil)) + body)) - (setq emvrs (cconv--set-diff emvrs vars)) - (setq lmenvs (cconv--map-diff-set lmenvs vars)) - - ;; The difference between envs and fvrs is explained - ;; in comment in the beginning of the function. - (dolist (var vars) - (when (member (cons (list var) parentform) cconv-captured+mutated) - (push var emvrs) - (push `(,var (list ,var)) letbind))) - (dolist (elm body-forms) ; convert function body - (push (cconv-closure-convert-rec - elm emvrs fvrs-new envs lmenvs) - body-forms-new)) - - (setq body-forms-new - (if letbind `((let ,letbind . ,(reverse body-forms-new))) - (reverse body-forms-new))) + (when letbind + (let ((special-forms '())) + ;; Keep special forms at the beginning of the body. + (while (or (stringp (car body-new)) ;docstring. + (memq (car-safe (car body-new)) '(interactive declare))) + (push (pop body-new) special-forms)) + (setq body-new + `(,@(nreverse special-forms) (let ,letbind . ,body-new))))) (cond - ;if no freevars - do nothing - ((null envector) - `(function (lambda ,vars . ,body-forms-new))) - ; 1 free variable - do not build vector + ((null envector) ;if no freevars - do nothing + `(function (lambda ,args . ,body-new))) (t `(internal-make-closure - ,vars ,envector . ,body-forms-new))))) + ,args ,envector . ,body-new))))) -(defun cconv-closure-convert-rec (form emvrs fvrs envs lmenvs) +(defun cconv-convert (form env extend) ;; This function actually rewrites the tree. - "Eliminates all free variables of all lambdas in given forms. -Arguments: -- FORM is a piece of Elisp code after macroexpansion. -- LMENVS is a list of environments used for lambda-lifting. Initially empty. -- EMVRS is a list that contains mutated variables that are visible -within current environment. -- ENVS is an environment(list of free variables) of current closure. -Initially empty. -- FVRS is a list of variables to substitute in each context. -Initially empty. - -Returns a form where all lambdas don't have any free variables." + "Return FORM with all its lambdas changed so they are closed. +ENV is a lexical environment mapping variables to the expression +used to get its value. This is used for variables that are copied into +closures, moved into cons cells, ... +ENV is a list where each entry takes the shape either: + (VAR . (car EXP)): VAR has been moved into the car of a cons-cell, and EXP + is an expression that evaluates to this cons-cell. + (VAR . (internal-get-closed-var N)): VAR has been copied into the closure + environment's Nth slot. + (VAR . (apply-partially F ARG1 ARG2 ..)): VAR has been λ-lifted and takes + additional arguments ARGs. +EXTEND is a list of variables which might need to be accessed even from places +where they are shadowed, because some part of ENV causes them to be used at +places where they originally did not directly appear." + (assert (not (delq nil (mapcar (lambda (mapping) + (if (eq (cadr mapping) 'apply-partially) + (cconv--set-diff (cdr (cddr mapping)) + extend))) + env)))) + ;; What's the difference between fvrs and envs? ;; Suppose that we have the code ;; (lambda (..) fvr (let ((fvr 1)) (+ fvr 1))) @@ -266,18 +269,12 @@ Returns a form where all lambdas don't have any free variables." ;; so we never touch it(unless we enter to the other closure). ;;(if (listp form) (print (car form)) form) (pcase form - (`(,(and letsym (or `let* `let)) ,binders . ,body-forms) + (`(,(and letsym (or `let* `let)) ,binders . ,body) ; let and let* special forms - (let ((body-forms-new '()) - (binders-new '()) - ;; next for variables needed for delayed push - ;; because we should process - ;; before we change any arguments - (lmenvs-new '()) ;needed only in case of let - (emvrs-new '()) ;needed only in case of let - (emvr-push) ;needed only in case of let* - (lmenv-push)) ;needed only in case of let* + (let ((binders-new '()) + (new-env env) + (new-extend extend)) (dolist (binder binders) (let* ((value nil) @@ -288,372 +285,223 @@ Returns a form where all lambdas don't have any free variables." (new-val (cond ;; Check if var is a candidate for lambda lifting. - ((member (cons binder form) cconv-lambda-candidates) - (assert (and (eq (car value) 'function) - (eq (car (cadr value)) 'lambda))) - (assert (equal (cddr (cadr value)) - (caar cconv-freevars-alist))) - ;; Peek at the freevars to decide whether to λ-lift. - (let* ((fv (cdr (car cconv-freevars-alist))) - (funargs (cadr (cadr value))) - (funcvars (append fv funargs)) - (funcbodies (cddadr value)) ; function bodies - (funcbodies-new '())) + ((and (member (cons binder form) cconv-lambda-candidates) + (progn + (assert (and (eq (car value) 'function) + (eq (car (cadr value)) 'lambda))) + (assert (equal (cddr (cadr value)) + (caar cconv-freevars-alist))) + ;; Peek at the freevars to decide whether to λ-lift. + (let* ((fvs (cdr (car cconv-freevars-alist))) + (fun (cadr value)) + (funargs (cadr fun)) + (funcvars (append fvs funargs))) ; lambda lifting condition - (if (or (not fv) (< cconv-liftwhen (length funcvars))) - ; do not lift - (progn - ;; (byte-compile-log-warning - ;; (format "Not λ-lifting `%S': %d > %d" - ;; var (length funcvars) cconv-liftwhen)) - - (cconv-closure-convert-rec - value emvrs fvrs envs lmenvs)) - ; lift - (progn - ;; (byte-compile-log-warning - ;; (format "λ-lifting `%S'" var)) - (setq cconv-freevars-alist - ;; Now that we know we'll λ-lift, consume the - ;; freevar data. - (cdr cconv-freevars-alist)) - (dolist (elm2 funcbodies) - (push ; convert function bodies - (cconv-closure-convert-rec - elm2 emvrs nil envs lmenvs) - funcbodies-new)) - (if (eq letsym 'let*) - (setq lmenv-push (cons var fv)) - (push (cons var fv) lmenvs-new)) - ; push lifted function - - `(function . - ((lambda ,funcvars . - ,(reverse funcbodies-new)))))))) + (and fvs (>= cconv-liftwhen (length funcvars)))))) + ; Lift. + (let* ((fvs (cdr (pop cconv-freevars-alist))) + (fun (cadr value)) + (funargs (cadr fun)) + (funcvars (append fvs funargs)) + (funcbody (cddr fun)) + (funcbody-env ())) + (push `(,var . (apply-partially ,var . ,fvs)) new-env) + (dolist (fv fvs) + (pushnew fv new-extend) + (if (and (eq 'car (car-safe (cdr (assq fv env)))) + (not (memq fv funargs))) + (push `(,fv . (car ,fv)) funcbody-env))) + `(function (lambda ,funcvars . + ,(mapcar (lambda (form) + (cconv-convert + form funcbody-env nil)) + funcbody))))) ;; Check if it needs to be turned into a "ref-cell". ((member (cons binder form) cconv-captured+mutated) ;; Declared variable is mutated and captured. - (prog1 - `(list ,(cconv-closure-convert-rec - value emvrs - fvrs envs lmenvs)) - (if (eq letsym 'let*) - (setq emvr-push var) - (push var emvrs-new)))) + (push `(,var . (car ,var)) new-env) + `(list ,(cconv-convert value env extend))) ;; Normal default case. (t - (cconv-closure-convert-rec - value emvrs fvrs envs lmenvs))))) + (if (assq var new-env) (push `(,var) new-env)) + (cconv-convert value env extend))))) - ;; this piece of code below letbinds free - ;; variables of a lambda lifted function - ;; if they are redefined in this let - ;; example: - ;; (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1)) - ;; Here we can not pass y as parameter because it is - ;; redefined. We add a (closed-y y) declaration. - ;; We do that even if the function is not used inside - ;; this let(*). The reason why we ignore this case is - ;; that we can't "look forward" to see if the function - ;; is called there or not. To treat well this case we - ;; need to traverse the tree one more time to collect this - ;; data, and I think that it's not worth it. + ;; The piece of code below letbinds free variables of a λ-lifted + ;; function if they are redefined in this let, example: + ;; (let* ((fun (lambda (x) (+ x y))) (y 1)) (funcall fun 1)) + ;; Here we can not pass y as parameter because it is redefined. + ;; So we add a (closed-y y) declaration. We do that even if the + ;; function is not used inside this let(*). The reason why we + ;; ignore this case is that we can't "look forward" to see if the + ;; function is called there or not. To treat this case better we'd + ;; need to traverse the tree one more time to collect this data, and + ;; I think that it's not worth it. + (when (memq var new-extend) + (let ((closedsym + (make-symbol (concat "closed-" (symbol-name var))))) + (setq new-env + (mapcar (lambda (mapping) + (if (not (eq (cadr mapping) 'apply-partially)) + mapping + (assert (eq (car mapping) (nth 2 mapping))) + (list* (car mapping) + 'apply-partially + (car mapping) + (mapcar (lambda (arg) + (if (eq var arg) + closedsym arg)) + (nthcdr 3 mapping))))) + new-env)) + (setq new-extend (remq var new-extend)) + (push closedsym new-extend) + (push `(,closedsym ,var) binders-new))) - (when (eq letsym 'let*) - (let ((closedsym '()) - (new-lmenv '()) - (old-lmenv '())) - (dolist (lmenv lmenvs) - (when (memq var (cdr lmenv)) - (setq closedsym - (make-symbol - (concat "closed-" (symbol-name var)))) - (setq new-lmenv (list (car lmenv))) - (dolist (frv (cdr lmenv)) (if (eq frv var) - (push closedsym new-lmenv) - (push frv new-lmenv))) - (setq new-lmenv (reverse new-lmenv)) - (setq old-lmenv lmenv))) - (when new-lmenv - (setq lmenvs (remq old-lmenv lmenvs)) - (push new-lmenv lmenvs) - (push `(,closedsym ,var) binders-new)))) ;; We push the element after redefined free variables are ;; processed. This is important to avoid the bug when free ;; variable and the function have the same name. (push (list var new-val) binders-new) - (when (eq letsym 'let*) ; update fvrs - (setq fvrs (remq var fvrs)) - (setq emvrs (remq var emvrs)) ; remove if redefined - (when emvr-push - (push emvr-push emvrs) - (setq emvr-push nil)) - (setq lmenvs (cconv--map-diff-elem lmenvs var)) - (when lmenv-push - (push lmenv-push lmenvs) - (setq lmenv-push nil))) - )) ; end of dolist over binders - (when (eq letsym 'let) + (when (eq letsym 'let*) + (setq env new-env) + (setq extend new-extend)) + )) ; end of dolist over binders - ;; Here we update emvrs, fvrs and lmenvs lists - (setq fvrs (cconv--set-diff-map fvrs binders-new)) - (setq emvrs (cconv--set-diff-map emvrs binders-new)) - (setq emvrs (append emvrs emvrs-new)) - (setq lmenvs (cconv--set-diff-map lmenvs binders-new)) - (setq lmenvs (append lmenvs lmenvs-new)) - - ;; Here we do the same letbinding as for let* above - ;; to avoid situation when a free variable of a lambda lifted - ;; function got redefined. - - (let ((new-lmenv) - (var nil) - (closedsym nil) - (letbinds '())) - (dolist (binder binders) - (setq var (if (consp binder) (car binder) binder)) - - (let ((lmenvs-1 lmenvs)) ; just to avoid manipulating - (dolist (lmenv lmenvs-1) ; the counter inside the loop - (when (memq var (cdr lmenv)) - (setq closedsym (make-symbol - (concat "closed-" - (symbol-name var)))) - - (setq new-lmenv (list (car lmenv))) - (dolist (frv (cdr lmenv)) - (push (if (eq frv var) closedsym frv) - new-lmenv)) - (setq new-lmenv (reverse new-lmenv)) - (setq lmenvs (remq lmenv lmenvs)) - (push new-lmenv lmenvs) - (push `(,closedsym ,var) letbinds) - )))) - (setq binders-new (append binders-new letbinds)))) - - (dolist (elm body-forms) ; convert body forms - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs) - body-forms-new)) - `(,letsym ,(reverse binders-new) . ,(reverse body-forms-new)))) + `(,letsym ,(nreverse binders-new) + . ,(mapcar (lambda (form) + (cconv-convert + form new-env new-extend)) + body)))) ;end of let let* forms ; first element is lambda expression - (`(,(and `(lambda . ,_) fun) . ,other-body-forms) - - (let ((other-body-forms-new '())) - (dolist (elm other-body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs) - other-body-forms-new)) - `(funcall - ,(cconv-closure-convert-rec - (list 'function fun) emvrs fvrs envs lmenvs) - ,@(nreverse other-body-forms-new)))) + (`(,(and `(lambda . ,_) fun) . ,args) + ;; FIXME: it's silly to create a closure just to call it. + `(funcall + ,(cconv-convert `(function ,fun) env extend) + ,@(mapcar (lambda (form) + (cconv-convert form env extend)) + args))) (`(cond . ,cond-forms) ; cond special form - (let ((cond-forms-new '())) - (dolist (elm cond-forms) - (push (let ((elm-new '())) - (dolist (elm-2 elm) - (push - (cconv-closure-convert-rec - elm-2 emvrs fvrs envs lmenvs) - elm-new)) - (reverse elm-new)) - cond-forms-new)) - (cons 'cond - (reverse cond-forms-new)))) + `(cond . ,(mapcar (lambda (branch) + (mapcar (lambda (form) + (cconv-convert form env extend)) + branch)) + cond-forms))) - (`(quote . ,_) form) - - (`(function (lambda ,vars . ,body-forms)) ; function form - (cconv-closure-convert-function - fvrs vars emvrs envs lmenvs body-forms form)) + (`(function (lambda ,args . ,body) . ,_) + (cconv--convert-function args body env form)) (`(internal-make-closure . ,_) - (error "Internal byte-compiler error: cconv called twice")) + (byte-compile-report-error + "Internal error in compiler: cconv called twice?")) - (`(function . ,_) form) ; Same as quote. + (`(quote . ,_) form) + (`(function . ,_) form) ;defconst, defvar - (`(,(and sym (or `defconst `defvar)) ,definedsymbol . ,body-forms) - - (let ((body-forms-new '())) - (dolist (elm body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs) - body-forms-new)) - (setq body-forms-new (reverse body-forms-new)) - `(,sym ,definedsymbol . ,body-forms-new))) + (`(,(and sym (or `defconst `defvar)) ,definedsymbol . ,forms) + `(,sym ,definedsymbol + . ,(mapcar (lambda (form) (cconv-convert form env extend)) + forms))) ;defun, defmacro (`(,(and sym (or `defun `defmacro)) - ,func ,vars . ,body-forms) - - ;; The freevar data was pushed onto cconv-freevars-alist - ;; but we don't need it. - (assert (equal body-forms (caar cconv-freevars-alist))) + ,func ,args . ,body) + (assert (equal body (caar cconv-freevars-alist))) (assert (null (cdar cconv-freevars-alist))) - (setq cconv-freevars-alist (cdr cconv-freevars-alist)) - (let ((body-new '()) ; The whole body. - (body-forms-new '()) ; Body w\o docstring and interactive. - (letbind '())) - ; Find mutable arguments. - (dolist (elm vars) - (when (member (cons (list elm) form) cconv-captured+mutated) - (push elm letbind) - (push elm emvrs))) - ;Transform body-forms. - (when (stringp (car body-forms)) ; Treat docstring well. - (push (car body-forms) body-new) - (setq body-forms (cdr body-forms))) - (when (eq (car-safe (car body-forms)) 'interactive) - (push (cconv-closure-convert-rec - (car body-forms) - emvrs fvrs envs lmenvs) - body-new) - (setq body-forms (cdr body-forms))) - - (dolist (elm body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs) - body-forms-new)) - (setq body-forms-new (reverse body-forms-new)) - - (if letbind - ; Letbind mutable arguments. - (let ((binders-new '())) - (dolist (elm letbind) (push `(,elm (list ,elm)) - binders-new)) - (push `(let ,(reverse binders-new) . - ,body-forms-new) body-new) - (setq body-new (reverse body-new))) - (setq body-new (append (reverse body-new) body-forms-new))) - - `(,sym ,func ,vars . ,body-new))) + (let ((new (cconv--convert-function args body env form))) + (pcase new + (`(function (lambda ,newargs . ,new-body)) + (assert (equal args newargs)) + `(,sym ,func ,args . ,new-body)) + (t (byte-compile-report-error + (format "Internal error in cconv of (%s %s ...)" sym func)))))) ;condition-case (`(condition-case ,var ,protected-form . ,handlers) - (let ((newform (cconv-closure-convert-rec - `(function (lambda () ,protected-form)) - emvrs fvrs envs lmenvs))) - (setq fvrs (remq var fvrs)) + (let ((newform (cconv--convert-function + () (list protected-form) env form))) `(condition-case :fun-body ,newform ,@(mapcar (lambda (handler) (list (car handler) - (cconv-closure-convert-rec - (let ((arg (or var cconv--dummy-var))) - `(function (lambda (,arg) ,@(cdr handler)))) - emvrs fvrs envs lmenvs))) + (cconv--convert-function + (list (or var cconv--dummy-var)) + (cdr handler) env form))) handlers)))) (`(,(and head (or `catch `unwind-protect)) ,form . ,body) - `(,head ,(cconv-closure-convert-rec form emvrs fvrs envs lmenvs) - :fun-body - ,(cconv-closure-convert-rec `(function (lambda () ,@body)) - emvrs fvrs envs lmenvs))) + `(,head ,(cconv-convert form env extend) + :fun-body ,(cconv--convert-function () body env form))) (`(track-mouse . ,body) `(track-mouse - :fun-body - ,(cconv-closure-convert-rec `(function (lambda () ,@body)) - emvrs fvrs envs lmenvs))) + :fun-body ,(cconv--convert-function () body env form))) (`(setq . ,forms) ; setq special form - (let (prognlist sym sym-new value) + (let ((prognlist ())) (while forms - (setq sym (car forms)) - (setq sym-new (cconv-closure-convert-rec - sym - (remq sym emvrs) fvrs envs lmenvs)) - (setq value - (cconv-closure-convert-rec - (cadr forms) emvrs fvrs envs lmenvs)) - (cond - ((memq sym emvrs) (push `(setcar ,sym-new ,value) prognlist)) - ((symbolp sym-new) (push `(setq ,sym-new ,value) prognlist)) - ;; This should never happen, but for variables which are - ;; mutated+captured+unused, we may end up trying to `setq' - ;; on a closed-over variable, so just drop the setq. - (t (push value prognlist))) - (setq forms (cddr forms))) + (let* ((sym (pop forms)) + (sym-new (or (cdr (assq sym env)) sym)) + (value (cconv-convert (pop forms) env extend))) + (push (pcase sym-new + ((pred symbolp) `(setq ,sym-new ,value)) + (`(car ,iexp) `(setcar ,iexp ,value)) + ;; This "should never happen", but for variables which are + ;; mutated+captured+unused, we may end up trying to `setq' + ;; on a closed-over variable, so just drop the setq. + (_ ;; (byte-compile-report-error + ;; (format "Internal error in cconv of (setq %s ..)" + ;; sym-new)) + value)) + prognlist))) (if (cdr prognlist) - `(progn . ,(reverse prognlist)) + `(progn . ,(nreverse prognlist)) (car prognlist)))) (`(,(and (or `funcall `apply) callsym) ,fun . ,args) - ; funcall is not a special form - ; but we treat it separately - ; for the needs of lambda lifting - (let ((fv (cdr (assq fun lmenvs)))) - (if fv - (let ((args-new '()) - (processed-fv '())) - ;; All args (free variables and actual arguments) - ;; should be processed, because they can be fvrs - ;; (free variables of another closure) - (dolist (fvr fv) - (push (cconv-closure-convert-rec - fvr (remq fvr emvrs) - fvrs envs lmenvs) - processed-fv)) - (setq processed-fv (reverse processed-fv)) - (dolist (elm args) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs) - args-new)) - (setq args-new (append processed-fv (reverse args-new))) - (setq fun (cconv-closure-convert-rec - fun emvrs fvrs envs lmenvs)) - `(,callsym ,fun . ,args-new)) - (let ((cdr-new '())) - (dolist (elm (cdr form)) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs) - cdr-new)) - `(,callsym . ,(reverse cdr-new)))))) + ;; These are not special forms but we treat them separately for the needs + ;; of lambda lifting. + (let ((mapping (cdr (assq fun env)))) + (pcase mapping + (`(apply-partially ,_ . ,(and fvs `(,_ . ,_))) + (assert (eq (cadr mapping) fun)) + `(,callsym ,fun + ,@(mapcar (lambda (fv) + (let ((exp (or (cdr (assq fv env)) fv))) + (pcase exp + (`(car ,iexp . ,_) iexp) + (_ exp)))) + fvs) + ,@(mapcar (lambda (arg) + (cconv-convert arg env extend)) + args))) + (_ `(,callsym ,@(mapcar (lambda (arg) + (cconv-convert arg env extend)) + (cons fun args))))))) (`(interactive . ,forms) - `(interactive - ,@(mapcar (lambda (form) - (cconv-closure-convert-rec form nil nil nil nil)) - forms))) + `(interactive . ,(mapcar (lambda (form) + (cconv-convert form nil nil)) + forms))) - (`(,func . ,body-forms) ; first element is function or whatever - ; function-like forms are: - ; or, and, if, progn, prog1, prog2, - ; while, until - (let ((body-forms-new '())) - (dolist (elm body-forms) - (push (cconv-closure-convert-rec - elm emvrs fvrs envs lmenvs) - body-forms-new)) - (setq body-forms-new (reverse body-forms-new)) - `(,func . ,body-forms-new))) + (`(,func . ,forms) + ;; First element is function or whatever function-like forms are: or, and, + ;; if, progn, prog1, prog2, while, until + `(,func . ,(mapcar (lambda (form) + (cconv-convert form env extend)) + forms))) - (_ - (let ((free (memq form fvrs))) - (if free ;form is a free variable - (let* ((numero (- (length fvrs) (length free))) - ;; Replace form => (aref env #) - (var `(internal-get-closed-var ,numero))) - (if (memq form emvrs) ; form => (car (aref env #)) if mutable - `(car ,var) - var)) - (if (memq form emvrs) ; if form is a mutable variable - `(car ,form) ; replace form => (car form) - form)))))) + (_ (or (cdr (assq form env)) form)))) (unless (fboundp 'byte-compile-not-lexical-var-p) ;; Only used to test the code in non-lexbind Emacs. (defalias 'byte-compile-not-lexical-var-p 'boundp)) -(defun cconv-analyse-use (vardata form varkind) +(defun cconv--analyse-use (vardata form varkind) "Analyse the use of a variable. VARDATA should be (BINDER READ MUTATED CAPTURED CALLED). VARKIND is the name of the kind of variable. @@ -663,8 +511,8 @@ FORM is the parent form that binds this var." (`(,_ nil nil nil nil) nil) (`((,(and (pred (lambda (var) (eq ?_ (aref (symbol-name var) 0)))) var) . ,_) ,_ ,_ ,_ ,_) - (byte-compile-log-warning (format "%s `%S' not left unused" varkind var))) - ((or `(,_ ,_ ,_ ,_ ,_) dontcare) nil)) + (byte-compile-log-warning + (format "%s `%S' not left unused" varkind var)))) (pcase vardata (`((,var . ,_) nil ,_ ,_ nil) ;; FIXME: This gives warnings in the wrong order, with imprecise line @@ -681,11 +529,9 @@ FORM is the parent form that binds this var." (`(,binder ,_ t t ,_) (push (cons binder form) cconv-captured+mutated)) (`(,(and binder `(,_ (function (lambda . ,_)))) nil nil nil t) - (push (cons binder form) cconv-lambda-candidates)) - (`(,_ ,_ ,_ ,_ ,_) nil) - (dontcare))) + (push (cons binder form) cconv-lambda-candidates)))) -(defun cconv-analyse-function (args body env parentform) +(defun cconv--analyse-function (args body env parentform) (let* ((newvars nil) (freevars (list body)) ;; We analyze the body within a new environment where all uses are @@ -710,7 +556,7 @@ FORM is the parent form that binds this var." (cconv-analyse-form form newenv)) ;; Summarize resulting data about arguments. (dolist (vardata newvars) - (cconv-analyse-use vardata parentform "argument")) + (cconv--analyse-use vardata parentform "argument")) ;; Transfer uses collected in `envcopy' (via `newenv') back to `env'; ;; and compute free variables. (while env @@ -763,7 +609,7 @@ and updates the data stored in ENV." (cconv-analyse-form form env)) (dolist (vardata newvars) - (cconv-analyse-use vardata form "variable")))) + (cconv--analyse-use vardata form "variable")))) ; defun special form (`(,(or `defun `defmacro) ,func ,vrs . ,body-forms) @@ -772,10 +618,10 @@ and updates the data stored in ENV." (format "Function %S will ignore its context %S" func (mapcar #'car env)) t :warning)) - (cconv-analyse-function vrs body-forms nil form)) + (cconv--analyse-function vrs body-forms nil form)) (`(function (lambda ,vrs . ,body-forms)) - (cconv-analyse-function vrs body-forms env form)) + (cconv--analyse-function vrs body-forms env form)) (`(setq . ,forms) ;; If a local variable (member of env) is modified by setq then @@ -801,19 +647,19 @@ and updates the data stored in ENV." ;; FIXME: The bytecode for condition-case forces us to wrap the ;; form and handlers in closures (for handlers, it's probably ;; unavoidable, but not for the protected form). - (cconv-analyse-function () (list protected-form) env form) + (cconv--analyse-function () (list protected-form) env form) (dolist (handler handlers) - (cconv-analyse-function (if var (list var)) (cdr handler) env form))) + (cconv--analyse-function (if var (list var)) (cdr handler) env form))) ;; FIXME: The bytecode for catch forces us to wrap the body. (`(,(or `catch `unwind-protect) ,form . ,body) (cconv-analyse-form form env) - (cconv-analyse-function () body env form)) + (cconv--analyse-function () body env form)) ;; FIXME: The bytecode for save-window-excursion and the lack of ;; bytecode for track-mouse forces us to wrap the body. (`(track-mouse . ,body) - (cconv-analyse-function () body env form)) + (cconv--analyse-function () body env form)) (`(,(or `defconst `defvar) ,var ,value . ,_) (push var byte-compile-bound-variables) diff --git a/test/ChangeLog b/test/ChangeLog index b247b88bc94..dc9b87adfac 100644 --- a/test/ChangeLog +++ b/test/ChangeLog @@ -1,3 +1,7 @@ +2011-03-10 Stefan Monnier + + * automated/lexbind-tests.el: New file. + 2011-03-05 Glenn Morris * eshell.el: Move here from lisp/eshell/esh-test.el. diff --git a/test/automated/lexbind-tests.el b/test/automated/lexbind-tests.el new file mode 100644 index 00000000000..1ff31e2422d --- /dev/null +++ b/test/automated/lexbind-tests.el @@ -0,0 +1,75 @@ +;;; lexbind-tests.el --- Testing the lexbind byte-compiler + +;; Copyright (C) 2011 Free Software Foundation, Inc. + +;; Author: Stefan Monnier +;; Keywords: + +;; This program 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 3 of the License, or +;; (at your option) any later version. + +;; This program 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 this program. If not, see . + +;;; Commentary: + +;; + +;;; Code: + +(require 'ert) + +(defconst lexbind-tests + `( + (let ((f #'car)) + (let ((f (lambda (x) (cons (funcall f x) (cdr x))))) + (funcall f '(1 . 2)))) + ) + "List of expression for test. +Each element will be executed by interpreter and with +bytecompiled code, and their results compared.") + + + +(defun lexbind-check-1 (pat) + "Return non-nil if PAT is the same whether directly evalled or compiled." + (let ((warning-minimum-log-level :emergency) + (byte-compile-warnings nil) + (v0 (condition-case nil + (eval pat t) + (error nil))) + (v1 (condition-case nil + (funcall (let ((lexical-binding t)) + (byte-compile `(lambda nil ,pat)))) + (error nil)))) + (equal v0 v1))) + +(put 'lexbind-check-1 'ert-explainer 'lexbind-explain-1) + +(defun lexbind-explain-1 (pat) + (let ((v0 (condition-case nil + (eval pat t) + (error nil))) + (v1 (condition-case nil + (funcall (let ((lexical-binding t)) + (byte-compile (list 'lambda nil pat)))) + (error nil)))) + (format "Expression `%s' gives `%s' if directly evalled, `%s' if compiled." + pat v0 v1))) + +(ert-deftest lexbind-tests () + "Test the Emacs byte compiler lexbind handling." + (dolist (pat lexbind-tests) + (should (lexbind-check-1 pat)))) + + + +(provide 'lexbind-tests) +;;; lexbind-tests.el ends here From bba752f83152f36bfc2a24b212fb5cba3aad9188 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 10 Mar 2011 09:52:33 -0500 Subject: [PATCH 28/45] * lisp/emacs-lisp/byte-opt.el: Use lexical binding. (for-effectm byte-compile-tag-number): Declare dynamic. (byte-optimize-form-code-walker, byte-optimize-form): Move dynamic binding of for-effect from function argument to let binding. (byte-decompile-bytecode-1): Move dynamic binding of bytedecomp-bytes from function argument to let binding. --- lisp/ChangeLog | 8 +++++++- lisp/emacs-lisp/byte-opt.el | 25 +++++++++++++++---------- 2 files changed, 22 insertions(+), 11 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 5e38629461b..26661bf6df7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,5 +1,12 @@ 2011-03-10 Stefan Monnier + * emacs-lisp/byte-opt.el: Use lexical binding. + (for-effectm byte-compile-tag-number): Declare dynamic. + (byte-optimize-form-code-walker, byte-optimize-form): Move dynamic + binding of for-effect from function argument to let binding. + (byte-decompile-bytecode-1): Move dynamic binding of bytedecomp-bytes + from function argument to let binding. + * emacs-lisp/cconv.el (cconv--convert-function): Rename from cconv-closure-convert-function. (cconv-convert): Rename from cconv-closure-convert-rec. @@ -7,7 +14,6 @@ (cconv--analyse-function): Rename from cconv-analyse-function. (cconv--analyse-use): Change some patterns to silence compiler. (cconv-convert, cconv--convert-function): Rewrite. - * emacs-lisp/byte-opt.el (byte-compile-inline-expand): Adjust check for new byte-code representation. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index a49218fe02d..68ec2144dae 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1,4 +1,4 @@ -;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler +;;; byte-opt.el --- the optimization passes of the emacs-lisp byte compiler -*- lexical-binding: t -*- ;; Copyright (C) 1991, 1994, 2000-2011 Free Software Foundation, Inc. @@ -378,7 +378,9 @@ ;;; implementing source-level optimizers -(defun byte-optimize-form-code-walker (form for-effect) +(defvar for-effect) + +(defun byte-optimize-form-code-walker (form for-effect-arg) ;; ;; For normal function calls, We can just mapcar the optimizer the cdr. But ;; we need to have special knowledge of the syntax of the special forms @@ -386,7 +388,8 @@ ;; the important aspect is that they are subrs that don't evaluate all of ;; their args.) ;; - (let ((fn (car-safe form)) + (let ((for-effect for-effect-arg) + (fn (car-safe form)) tmp) (cond ((not (consp form)) (if (not (and for-effect @@ -586,18 +589,19 @@ (setq list (cdr list))) constant)) -(defun byte-optimize-form (form &optional for-effect) +(defun byte-optimize-form (form &optional for-effect-arg) "The source-level pass of the optimizer." ;; ;; First, optimize all sub-forms of this one. - (setq form (byte-optimize-form-code-walker form for-effect)) + (setq form (byte-optimize-form-code-walker form for-effect-arg)) ;; ;; after optimizing all subforms, optimize this form until it doesn't ;; optimize any further. This means that some forms will be passed through ;; the optimizer many times, but that's necessary to make the for-effect ;; processing do as much as possible. ;; - (let (opt new) + (let ((for-effect for-effect-arg) + opt new) (if (and (consp form) (symbolp (car form)) (or (and for-effect @@ -1355,6 +1359,7 @@ (setq bytedecomp-ptr (1+ bytedecomp-ptr)) ;offset in next byte (aref bytedecomp-bytes bytedecomp-ptr)))) +(defvar byte-compile-tag-number) ;; This de-compiler is used for inline expansion of compiled functions, ;; and by the disassembler. @@ -1376,9 +1381,9 @@ ;; If MAKE-SPLICEABLE is nil, we are being called for the disassembler. ;; In that case, we put a pc value into the list ;; before each insn (or its label). -(defun byte-decompile-bytecode-1 (bytedecomp-bytes constvec - &optional make-spliceable) - (let ((length (length bytedecomp-bytes)) +(defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable) + (let ((bytedecomp-bytes bytes) + (length (length bytes)) (bytedecomp-ptr 0) optr tags bytedecomp-op offset lap tmp endtag) @@ -1522,7 +1527,7 @@ ;; The variable `byte-boolean-vars' is now primitive and updated ;; automatically by DEFVAR_BOOL. -(defun byte-optimize-lapcode (lap &optional for-effect) +(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 From 9ace101ce2e22c85a4298f20702e9b79ae03ad1f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 10 Mar 2011 14:40:48 -0500 Subject: [PATCH 29/45] * lisp/emacs-lisp/bytecomp.el: Use lexical-binding. (byte-recompile-directory): Remove unused var `bytecomp-dest'. (byte-recompile-file): Use derived-mode-p. (byte-compile-from-buffer): Remove arg `bytecomp-filename'. Use byte-compile-current-file instead. (byte-compile-file): Adjust call accordingly. (bytecomp-outbuffer): Move declaration before first use. (for-effect): Declare dynamic. (byte-compile-file-form-defmumble): Use byte-compile-current-file. (byte-compile-top-level, byte-compile-out-toplevel, byte-compile-form): Move dyn-binding of for-effect from function argument to let binding. (byte-compile-out-toplevel): Don't both passing for-effect to byte-optimize-lapcode. (byte-compile-top-level-body, byte-compile-body): Rename for-effect -> for-effect-arg so it's lexical. * lisp/subr.el (functionp): Remove, now that it's in src/eval.c. --- lisp/ChangeLog | 20 ++++- lisp/emacs-lisp/bytecomp.el | 157 ++++++++++++++++++------------------ lisp/subr.el | 14 ---- 3 files changed, 99 insertions(+), 92 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 26661bf6df7..fd00cf70f40 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,6 +1,24 @@ 2011-03-10 Stefan Monnier - * emacs-lisp/byte-opt.el: Use lexical binding. + * emacs-lisp/bytecomp.el: Use lexical-binding. + (byte-recompile-directory): Remove unused var `bytecomp-dest'. + (byte-recompile-file): Use derived-mode-p. + (byte-compile-from-buffer): Remove arg `bytecomp-filename'. + Use byte-compile-current-file instead. + (byte-compile-file): Adjust call accordingly. + (bytecomp-outbuffer): Move declaration before first use. + (for-effect): Declare dynamic. + (byte-compile-file-form-defmumble): Use byte-compile-current-file. + (byte-compile-top-level, byte-compile-out-toplevel, byte-compile-form): + Move dyn-binding of for-effect from function argument to let binding. + (byte-compile-out-toplevel): Don't both passing for-effect to + byte-optimize-lapcode. + (byte-compile-top-level-body, byte-compile-body): + Rename for-effect -> for-effect-arg so it's lexical. + + * subr.el (functionp): Remove, now that it's in src/eval.c. + + * emacs-lisp/byte-opt.el: Use lexical-binding. (for-effectm byte-compile-tag-number): Declare dynamic. (byte-optimize-form-code-walker, byte-optimize-form): Move dynamic binding of for-effect from function argument to let binding. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 7b785c9ace6..77dd3408219 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1,4 +1,4 @@ -;;; bytecomp.el --- compilation of Lisp code into byte code +;;; bytecomp.el --- compilation of Lisp code into byte code -*- lexical-binding: t -*- ;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2011 ;; Free Software Foundation, Inc. @@ -1063,7 +1063,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." ;; This no-op function is used as the value of warning-series ;; to tell inner calls to displaying-byte-compile-warnings ;; not to bind warning-series. -(defun byte-compile-warning-series (&rest ignore) +(defun byte-compile-warning-series (&rest _ignore) nil) ;; (compile-mode) will cause this to be loaded. @@ -1606,7 +1606,7 @@ that already has a `.elc' file." (setq bytecomp-directory (car bytecomp-directories)) (message "Checking %s..." bytecomp-directory) (let ((bytecomp-files (directory-files bytecomp-directory)) - bytecomp-source bytecomp-dest) + bytecomp-source) (dolist (bytecomp-file bytecomp-files) (setq bytecomp-source (expand-file-name bytecomp-file bytecomp-directory)) @@ -1724,8 +1724,7 @@ The value is non-nil if there were no errors, nil if errors." (bytecomp-file-name nil) (bytecomp-file-dir nil)) (and bytecomp-file - (eq (cdr (assq 'major-mode (buffer-local-variables))) - 'emacs-lisp-mode) + (derived-mode-p 'emacs-lisp-mode) (setq bytecomp-file-name (file-name-nondirectory bytecomp-file) bytecomp-file-dir (file-name-directory bytecomp-file))) (list (read-file-name (if current-prefix-arg @@ -1803,7 +1802,7 @@ The value is non-nil if there were no errors, nil if errors." ;; within byte-compile-from-buffer lingers in that buffer. (setq output-buffer (save-current-buffer - (byte-compile-from-buffer input-buffer bytecomp-filename))) + (byte-compile-from-buffer input-buffer))) (if byte-compiler-error-flag nil (when byte-compile-verbose @@ -1880,9 +1879,11 @@ With argument ARG, insert value in current buffer after the form." (insert "\n")) ((message "%s" (prin1-to-string value))))))) +;; Dynamically bound in byte-compile-from-buffer. +;; NB also used in cl.el and cl-macs.el. +(defvar bytecomp-outbuffer) -(defun byte-compile-from-buffer (bytecomp-inbuffer &optional bytecomp-filename) - ;; Filename is used for the loading-into-Emacs-18 error message. +(defun byte-compile-from-buffer (bytecomp-inbuffer) (let (bytecomp-outbuffer (byte-compile-current-buffer bytecomp-inbuffer) (byte-compile-read-position nil) @@ -1919,8 +1920,9 @@ With argument ARG, insert value in current buffer after the form." (setq case-fold-search nil)) (displaying-byte-compile-warnings (with-current-buffer bytecomp-inbuffer - (and bytecomp-filename - (byte-compile-insert-header bytecomp-filename bytecomp-outbuffer)) + (and byte-compile-current-file + (byte-compile-insert-header byte-compile-current-file + bytecomp-outbuffer)) (goto-char (point-min)) ;; Should we always do this? When calling multiple files, it ;; would be useful to delay this warning until all have been @@ -1952,9 +1954,9 @@ and will be removed soon. See (elisp)Backquote in the manual.")) (byte-compile-warn-about-unresolved-functions)) ;; Fix up the header at the front of the output ;; if the buffer contains multibyte characters. - (and bytecomp-filename + (and byte-compile-current-file (with-current-buffer bytecomp-outbuffer - (byte-compile-fix-header bytecomp-filename))))) + (byte-compile-fix-header byte-compile-current-file))))) bytecomp-outbuffer)) (defun byte-compile-fix-header (filename) @@ -2043,10 +2045,6 @@ Call from the source buffer." ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n" ";;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;\n\n")))) -;; Dynamically bound in byte-compile-from-buffer. -;; NB also used in cl.el and cl-macs.el. -(defvar bytecomp-outbuffer) - (defun byte-compile-output-file-form (form) ;; writes the given form to the output buffer, being careful of docstrings ;; in defun, defmacro, defvar, defvaralias, defconst, autoload and @@ -2073,6 +2071,7 @@ Call from the source buffer." nil))) (defvar print-gensym-alist) ;Used before print-circle existed. +(defvar for-effect) (defun byte-compile-output-docform (preface name info form specindex quoted) "Print a form with a doc string. INFO is (prefix doc-index postfix). @@ -2138,7 +2137,7 @@ list that represents a doc string reference. ;; (for instance, gensyms in the arg list). (let (non-nil) (when (hash-table-p print-number-table) - (maphash (lambda (k v) (if v (setq non-nil t))) + (maphash (lambda (_k v) (if v (setq non-nil t))) print-number-table)) (not non-nil))) ;; Output the byte code and constants specially @@ -2393,8 +2392,8 @@ by side-effects." (if (byte-compile-warning-enabled-p 'redefine) (byte-compile-arglist-warn form macrop)) (if byte-compile-verbose - ;; bytecomp-filename is from byte-compile-from-buffer. - (message "Compiling %s... (%s)" (or bytecomp-filename "") (nth 1 form))) + (message "Compiling %s... (%s)" + (or byte-compile-current-file "") (nth 1 form))) (cond (bytecomp-that-one (if (and (byte-compile-warning-enabled-p 'redefine) ;; don't warn when compiling the stubs in byte-run... @@ -2815,14 +2814,15 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; Given an expression FORM, compile it and return an equivalent byte-code ;; expression (a call to the function byte-code). -(defun byte-compile-top-level (form &optional for-effect output-type +(defun byte-compile-top-level (form &optional for-effect-arg output-type lexenv reserved-csts) ;; OUTPUT-TYPE advises about how form is expected to be used: ;; 'eval or nil -> a single form, ;; 'progn or t -> a list of forms, ;; 'lambda -> body of a lambda, ;; 'file -> used at file-level. - (let ((byte-compile-constants nil) + (let ((for-effect for-effect-arg) + (byte-compile-constants nil) (byte-compile-variables nil) (byte-compile-tag-number 0) (byte-compile-depth 0) @@ -2852,8 +2852,8 @@ If FORM is a lambda or a macro, byte-compile it as a function." (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 +(defun byte-compile-out-toplevel (&optional for-effect-arg output-type) + (if for-effect-arg ;; The stack is empty. Push a value to be returned from (byte-code ..). (if (eq (car (car byte-compile-output)) 'byte-discard) (setq byte-compile-output (cdr byte-compile-output)) @@ -2872,7 +2872,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (setq byte-compile-output (nreverse byte-compile-output)) (if (memq byte-optimize '(t byte)) (setq byte-compile-output - (byte-optimize-lapcode byte-compile-output for-effect))) + (byte-optimize-lapcode byte-compile-output))) ;; Decompile trivial functions: ;; only constants and variables, or a single funcall except in lambdas. @@ -2889,6 +2889,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; progn -> as <> or (progn <> atom) ;; file -> as progn, but takes both quotes and atoms, and longer forms. (let (rest + (for-effect for-effect-arg) (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. tmp body) (cond @@ -2938,9 +2939,9 @@ If FORM is a lambda or a macro, byte-compile it as a function." ((car body))))) ;; Given BYTECOMP-BODY, compile it and return a new body. -(defun byte-compile-top-level-body (bytecomp-body &optional for-effect) +(defun byte-compile-top-level-body (bytecomp-body &optional for-effect-arg) (setq bytecomp-body - (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t)) + (byte-compile-top-level (cons 'progn bytecomp-body) for-effect-arg t)) (cond ((eq (car-safe bytecomp-body) 'progn) (cdr bytecomp-body)) (bytecomp-body @@ -2971,54 +2972,56 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; byte-compile-form, or take extreme care to handle for-effect correctly. ;; (Use byte-compile-form-do-effect to reset the for-effect flag too.) ;; -(defun byte-compile-form (form &optional for-effect) - (cond ((not (consp form)) - (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form)) - (when (symbolp form) - (byte-compile-set-symbol-position form)) - (byte-compile-constant form)) - ((and for-effect byte-compile-delete-errors) - (when (symbolp form) - (byte-compile-set-symbol-position form)) - (setq for-effect nil)) - (t - (byte-compile-variable-ref form)))) - ((symbolp (car form)) - (let* ((bytecomp-fn (car form)) - (bytecomp-handler (get bytecomp-fn 'byte-compile))) - (when (byte-compile-const-symbol-p bytecomp-fn) - (byte-compile-warn "`%s' called as a function" bytecomp-fn)) - (and (byte-compile-warning-enabled-p 'interactive-only) - (memq bytecomp-fn byte-compile-interactive-only-functions) - (byte-compile-warn "`%s' used from Lisp code\n\ +(defun byte-compile-form (form &optional for-effect-arg) + (let ((for-effect for-effect-arg)) + (cond + ((not (consp form)) + (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form)) + (when (symbolp form) + (byte-compile-set-symbol-position form)) + (byte-compile-constant form)) + ((and for-effect byte-compile-delete-errors) + (when (symbolp form) + (byte-compile-set-symbol-position form)) + (setq for-effect nil)) + (t + (byte-compile-variable-ref form)))) + ((symbolp (car form)) + (let* ((bytecomp-fn (car form)) + (bytecomp-handler (get bytecomp-fn 'byte-compile))) + (when (byte-compile-const-symbol-p bytecomp-fn) + (byte-compile-warn "`%s' called as a function" bytecomp-fn)) + (and (byte-compile-warning-enabled-p 'interactive-only) + (memq bytecomp-fn byte-compile-interactive-only-functions) + (byte-compile-warn "`%s' used from Lisp code\n\ That command is designed for interactive use only" bytecomp-fn)) - (if (and (fboundp (car form)) - (eq (car-safe (symbol-function (car form))) 'macro)) - (byte-compile-report-error - (format "Forgot to expand macro %s" (car form)))) - (if (and bytecomp-handler - ;; Make sure that function exists. This is important - ;; for CL compiler macros since the symbol may be - ;; `cl-byte-compile-compiler-macro' but if CL isn't - ;; loaded, this function doesn't exist. - (and (not (eq bytecomp-handler - ;; Already handled by macroexpand-all. - 'cl-byte-compile-compiler-macro)) - (functionp bytecomp-handler))) - (funcall bytecomp-handler form) - (byte-compile-normal-call form)) - (if (byte-compile-warning-enabled-p 'cl-functions) - (byte-compile-cl-warn form)))) - ((and (or (byte-code-function-p (car form)) - (eq (car-safe (car form)) 'lambda)) - ;; if the form comes out the same way it went in, that's - ;; because it was malformed, and we couldn't unfold it. - (not (eq form (setq form (byte-compile-unfold-lambda form))))) - (byte-compile-form form for-effect) - (setq for-effect nil)) - ((byte-compile-normal-call form))) - (if for-effect - (byte-compile-discard))) + (if (and (fboundp (car form)) + (eq (car-safe (symbol-function (car form))) 'macro)) + (byte-compile-report-error + (format "Forgot to expand macro %s" (car form)))) + (if (and bytecomp-handler + ;; Make sure that function exists. This is important + ;; for CL compiler macros since the symbol may be + ;; `cl-byte-compile-compiler-macro' but if CL isn't + ;; loaded, this function doesn't exist. + (and (not (eq bytecomp-handler + ;; Already handled by macroexpand-all. + 'cl-byte-compile-compiler-macro)) + (functionp bytecomp-handler))) + (funcall bytecomp-handler form) + (byte-compile-normal-call form)) + (if (byte-compile-warning-enabled-p 'cl-functions) + (byte-compile-cl-warn form)))) + ((and (or (byte-code-function-p (car form)) + (eq (car-safe (car form)) 'lambda)) + ;; if the form comes out the same way it went in, that's + ;; because it was malformed, and we couldn't unfold it. + (not (eq form (setq form (byte-compile-unfold-lambda form))))) + (byte-compile-form form for-effect) + (setq for-effect nil)) + ((byte-compile-normal-call form))) + (if for-effect + (byte-compile-discard)))) (defun byte-compile-normal-call (form) (when (and (byte-compile-warning-enabled-p 'callargs) @@ -3326,7 +3329,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" ((= len 4) (byte-compile-three-args form)) (t (byte-compile-subr-wrong-args form "2-3"))))) -(defun byte-compile-noop (form) +(defun byte-compile-noop (_form) (byte-compile-constant nil)) (defun byte-compile-discard (&optional num preserve-tos) @@ -3632,11 +3635,11 @@ discarding." ;;; control structures -(defun byte-compile-body (bytecomp-body &optional for-effect) +(defun byte-compile-body (bytecomp-body &optional for-effect-arg) (while (cdr bytecomp-body) (byte-compile-form (car bytecomp-body) t) (setq bytecomp-body (cdr bytecomp-body))) - (byte-compile-form (car bytecomp-body) for-effect)) + (byte-compile-form (car bytecomp-body) for-effect-arg)) (defsubst byte-compile-body-do-effect (bytecomp-body) (byte-compile-body bytecomp-body for-effect) @@ -4190,7 +4193,7 @@ binding slots have been popped." ;; Lambdas in valid places are handled as special cases by various code. ;; The ones that remain are errors. -(defun byte-compile-lambda-form (form) +(defun byte-compile-lambda-form (_form) (byte-compile-set-symbol-position 'lambda) (error "`lambda' used as function name is invalid")) diff --git a/lisp/subr.el b/lisp/subr.el index a493c31b254..b7b5bec1249 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -249,20 +249,6 @@ Any list whose car is `frame-configuration' is assumed to be a frame configuration." (and (consp object) (eq (car object) 'frame-configuration))) - -(defun functionp (object) - "Non-nil if OBJECT is a function." - (or (and (symbolp object) (fboundp object) - (condition-case nil - (setq object (indirect-function object)) - (error nil)) - (eq (car-safe object) 'autoload) - (not (car-safe (cdr-safe (cdr-safe (cdr-safe (cdr-safe object))))))) - (and (subrp object) - ;; Filter out special forms. - (not (eq 'unevalled (cdr (subr-arity object))))) - (byte-code-function-p object) - (eq (car-safe object) 'lambda))) ;;;; List functions. From ba83908c4b7fda12991ae9073028a60da87c1fa2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 11 Mar 2011 15:04:22 -0500 Subject: [PATCH 30/45] Misc fixes, and use lexical-binding in more files. * lisp/subr.el (letrec): New macro. (with-wrapper-hook): Move from lisp/simple.el and don't use CL. * simple.el (with-wrapper-hook): Move with-wrapper-hook to subr.el. * lisp/help-fns.el (help-function-arglist): Handle subroutines as well. (describe-variable): Use special-variable-p to filter completions. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Don't expand `declare' in defmacros. * lisp/emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): Handle `declare'. * lisp/emacs-lisp/cl.el (pushnew): Silence unfixable warning. * lisp/emacs-lisp/cl-macs.el (defstruct, define-compiler-macro): Mark unused arg as unused. * lisp/emacs-lisp/byte-opt.el (byte-optimize-lapcode): Use memq. * lisp/emacs-lisp/autoload.el (make-autoload): Don't assume the macro's first sexp is a list. (autoload-generate-file-autoloads): Improve error message. * lisp/emacs-lisp/advice.el (ad-arglist): Use help-function-arglist to understand the new byte-code arg format. * lisp/vc/smerge-mode.el: * lisp/vc/log-view.el: * lisp/vc/log-edit.el: * lisp/vc/cvs-status.el: * lisp/uniquify.el: * lisp/textmodes/css-mode.el: * lisp/textmodes/bibtex-style.el: * lisp/reveal.el: * lisp/newcomment.el: * lisp/emacs-lisp/smie.el: * lisp/abbrev.el: Use lexical-binding. * src/eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR. (Fdefvar): Remove redundant SYMBOLP check. (Ffunctionp): Don't signal an error for undefined aliases. * doc/lispref/variables.texi (Converting to Lexical Binding): New node. --- doc/lispref/ChangeLog | 4 +++ doc/lispref/variables.texi | 40 +++++++++++++++++++++- etc/NEWS.lexbind | 3 +- lisp/ChangeLog | 32 ++++++++++++++++++ lisp/abbrev.el | 29 ++++++++-------- lisp/emacs-lisp/advice.el | 16 +++------ lisp/emacs-lisp/autoload.el | 5 +-- lisp/emacs-lisp/byte-opt.el | 11 +++--- lisp/emacs-lisp/bytecomp.el | 34 ++++++++++--------- lisp/emacs-lisp/cconv.el | 4 +++ lisp/emacs-lisp/cl-loaddefs.el | 17 ++++++---- lisp/emacs-lisp/cl-macs.el | 14 ++++---- lisp/emacs-lisp/cl.el | 9 ++++- lisp/emacs-lisp/macroexp.el | 11 +++++- lisp/emacs-lisp/smie.el | 4 +-- lisp/help-fns.el | 22 ++++++++++-- lisp/mpc.el | 4 +-- lisp/newcomment.el | 4 +-- lisp/reveal.el | 2 +- lisp/simple.el | 45 ------------------------- lisp/subr.el | 61 ++++++++++++++++++++++++++++++++++ lisp/textmodes/bibtex-style.el | 4 +-- lisp/textmodes/css-mode.el | 2 +- lisp/uniquify.el | 2 +- lisp/vc/cvs-status.el | 42 +++++++++++++---------- lisp/vc/diff-mode.el | 53 +++++++++++++++-------------- lisp/vc/log-edit.el | 6 ++-- lisp/vc/log-view.el | 3 +- lisp/vc/smerge-mode.el | 2 +- src/ChangeLog | 6 ++++ src/eval.c | 25 ++++++-------- 31 files changed, 327 insertions(+), 189 deletions(-) diff --git a/doc/lispref/ChangeLog b/doc/lispref/ChangeLog index ab993fe35a2..8a1ccef335f 100644 --- a/doc/lispref/ChangeLog +++ b/doc/lispref/ChangeLog @@ -1,3 +1,7 @@ +2011-03-11 Stefan Monnier + + * variables.texi (Converting to Lexical Binding): New node. + 2011-03-01 Stefan Monnier * variables.texi (Scope): Mention the availability of lexical scoping. diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index 27ec4831cbe..fad76ed39f8 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -912,7 +912,7 @@ dynamically scoped, like all variables in Emacs Lisp. * Extent:: Extent means how long in time a value exists. * Impl of Scope:: Two ways to implement dynamic scoping. * Using Scoping:: How to use dynamic scoping carefully and avoid problems. -* Lexical Binding:: +* Lexical Binding:: Use of lexical scoping. @end menu @node Scope @@ -1136,6 +1136,44 @@ body can later be evaluated in the proper context. Those objects are called by @code{funcall}, and they are represented by a cons cell whose @code{car} is the symbol @code{closure}. +@menu +* Converting to Lexical Binding:: How to start using lexical scoping +@end menu + +@node Converting to Lexical Binding +@subsubsection Converting a package to use lexical scoping + +Lexical scoping, as currently implemented, does not bring many significant +benefits, unless you are a seasoned functional programmer addicted to +higher-order functions. But its importance will increase in the future: +lexical scoping opens up a lot more opportunities for optimization, so +lexically scoped code is likely to run faster in future Emacs versions, and it +is much more friendly to concurrency, which we want to add in the near future. + +Converting a package to lexical binding is usually pretty easy and should not +break backward compatibility: just add a file-local variable setting +@code{lexical-binding} to @code{t} and add declarations of the form +@code{(defvar @var{VAR})} for every variable which still needs to use +dynamic scoping. + +To find which variables need this declaration, the simplest solution is to +check the byte-compiler's warnings. The byte-compiler will usually find those +variables either because they are used outside of a let-binding (leading to +warnings about reference or assignment to ``free variable @var{VAR}'') or +because they are let-bound but not used within the let-binding (leading to +warnings about ``unused lexical variable @var{VAR}''). + +In cases where a dynamically scoped variable was bound as a function argument, +you will also need to move this binding to a @code{let}. These cases are also +flagged by the byte-compiler. + +To silence byte-compiler warnings about unused variables, just use a variable +name that start with an underscore, which the byte-compiler interpret as an +indication that this is a variable known not to be used. + +In most cases, the resulting code will then work with either setting of +@code{lexical-binding}, so it can still be used with older Emacsen (which will +simply ignore the @code{lexical-binding} variable setting). @node Buffer-Local Variables @section Buffer-Local Variables diff --git a/etc/NEWS.lexbind b/etc/NEWS.lexbind index bcb56c313f8..de5d9a07715 100644 --- a/etc/NEWS.lexbind +++ b/etc/NEWS.lexbind @@ -18,7 +18,8 @@ all the code in that file. ** Lexically scoped interpreted functions are represented with a new form of function value which looks like (closure ENV lambda ARGS &rest BODY). - +** New macro `letrec' to define recursive local functions. + ---------------------------------------------------------------------- This file is part of GNU Emacs. diff --git a/lisp/ChangeLog b/lisp/ChangeLog index fd00cf70f40..0b432eb46d9 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,35 @@ +2011-03-11 Stefan Monnier + + * subr.el (letrec): New macro. + (with-wrapper-hook): Move from simple.el and don't use CL. + * simple.el (with-wrapper-hook): Move with-wrapper-hook to subr.el. + * help-fns.el (help-function-arglist): Handle subroutines as well. + (describe-variable): Use special-variable-p to filter completions. + * emacs-lisp/macroexp.el (macroexpand-all-1): Don't expand `declare' + in defmacros. + * emacs-lisp/cconv.el (cconv-convert, cconv-analyse-form): + Handle `declare'. + * emacs-lisp/cl.el (pushnew): Silence unfixable warning. + * emacs-lisp/cl-macs.el (defstruct, define-compiler-macro): + Mark unused arg as unused. + * emacs-lisp/byte-opt.el (byte-optimize-lapcode): Use memq. + * emacs-lisp/autoload.el (make-autoload): Don't assume the macro's + first sexp is a list. + (autoload-generate-file-autoloads): Improve error message. + * emacs-lisp/advice.el (ad-arglist): Use help-function-arglist + to understand the new byte-code arg format. + * vc/smerge-mode.el: + * vc/log-view.el: + * vc/log-edit.el: + * vc/cvs-status.el: + * uniquify.el: + * textmodes/css-mode.el: + * textmodes/bibtex-style.el: + * reveal.el: + * newcomment.el: + * emacs-lisp/smie.el: + * abbrev.el: Use lexical-binding. + 2011-03-10 Stefan Monnier * emacs-lisp/bytecomp.el: Use lexical-binding. diff --git a/lisp/abbrev.el b/lisp/abbrev.el index fbca214a649..3844391a180 100644 --- a/lisp/abbrev.el +++ b/lisp/abbrev.el @@ -1,4 +1,4 @@ -;;; abbrev.el --- abbrev mode commands for Emacs +;;; abbrev.el --- abbrev mode commands for Emacs -*- lexical-binding: t -*- ;; Copyright (C) 1985-1987, 1992, 2001-2011 Free Software Foundation, Inc. @@ -767,20 +767,19 @@ Returns the abbrev symbol, if expansion took place." (destructuring-bind (&optional sym name wordstart wordend) (abbrev--before-point) (when sym - (let ((value sym)) - (unless (or ;; executing-kbd-macro - noninteractive - (window-minibuffer-p (selected-window))) - ;; Add an undo boundary, in case we are doing this for - ;; a self-inserting command which has avoided making one so far. - (undo-boundary)) - ;; Now sym is the abbrev symbol. - (setq last-abbrev-text name) - (setq last-abbrev sym) - (setq last-abbrev-location wordstart) - ;; If this abbrev has an expansion, delete the abbrev - ;; and insert the expansion. - (abbrev-insert sym name wordstart wordend)))))) + (unless (or ;; executing-kbd-macro + noninteractive + (window-minibuffer-p (selected-window))) + ;; Add an undo boundary, in case we are doing this for + ;; a self-inserting command which has avoided making one so far. + (undo-boundary)) + ;; Now sym is the abbrev symbol. + (setq last-abbrev-text name) + (setq last-abbrev sym) + (setq last-abbrev-location wordstart) + ;; If this abbrev has an expansion, delete the abbrev + ;; and insert the expansion. + (abbrev-insert sym name wordstart wordend))))) (defun unexpand-abbrev () "Undo the expansion of the last abbrev that expanded. diff --git a/lisp/emacs-lisp/advice.el b/lisp/emacs-lisp/advice.el index 915a726ae11..39ea97aa98e 100644 --- a/lisp/emacs-lisp/advice.el +++ b/lisp/emacs-lisp/advice.el @@ -2535,17 +2535,11 @@ See Info node `(elisp)Computed Advice' for detailed documentation." "Return the argument list of DEFINITION. If DEFINITION could be from a subr then its NAME should be supplied to make subr arglist lookup more efficient." - (cond ((ad-compiled-p definition) - (aref (ad-compiled-code definition) 0)) - ((consp definition) - (car (cdr (ad-lambda-expression definition)))) - ((ad-subr-p definition) - (if name - (ad-subr-arglist name) - ;; otherwise get it from its printed representation: - (setq name (format "%s" definition)) - (string-match "^#]+\\)>$" name) - (ad-subr-arglist (intern (match-string 1 name))))))) + (require 'help-fns) + (cond + ((or (ad-macro-p definition) (ad-advice-p definition)) + (help-function-arglist (cdr definition))) + (t (help-function-arglist definition)))) ;; Store subr-args as `((arg1 arg2 ...))' so I can distinguish ;; a defined empty arglist `(nil)' from an undefined arglist: diff --git a/lisp/emacs-lisp/autoload.el b/lisp/emacs-lisp/autoload.el index d6e7ee9e3cb..5a5d6b88a2d 100644 --- a/lisp/emacs-lisp/autoload.el +++ b/lisp/emacs-lisp/autoload.el @@ -137,7 +137,7 @@ or macro definition or a defcustom)." ;; Special case to autoload some of the macro's declarations. (let ((decls (nth (if (stringp (nth 3 form)) 4 3) form)) (exps '())) - (when (eq (car decls) 'declare) + (when (eq (car-safe decls) 'declare) ;; FIXME: We'd like to reuse macro-declaration-function, ;; but we can't since it doesn't return anything. (dolist (decl decls) @@ -471,7 +471,8 @@ Return non-nil if and only if FILE adds no autoloads to OUTFILE (marker-buffer output-start))) (autoload-print-form autoload))) (error - (message "Error in %s: %S" file err))) + (message "Autoload cookie error in %s:%s %S" + file (count-lines (point-min) (point)) err))) ;; Copy the rest of the line to the output. (princ (buffer-substring diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 68ec2144dae..a4254bfeca1 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -1657,8 +1657,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; it is wrong to do the same thing for the -else-pop variants. ;; ((and (eq 'byte-not (car lap0)) - (or (eq 'byte-goto-if-nil (car lap1)) - (eq 'byte-goto-if-not-nil (car lap1)))) + (memq (car lap1) '(byte-goto-if-nil byte-goto-if-not-nil))) (byte-compile-log-lap " not %s\t-->\t%s" lap1 (cons @@ -1677,8 +1676,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; ;; it is wrong to do the same thing for the -else-pop variants. ;; - ((and (or (eq 'byte-goto-if-nil (car lap0)) - (eq 'byte-goto-if-not-nil (car lap0))) ; gotoX + ((and (memq (car lap0) + '(byte-goto-if-nil byte-goto-if-not-nil)) ; gotoX (eq 'byte-goto (car lap1)) ; gotoY (eq (cdr lap0) lap2)) ; TAG X (let ((inverse (if (eq 'byte-goto-if-nil (car lap0)) @@ -1701,8 +1700,8 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; only be known when the closure will be built at ;; run-time). (consp (cdr lap0))) - (cond ((if (or (eq (car lap1) 'byte-goto-if-nil) - (eq (car lap1) 'byte-goto-if-nil-else-pop)) + (cond ((if (memq (car lap1) '(byte-goto-if-nil + byte-goto-if-nil-else-pop)) (car (cdr lap0)) (not (car (cdr lap0)))) (byte-compile-log-lap " %s %s\t-->\t" diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 77dd3408219..c661e6bea7a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -432,11 +432,12 @@ This list lives partly on the stack.") (eval-when-compile . (lambda (&rest body) (list 'quote + ;; FIXME: is that right in lexbind code? (byte-compile-eval - (byte-compile-top-level - (macroexpand-all - (cons 'progn body) - byte-compile-initial-macro-environment)))))) + (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)) (cons 'progn body)))) @@ -2732,16 +2733,16 @@ 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 - ;; If doing lexical binding, push a new - ;; lexical environment containing just the - ;; args (since lambda expressions should be - ;; closed by now). - (and lexical-binding - (byte-compile-make-lambda-lexenv - bytecomp-fun)) - reserved-csts))) + (let ((compiled + (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda + ;; If doing lexical binding, push a new + ;; lexical environment containing just the + ;; args (since lambda expressions should be + ;; closed by now). + (and lexical-binding + (byte-compile-make-lambda-lexenv + bytecomp-fun)) + reserved-csts))) ;; Build the actual byte-coded function. (if (eq 'byte-code (car-safe compiled)) (apply 'make-byte-code @@ -3027,8 +3028,9 @@ That command is designed for interactive use only" bytecomp-fn)) (when (and (byte-compile-warning-enabled-p 'callargs) (symbolp (car form))) (if (memq (car form) - '(custom-declare-group custom-declare-variable - custom-declare-face)) + '(custom-declare-group + ;; custom-declare-variable custom-declare-face + )) (byte-compile-nogroup-warn form)) (when (get (car form) 'byte-obsolete-info) (byte-compile-warn-obsolete (car form))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 741bc7ce74f..5be84c15d89 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -488,6 +488,8 @@ places where they originally did not directly appear." (cconv-convert form nil nil)) forms))) + (`(declare . ,_) form) ;The args don't contain code. + (`(,func . ,forms) ;; First element is function or whatever function-like forms are: or, and, ;; if, progn, prog1, prog2, while, until @@ -683,6 +685,8 @@ and updates the data stored in ENV." ;; variables in the function's enclosing environment, but it doesn't ;; seem worth the trouble. (dolist (form forms) (cconv-analyse-form form nil))) + + (`(declare . ,_) nil) ;The args don't contain code. (`(,_ . ,body-forms) ; First element is a function or whatever. (dolist (form body-forms) (cconv-analyse-form form env))) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 17046f1ffb4..2795b143e47 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -277,12 +277,12 @@ Not documented ;;;;;; assert check-type typep deftype cl-struct-setf-expander defstruct ;;;;;; define-modify-macro callf2 callf letf* letf rotatef shiftf ;;;;;; remf cl-do-pop psetf setf get-setf-method defsetf define-setf-method -;;;;;; declare locally multiple-value-setq multiple-value-bind lexical-let* -;;;;;; lexical-let symbol-macrolet macrolet labels flet progv psetq -;;;;;; do-all-symbols do-symbols dotimes dolist do* do loop return-from -;;;;;; return block etypecase typecase ecase case load-time-value -;;;;;; eval-when destructuring-bind function* defmacro* defun* gentemp -;;;;;; gensym) "cl-macs" "cl-macs.el" "5bdba3fbbcbfcf57a2c9ca87a6318150") +;;;;;; declare the locally multiple-value-setq multiple-value-bind +;;;;;; lexical-let* lexical-let symbol-macrolet macrolet labels +;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist +;;;;;; do* do loop return-from return block etypecase typecase ecase +;;;;;; case load-time-value eval-when destructuring-bind function* +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "864a28dc0495ad87d39637a965387526") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ @@ -535,6 +535,11 @@ values. For compatibility, (values A B C) is a synonym for (list A B C). \(fn &rest BODY)" nil (quote macro)) +(autoload 'the "cl-macs" "\ + + +\(fn TYPE FORM)" nil (quote macro)) + (autoload 'declare "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 8b1fc9d5f53..851355e2c75 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2428,11 +2428,13 @@ value, that slot cannot be set via `setf'. (push (cons name t) side-eff)))) (if print-auto (nconc print-func (list '(princ ")" cl-s) t))) (if print-func - (push (list 'push - (list 'function - (list 'lambda '(cl-x cl-s cl-n) - (list 'and pred-form print-func))) - 'custom-print-functions) forms)) + (push `(push + ;; The auto-generated function does not pay attention to + ;; the depth argument cl-n. + (lambda (cl-x cl-s ,(if print-auto '_cl-n 'cl-n)) + (and ,pred-form ,print-func)) + custom-print-functions) + forms)) (push (list 'setq tag-symbol (list 'list (list 'quote tag))) forms) (push (list* 'eval-when '(compile load eval) (list 'put (list 'quote name) '(quote cl-struct-slots) @@ -2586,7 +2588,7 @@ and then returning foo." (cl-transform-function-property func 'cl-compiler-macro (cons (if (memq '&whole args) (delq '&whole args) - (cons '--cl-whole-arg-- args)) body)) + (cons '_cl-whole-arg args)) body)) (list 'or (list 'get (list 'quote func) '(quote byte-compile)) (list 'progn (list 'put (list 'quote func) '(quote byte-compile) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 1d2b82f82eb..d303dab4ad3 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -161,7 +161,14 @@ an element already on the list. (if (symbolp place) (if (null keys) `(let ((x ,x)) - (if (memql x ,place) ,place (setq ,place (cons x ,place)))) + (if (memql x ,place) + ;; This symbol may later on expand to actual code which then + ;; trigger warnings like "value unused" since pushnew's return + ;; value is rarely used. It should not matter that other + ;; warnings may be silenced, since `place' is used earlier and + ;; should have triggered them already. + (with-no-warnings ,place) + (setq ,place (cons x ,place)))) (list 'setq place (list* 'adjoin x place keys))) (list* 'callf2 'adjoin x place keys))) diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 168a430577d..55ca90597d1 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -131,7 +131,16 @@ Assumes the caller has bound `macroexpand-all-environment'." (`(defmacro ,name . ,args-and-body) (push (cons name (cons 'lambda args-and-body)) macroexpand-all-environment) - (macroexpand-all-forms form 3)) + (let ((n 3)) + ;; Don't macroexpand `declare' since it should really be "expanded" + ;; away when `defmacro' is expanded, but currently defmacro is not + ;; itself a macro. So both `defmacro' and `declare' need to be + ;; handled directly in bytecomp.el. + ;; FIXME: Maybe a simpler solution is to (defalias 'declare 'quote). + (while (or (stringp (nth n form)) + (eq (car-safe (nth n form)) 'declare)) + (setq n (1+ n))) + (macroexpand-all-forms form n))) (`(defun . ,_) (macroexpand-all-forms form 3)) (`(,(or `defvar `defconst) . ,_) (macroexpand-all-forms form 2)) (`(function ,(and f `(lambda . ,_))) diff --git a/lisp/emacs-lisp/smie.el b/lisp/emacs-lisp/smie.el index e81a8b37981..2701d6b940b 100644 --- a/lisp/emacs-lisp/smie.el +++ b/lisp/emacs-lisp/smie.el @@ -1,4 +1,4 @@ -;;; smie.el --- Simple Minded Indentation Engine +;;; smie.el --- Simple Minded Indentation Engine -*- lexical-binding: t -*- ;; Copyright (C) 2010-2011 Free Software Foundation, Inc. @@ -178,7 +178,7 @@ one of those elements share the same precedence level and associativity." ;; Maybe also add (or ...) for things like ;; (exp (exp (or "+" "*" "=" ..) exp)). ;; Basically, make it EBNF (except for the specification of a separator in - ;; the repetition). + ;; the repetition, maybe). (let ((nts (mapcar 'car bnf)) ;Non-terminals (first-ops-table ()) (last-ops-table ()) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index 35f8c5e8e37..f81505c1cf1 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -124,6 +124,22 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (nreverse arglist))) ((byte-code-function-p def) (aref def 0)) ((eq (car-safe def) 'lambda) (nth 1 def)) + ((subrp def) + (let ((arity (subr-arity def)) + (arglist ())) + (dotimes (i (car arity)) + (push (intern (concat "arg" (number-to-string (1+ i)))) arglist)) + (cond + ((not (numberp (cdr arglist))) + (push '&rest arglist) + (push 'rest arglist)) + ((< (car arity) (cdr arity)) + (push '&optional arglist) + (dotimes (i (- (cdr arity) (car arity))) + (push (intern (concat "arg" (number-to-string + (+ 1 i (car arity))))) + arglist)))) + (nreverse arglist))) ((and (eq (car-safe def) 'autoload) (not (eq (nth 4 def) 'keymap))) "[Arg list not available until function definition is loaded.]") (t t))) @@ -618,9 +634,9 @@ it is displayed along with the global value." "Describe variable (default %s): " v) "Describe variable: ") obarray - '(lambda (vv) - (or (boundp vv) - (get vv 'variable-documentation))) + (lambda (vv) + (or (special-variable-p vv) + (get vv 'variable-documentation))) t nil nil (if (symbolp v) (symbol-name v)))) (list (if (equal val "") diff --git a/lisp/mpc.el b/lisp/mpc.el index 10e8c9d7688..b1e4d860cca 100644 --- a/lisp/mpc.el +++ b/lisp/mpc.el @@ -2452,13 +2452,13 @@ This is used so that they can be compared with `eq', which is needed for (defvar mpc-faster-speedup 8) -(defun mpc-ffwd (event) +(defun mpc-ffwd (_event) "Fast forward." (interactive (list last-nonmenu-event)) ;; (mpc--faster event 4.0 1) (mpc--faster-toggle mpc-faster-speedup 1)) -(defun mpc-rewind (event) +(defun mpc-rewind (_event) "Fast rewind." (interactive (list last-nonmenu-event)) ;; (mpc--faster event 4.0 -1) diff --git a/lisp/newcomment.el b/lisp/newcomment.el index d88b76a7759..d3530b1be3e 100644 --- a/lisp/newcomment.el +++ b/lisp/newcomment.el @@ -1,4 +1,4 @@ -;;; newcomment.el --- (un)comment regions of buffers +;;; newcomment.el --- (un)comment regions of buffers -*- lexical-binding: t -*- ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. @@ -722,7 +722,7 @@ With any other arg, set comment column to indentation of the previous comment With prefix ARG, kill comments on that many lines starting with this one." (interactive "P") (comment-normalize-vars) - (dotimes (_ (prefix-numeric-value arg)) + (dotimes (i (prefix-numeric-value arg)) (save-excursion (beginning-of-line) (let ((cs (comment-search-forward (line-end-position) t))) diff --git a/lisp/reveal.el b/lisp/reveal.el index 574c86a0fa4..bf18602379c 100644 --- a/lisp/reveal.el +++ b/lisp/reveal.el @@ -1,4 +1,4 @@ -;;; reveal.el --- Automatically reveal hidden text at point +;;; reveal.el --- Automatically reveal hidden text at point -*- lexical-binding: t -*- ;; Copyright (C) 2000-2011 Free Software Foundation, Inc. diff --git a/lisp/simple.el b/lisp/simple.el index 4549a0bb336..f84812570bf 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -2827,51 +2827,6 @@ These commands include \\[set-mark-command] and \\[start-kbd-macro]." (reset-this-command-lengths) (restore-overriding-map)) -;; This function is here rather than in subr.el because it uses CL. -(defmacro with-wrapper-hook (var args &rest body) - "Run BODY wrapped with the VAR hook. -VAR is a special hook: its functions are called with a first argument -which is the \"original\" code (the BODY), so the hook function can wrap -the original function, or call it any number of times (including not calling -it at all). This is similar to an `around' advice. -VAR is normally a symbol (a variable) in which case it is treated like -a hook, with a buffer-local and a global part. But it can also be an -arbitrary expression. -ARGS is a list of variables which will be passed as additional arguments -to each function, after the initial argument, and which the first argument -expects to receive when called." - (declare (indent 2) (debug t)) - ;; We need those two gensyms because CL's lexical scoping is not available - ;; for function arguments :-( - (let ((funs (make-symbol "funs")) - (global (make-symbol "global")) - (argssym (make-symbol "args"))) - ;; Since the hook is a wrapper, the loop has to be done via - ;; recursion: a given hook function will call its parameter in order to - ;; continue looping. - `(labels ((runrestofhook (,funs ,global ,argssym) - ;; `funs' holds the functions left on the hook and `global' - ;; holds the functions left on the global part of the hook - ;; (in case the hook is local). - (lexical-let ((funs ,funs) - (global ,global)) - (if (consp funs) - (if (eq t (car funs)) - (runrestofhook - (append global (cdr funs)) nil ,argssym) - (apply (car funs) - (lambda (&rest ,argssym) - (runrestofhook (cdr funs) global ,argssym)) - ,argssym)) - ;; Once there are no more functions on the hook, run - ;; the original body. - (apply (lambda ,args ,@body) ,argssym))))) - (runrestofhook ,var - ;; The global part of the hook, if any. - ,(if (symbolp var) - `(if (local-variable-p ',var) - (default-value ',var))) - (list ,@args))))) (defvar filter-buffer-substring-functions nil "Wrapper hook around `filter-buffer-substring'. diff --git a/lisp/subr.el b/lisp/subr.el index b7b5bec1249..b6f095136ff 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -1242,6 +1242,67 @@ the hook's buffer-local value rather than its default value." (kill-local-variable hook) (set hook hook-value)))))) +(defmacro letrec (binders &rest body) + "Bind variables according to BINDERS then eval BODY. +The value of the last form in BODY is returned. +Each element of BINDERS is a list (SYMBOL VALUEFORM) which binds +SYMBOL to the value of VALUEFORM. +All symbols are bound before the VALUEFORMs are evalled." + ;; Only useful in lexical-binding mode. + ;; As a special-form, we could implement it more efficiently (and cleanly, + ;; making the vars actually unbound during evaluation of the binders). + (declare (debug let) (indent 1)) + `(let ,(mapcar #'car binders) + ,@(mapcar (lambda (binder) `(setq ,@binder)) binders) + ,@body)) + +(defmacro with-wrapper-hook (var args &rest body) + "Run BODY wrapped with the VAR hook. +VAR is a special hook: its functions are called with a first argument +which is the \"original\" code (the BODY), so the hook function can wrap +the original function, or call it any number of times (including not calling +it at all). This is similar to an `around' advice. +VAR is normally a symbol (a variable) in which case it is treated like +a hook, with a buffer-local and a global part. But it can also be an +arbitrary expression. +ARGS is a list of variables which will be passed as additional arguments +to each function, after the initial argument, and which the first argument +expects to receive when called." + (declare (indent 2) (debug t)) + ;; We need those two gensyms because CL's lexical scoping is not available + ;; for function arguments :-( + (let ((funs (make-symbol "funs")) + (global (make-symbol "global")) + (argssym (make-symbol "args")) + (runrestofhook (make-symbol "runrestofhook"))) + ;; Since the hook is a wrapper, the loop has to be done via + ;; recursion: a given hook function will call its parameter in order to + ;; continue looping. + `(letrec ((,runrestofhook + (lambda (,funs ,global ,argssym) + ;; `funs' holds the functions left on the hook and `global' + ;; holds the functions left on the global part of the hook + ;; (in case the hook is local). + (if (consp ,funs) + (if (eq t (car ,funs)) + (funcall ,runrestofhook + (append ,global (cdr ,funs)) nil ,argssym) + (apply (car ,funs) + (apply-partially + (lambda (,funs ,global &rest ,argssym) + (funcall ,runrestofhook ,funs ,global ,argssym)) + (cdr ,funs) ,global) + ,argssym)) + ;; Once there are no more functions on the hook, run + ;; the original body. + (apply (lambda ,args ,@body) ,argssym))))) + (funcall ,runrestofhook ,var + ;; The global part of the hook, if any. + ,(if (symbolp var) + `(if (local-variable-p ',var) + (default-value ',var))) + (list ,@args))))) + (defun add-to-list (list-var element &optional append compare-fn) "Add ELEMENT to the value of LIST-VAR if it isn't there yet. The test for presence of ELEMENT is done with `equal', diff --git a/lisp/textmodes/bibtex-style.el b/lisp/textmodes/bibtex-style.el index 831d4e86676..bc5326240a3 100644 --- a/lisp/textmodes/bibtex-style.el +++ b/lisp/textmodes/bibtex-style.el @@ -1,4 +1,4 @@ -;;; bibtex-style.el --- Major mode for BibTeX Style files +;;; bibtex-style.el --- Major mode for BibTeX Style files -*- lexical-binding: t -*- ;; Copyright (C) 2005, 2007-2011 Free Software Foundation, Inc. @@ -141,7 +141,7 @@ (looking-at "if\\$")) (scan-error nil)))) (save-excursion - (condition-case err + (condition-case nil (while (progn (backward-sexp 1) (save-excursion (skip-chars-backward " \t{") (not (bolp))))) diff --git a/lisp/textmodes/css-mode.el b/lisp/textmodes/css-mode.el index b611261723a..ef51fb25035 100644 --- a/lisp/textmodes/css-mode.el +++ b/lisp/textmodes/css-mode.el @@ -1,4 +1,4 @@ -;;; css-mode.el --- Major mode to edit CSS files +;;; css-mode.el --- Major mode to edit CSS files -*- lexical-binding: t -*- ;; Copyright (C) 2006-2011 Free Software Foundation, Inc. diff --git a/lisp/uniquify.el b/lisp/uniquify.el index e894127cdb1..3153e143ba3 100644 --- a/lisp/uniquify.el +++ b/lisp/uniquify.el @@ -1,4 +1,4 @@ -;;; uniquify.el --- unique buffer names dependent on file name +;;; uniquify.el --- unique buffer names dependent on file name -*- lexical-binding: t -*- ;; Copyright (C) 1989, 1995-1997, 2001-2011 Free Software Foundation, Inc. diff --git a/lisp/vc/cvs-status.el b/lisp/vc/cvs-status.el index 7354e616c99..063eb414579 100644 --- a/lisp/vc/cvs-status.el +++ b/lisp/vc/cvs-status.el @@ -1,4 +1,4 @@ -;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8 -*- +;;; cvs-status.el --- major mode for browsing `cvs status' output -*- coding: utf-8; lexical-binding: t -*- ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. @@ -87,6 +87,12 @@ '(cvs-status-font-lock-keywords t nil nil nil (font-lock-multiline . t))) (defvar cvs-minor-wrap-function) +(defvar cvs-force-command) +(defvar cvs-minor-current-files) +(defvar cvs-secondary-branch-prefix) +(defvar cvs-branch-prefix) +(defvar cvs-tag-print-rev) + (put 'cvs-status-mode 'mode-class 'special) ;;;###autoload (define-derived-mode cvs-status-mode fundamental-mode "CVS-Status" @@ -472,7 +478,7 @@ Optional prefix ARG chooses between two representations." (nprev (if (and cvs-tree-nomerge next (equal vlist (cvs-tag->vlist next))) prev vlist))) - (cvs-map (lambda (v p) v) nprev prev))) + (cvs-map (lambda (v _p) v) nprev prev))) (after (save-excursion (newline) (cvs-tree-tags-insert (cdr tags) nprev))) @@ -512,24 +518,24 @@ Optional prefix ARG chooses between two representations." ;;;; Merged trees from different files ;;;; -(defun cvs-tree-fuzzy-merge-1 (trees tree prev) - ) +;; (defun cvs-tree-fuzzy-merge-1 (trees tree prev) +;; ) -(defun cvs-tree-fuzzy-merge (trees tree) - "Do the impossible: merge TREE into TREES." - ()) +;; (defun cvs-tree-fuzzy-merge (trees tree) +;; "Do the impossible: merge TREE into TREES." +;; ()) -(defun cvs-tree () - "Get tags from the status output and merge tham all into a big tree." - (save-excursion - (goto-char (point-min)) - (let ((inhibit-read-only t) - (trees (make-vector 31 0)) tree) - (while (listp (setq tree (cvs-tags->tree (cvs-status-get-tags)))) - (cvs-tree-fuzzy-merge trees tree)) - (erase-buffer) - (let ((cvs-tag-print-rev nil)) - (cvs-tree-print tree 'cvs-tag->string 3))))) +;; (defun cvs-tree () +;; "Get tags from the status output and merge them all into a big tree." +;; (save-excursion +;; (goto-char (point-min)) +;; (let ((inhibit-read-only t) +;; (trees (make-vector 31 0)) tree) +;; (while (listp (setq tree (cvs-tags->tree (cvs-status-get-tags)))) +;; (cvs-tree-fuzzy-merge trees tree)) +;; (erase-buffer) +;; (let ((cvs-tag-print-rev nil)) +;; (cvs-tree-print tree 'cvs-tag->string 3))))) (provide 'cvs-status) diff --git a/lisp/vc/diff-mode.el b/lisp/vc/diff-mode.el index 8e5fe27f965..f55629b3ea1 100644 --- a/lisp/vc/diff-mode.el +++ b/lisp/vc/diff-mode.el @@ -811,7 +811,7 @@ PREFIX is only used internally: don't use it." (defun diff-ediff-patch () "Call `ediff-patch-file' on the current buffer." (interactive) - (condition-case err + (condition-case nil (ediff-patch-file nil (current-buffer)) (wrong-number-of-arguments (ediff-patch-file)))) @@ -1168,7 +1168,7 @@ else cover the whole buffer." ;; *-change-function is asking for trouble, whereas making them ;; from a post-command-hook doesn't pose much problems (defvar diff-unhandled-changes nil) -(defun diff-after-change-function (beg end len) +(defun diff-after-change-function (beg end _len) "Remember to fixup the hunk header. See `after-change-functions' for the meaning of BEG, END and LEN." ;; Ignoring changes when inhibit-read-only is set is strictly speaking @@ -1690,7 +1690,7 @@ With a prefix argument, REVERSE the hunk." "See whether it's possible to apply the current hunk. With a prefix argument, try to REVERSE the hunk." (interactive "P") - (destructuring-bind (buf line-offset pos src dst &optional switched) + (destructuring-bind (buf line-offset pos src _dst &optional switched) (diff-find-source-location nil reverse) (set-window-point (display-buffer buf) (+ (car pos) (cdr src))) (diff-hunk-status-msg line-offset (diff-xor reverse switched) t))) @@ -1710,7 +1710,7 @@ then `diff-jump-to-old-file' is also set, for the next invocations." ;; This is a convenient detail when using smerge-diff. (if event (posn-set-point (event-end event))) (let ((rev (not (save-excursion (beginning-of-line) (looking-at "[-<]"))))) - (destructuring-bind (buf line-offset pos src dst &optional switched) + (destructuring-bind (buf line-offset pos src _dst &optional switched) (diff-find-source-location other-file rev) (pop-to-buffer buf) (goto-char (+ (car pos) (cdr src))) @@ -1728,7 +1728,7 @@ For use in `add-log-current-defun-function'." (when (looking-at diff-hunk-header-re) (forward-line 1) (re-search-forward "^[^ ]" nil t)) - (destructuring-bind (&optional buf line-offset pos src dst switched) + (destructuring-bind (&optional buf _line-offset pos src dst switched) ;; Use `noprompt' since this is used in which-func-mode and such. (ignore-errors ;Signals errors in place of prompting. (diff-find-source-location nil nil 'noprompt)) @@ -1876,28 +1876,27 @@ I.e. like `add-change-log-entry-other-window' but applied to all hunks." ;; good to call it for each change. (save-excursion (goto-char (point-min)) - (let ((orig-buffer (current-buffer))) - (condition-case nil - ;; Call add-change-log-entry-other-window for each hunk in - ;; the diff buffer. - (while (progn - (diff-hunk-next) - ;; Move to where the changes are, - ;; `add-change-log-entry-other-window' works better in - ;; that case. - (re-search-forward - (concat "\n[!+-<>]" - ;; If the hunk is a context hunk with an empty first - ;; half, recognize the "--- NNN,MMM ----" line - "\\(-- [0-9]+\\(,[0-9]+\\)? ----\n" - ;; and skip to the next non-context line. - "\\( .*\n\\)*[+]\\)?") - nil t)) - (save-excursion - ;; FIXME: this pops up windows of all the buffers. - (add-change-log-entry nil nil t nil t))) - ;; When there's no more hunks, diff-hunk-next signals an error. - (error nil))))) + (condition-case nil + ;; Call add-change-log-entry-other-window for each hunk in + ;; the diff buffer. + (while (progn + (diff-hunk-next) + ;; Move to where the changes are, + ;; `add-change-log-entry-other-window' works better in + ;; that case. + (re-search-forward + (concat "\n[!+-<>]" + ;; If the hunk is a context hunk with an empty first + ;; half, recognize the "--- NNN,MMM ----" line + "\\(-- [0-9]+\\(,[0-9]+\\)? ----\n" + ;; and skip to the next non-context line. + "\\( .*\n\\)*[+]\\)?") + nil t)) + (save-excursion + ;; FIXME: this pops up windows of all the buffers. + (add-change-log-entry nil nil t nil t))) + ;; When there's no more hunks, diff-hunk-next signals an error. + (error nil)))) ;; provide the package (provide 'diff-mode) diff --git a/lisp/vc/log-edit.el b/lisp/vc/log-edit.el index 192ab1f78d2..54a2cb4f196 100644 --- a/lisp/vc/log-edit.el +++ b/lisp/vc/log-edit.el @@ -1,4 +1,4 @@ -;;; log-edit.el --- Major mode for editing CVS commit messages +;;; log-edit.el --- Major mode for editing CVS commit messages -*- lexical-binding: t -*- ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. @@ -329,7 +329,7 @@ automatically." (defconst log-edit-header-contents-regexp "[ \t]*\\(.*\\(\n[ \t].*\\)*\\)\n?") -(defun log-edit-match-to-eoh (limit) +(defun log-edit-match-to-eoh (_limit) ;; FIXME: copied from message-match-to-eoh. (let ((start (point))) (rfc822-goto-eoh) @@ -361,7 +361,7 @@ automatically." nil lax))))) ;;;###autoload -(defun log-edit (callback &optional setup params buffer mode &rest ignore) +(defun log-edit (callback &optional setup params buffer mode &rest _ignore) "Setup a buffer to enter a log message. \\The buffer will be put in mode MODE or `log-edit-mode' if MODE is nil. diff --git a/lisp/vc/log-view.el b/lisp/vc/log-view.el index fa731e77a6e..d9a06c8a401 100644 --- a/lisp/vc/log-view.el +++ b/lisp/vc/log-view.el @@ -1,4 +1,4 @@ -;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output +;;; log-view.el --- Major mode for browsing RCS/CVS/SCCS log output -*- lexical-binding: t -*- ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. @@ -115,6 +115,7 @@ (autoload 'vc-diff-internal "vc") (defvar cvs-minor-wrap-function) +(defvar cvs-force-command) (defgroup log-view nil "Major mode for browsing log output of RCS/CVS/SCCS." diff --git a/lisp/vc/smerge-mode.el b/lisp/vc/smerge-mode.el index 37cdd41ee55..75e3b514531 100644 --- a/lisp/vc/smerge-mode.el +++ b/lisp/vc/smerge-mode.el @@ -1,4 +1,4 @@ -;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts +;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts -*- lexical-binding: t -*- ;; Copyright (C) 1999-2011 Free Software Foundation, Inc. diff --git a/src/ChangeLog b/src/ChangeLog index e8b3c57fbd0..bbf7f99bb32 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,9 @@ +2011-03-11 Stefan Monnier + + * eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR. + (Fdefvar): Remove redundant SYMBOLP check. + (Ffunctionp): Don't signal an error for undefined aliases. + 2011-03-06 Stefan Monnier * bytecode.c (exec_byte_code): Remove old lexical binding slot handling diff --git a/src/eval.c b/src/eval.c index 1f6a5e4a1c6..36c63a5c8a7 100644 --- a/src/eval.c +++ b/src/eval.c @@ -371,13 +371,12 @@ usage: (prog1 FIRST BODY...) */) do { + Lisp_Object tem = eval_sub (XCAR (args_left)); if (!(argnum++)) - val = eval_sub (Fcar (args_left)); - else - eval_sub (Fcar (args_left)); - args_left = Fcdr (args_left); + val = tem; + args_left = XCDR (args_left); } - while (!NILP(args_left)); + while (CONSP (args_left)); UNGCPRO; return val; @@ -406,13 +405,12 @@ usage: (prog2 FORM1 FORM2 BODY...) */) do { + Lisp_Object tem = eval_sub (XCAR (args_left)); if (!(argnum++)) - val = eval_sub (Fcar (args_left)); - else - eval_sub (Fcar (args_left)); - args_left = Fcdr (args_left); + val = tem; + args_left = XCDR (args_left); } - while (!NILP (args_left)); + while (CONSP (args_left)); UNGCPRO; return val; @@ -791,9 +789,8 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */) tem = Fdefault_boundp (sym); if (!NILP (tail)) { - if (SYMBOLP (sym)) - /* Do it before evaluating the initial value, for self-references. */ - XSYMBOL (sym)->declared_special = 1; + /* Do it before evaluating the initial value, for self-references. */ + XSYMBOL (sym)->declared_special = 1; if (SYMBOL_CONSTANT_P (sym)) { @@ -2873,7 +2870,7 @@ DEFUN ("functionp", Ffunctionp, Sfunctionp, 1, 1, 0, { if (SYMBOLP (object) && !NILP (Ffboundp (object))) { - object = Findirect_function (object, Qnil); + object = Findirect_function (object, Qt); if (CONSP (object) && EQ (XCAR (object), Qautoload)) { From 2ec42da9f0ddaaa9197617eb3e5a9d18ad2ba942 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 11 Mar 2011 22:32:43 -0500 Subject: [PATCH 31/45] Try and fix w32 build; misc cleanup. * lisp/subr.el (apply-partially): Move from subr.el; don't use lexical-let. (eval-after-load): Obey lexical-binding. * lisp/simple.el (apply-partially): Move to subr.el. * lisp/makefile.w32-in: Match changes in Makefile.in. (BIG_STACK_DEPTH, BIG_STACK_OPTS, BYTE_COMPILE_FLAGS): New vars. (.el.elc, compile-CMD, compile-SH, compile-always-CMD) (compile-always-SH, compile-calc-CMD, compile-calc-SH): Use them. (COMPILE_FIRST): Add pcase, macroexp, and cconv. * lisp/emacs-lisp/macroexp.el (macroexpand-all-1): Silence warning about calling CL's `compiler-macroexpand'. * lisp/emacs-lisp/bytecomp.el (byte-compile-preprocess): New function. (byte-compile-initial-macro-environment) (byte-compile-toplevel-file-form, byte-compile, byte-compile-sexp): Use it. (byte-compile-eval, byte-compile-eval-before-compile): Obey lexical-binding. (byte-compile--for-effect): Rename from `for-effect'. (display-call-tree): Use case. * lisp/emacs-lisp/byte-opt.el (for-effect): Don't declare as dynamic. (byte-optimize-form-code-walker, byte-optimize-form): Revert to old arg name. * lisp/Makefile.in (BYTE_COMPILE_FLAGS): New var. (compile-onefile, .el.elc, compile-calc, recompile): Use it. --- lisp/ChangeLog | 26 ++++ lisp/Makefile.in | 11 +- lisp/emacs-lisp/byte-opt.el | 33 ++-- lisp/emacs-lisp/bytecomp.el | 298 +++++++++++++++++++----------------- lisp/emacs-lisp/cconv.el | 1 - lisp/emacs-lisp/macroexp.el | 6 +- lisp/makefile.w32-in | 34 ++-- lisp/simple.el | 50 +++--- lisp/subr.el | 13 ++ 9 files changed, 264 insertions(+), 208 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 0b432eb46d9..01571b80124 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,29 @@ +2011-03-12 Stefan Monnier + + * subr.el (apply-partially): Move from subr.el; don't use lexical-let. + (eval-after-load): Obey lexical-binding. + * simple.el (apply-partially): Move to subr.el. + * makefile.w32-in: Match changes in Makefile.in. + (BIG_STACK_DEPTH, BIG_STACK_OPTS, BYTE_COMPILE_FLAGS): New vars. + (.el.elc, compile-CMD, compile-SH, compile-always-CMD) + (compile-always-SH, compile-calc-CMD, compile-calc-SH): Use them. + (COMPILE_FIRST): Add pcase, macroexp, and cconv. + * emacs-lisp/macroexp.el (macroexpand-all-1): Silence warning about + calling CL's `compiler-macroexpand'. + * emacs-lisp/bytecomp.el (byte-compile-preprocess): New function. + (byte-compile-initial-macro-environment) + (byte-compile-toplevel-file-form, byte-compile, byte-compile-sexp): + Use it. + (byte-compile-eval, byte-compile-eval-before-compile): + Obey lexical-binding. + (byte-compile--for-effect): Rename from `for-effect'. + (display-call-tree): Use case. + * emacs-lisp/byte-opt.el (for-effect): Don't declare as dynamic. + (byte-optimize-form-code-walker, byte-optimize-form): + Revert to old arg name. + * Makefile.in (BYTE_COMPILE_FLAGS): New var. + (compile-onefile, .el.elc, compile-calc, recompile): Use it. + 2011-03-11 Stefan Monnier * subr.el (letrec): New macro. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 268a45d8948..4db5ef4f008 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -77,6 +77,8 @@ AUTOGENEL = loaddefs.el \ BIG_STACK_DEPTH = 1200 BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" +BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) + # Files to compile before others during a bootstrap. This is done to # speed up the bootstrap process. @@ -205,7 +207,7 @@ compile-onefile: @echo Compiling $(THEFILE) @# Use byte-compile-refresh-preloaded to try and work around some of @# the most common bootstrapping problems. - @$(emacs) $(BIG_STACK_OPTS) -l bytecomp $(BYTE_COMPILE_EXTRA_FLAGS) \ + @$(emacs) $(BYTE_COMPILE_FLAGS) -l bytecomp \ -f byte-compile-refresh-preloaded \ -f batch-byte-compile $(THEFILE) @@ -225,7 +227,7 @@ compile-onefile: @# The BIG_STACK_OPTS are only needed to byte-compile the byte-compiler @# files, which is normally done in compile-first, but may also be @# recompiled via this rule. - @$(emacs) $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) \ + @$(emacs) $(BYTE_COMPILE_FLAGS) \ -f batch-byte-compile $< .PHONY: compile-first compile-main compile compile-always @@ -291,7 +293,7 @@ compile-always: doit compile-calc: for el in $(lisp)/calc/*.el; do \ echo Compiling $$el; \ - $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \ + $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \ done # Backup compiled Lisp files in elc.tar.gz. If that file already @@ -318,7 +320,8 @@ compile-after-backup: backup-compiled-files compile-always # since the environment of later files is affected by definitions in # earlier ones. recompile: doit $(LOADDEFS) compile-first $(lisp)/progmodes/cc-mode.elc - $(emacs) --eval "(batch-byte-recompile-directory 0)" $(lisp) + $(emacs) $(BYTE_COMPILE_FLAGS) \ + --eval "(batch-byte-recompile-directory 0)" $(lisp) # Update MH-E internal autoloads. These are not to be confused with # the autoloads for the MH-E entry points, which are already in loaddefs.el. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index a4254bfeca1..b07d61ae0d1 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -308,9 +308,9 @@ ;; ((lambda ...) ...) (defun byte-compile-unfold-lambda (form &optional name) ;; In lexical-binding mode, let and functions don't bind vars in the same way - ;; (let obey special-variable-p, but functions don't). This doesn't matter - ;; here, because function's behavior is underspecified so it can safely be - ;; turned into a `let', even though the reverse is not true. + ;; (let obey special-variable-p, but functions don't). But luckily, this + ;; doesn't matter here, because function's behavior is underspecified so it + ;; can safely be turned into a `let', even though the reverse is not true. (or name (setq name "anonymous lambda")) (let ((lambda (car form)) (values (cdr form))) @@ -378,9 +378,7 @@ ;;; implementing source-level optimizers -(defvar for-effect) - -(defun byte-optimize-form-code-walker (form for-effect-arg) +(defun byte-optimize-form-code-walker (form for-effect) ;; ;; For normal function calls, We can just mapcar the optimizer the cdr. But ;; we need to have special knowledge of the syntax of the special forms @@ -388,8 +386,7 @@ ;; the important aspect is that they are subrs that don't evaluate all of ;; their args.) ;; - (let ((for-effect for-effect-arg) - (fn (car-safe form)) + (let ((fn (car-safe form)) tmp) (cond ((not (consp form)) (if (not (and for-effect @@ -482,8 +479,8 @@ (byte-optimize-form (nth 2 form) for-effect) (byte-optimize-body (nthcdr 3 form) for-effect))))) - ((memq fn '(and or)) ; remember, and/or are control structures. - ;; take forms off the back until we can't any more. + ((memq fn '(and or)) ; Remember, and/or are control structures. + ;; Take forms off the back until we can't any more. ;; In the future it could conceivably be a problem that the ;; subexpressions of these forms are optimized in the reverse ;; order, but it's ok for now. @@ -498,7 +495,8 @@ (byte-compile-log " all subforms of %s called for effect; deleted" form)) (and backwards - (cons fn (nreverse (mapcar 'byte-optimize-form backwards))))) + (cons fn (nreverse (mapcar 'byte-optimize-form + backwards))))) (cons fn (mapcar 'byte-optimize-form (cdr form))))) ((eq fn 'interactive) @@ -537,8 +535,8 @@ ;; However, don't actually bother calling `ignore'. `(prog1 nil . ,(mapcar 'byte-optimize-form (cdr form)))) - ((eq fn 'internal-make-closure) - form) + ;; Neeeded as long as we run byte-optimize-form after cconv. + ((eq fn 'internal-make-closure) form) ((not (symbolp fn)) (debug) @@ -589,19 +587,18 @@ (setq list (cdr list))) constant)) -(defun byte-optimize-form (form &optional for-effect-arg) +(defun byte-optimize-form (form &optional for-effect) "The source-level pass of the optimizer." ;; ;; First, optimize all sub-forms of this one. - (setq form (byte-optimize-form-code-walker form for-effect-arg)) + (setq form (byte-optimize-form-code-walker form for-effect)) ;; ;; after optimizing all subforms, optimize this form until it doesn't ;; optimize any further. This means that some forms will be passed through ;; the optimizer many times, but that's necessary to make the for-effect ;; processing do as much as possible. ;; - (let ((for-effect for-effect-arg) - opt new) + (let (opt new) (if (and (consp form) (symbolp (car form)) (or (and for-effect @@ -618,7 +615,7 @@ (defun byte-optimize-body (forms all-for-effect) - ;; optimize the cdr of a progn or implicit progn; all forms is a list of + ;; Optimize the cdr of a progn or implicit progn; all forms is a list of ;; forms, all but the last of which are optimized with the assumption that ;; they are being called for effect. the last is for-effect as well if ;; all-for-effect is true. returns a new list of forms. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index c661e6bea7a..729d91eb1c5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -33,8 +33,7 @@ ;;; Code: -;; FIXME: Use lexical-binding and get rid of the atrocious "bytecomp-" -;; variable prefix. +;; FIXME: get rid of the atrocious "bytecomp-" variable prefix. ;; ======================================================================== ;; Entry points: @@ -432,12 +431,9 @@ This list lives partly on the stack.") (eval-when-compile . (lambda (&rest body) (list 'quote - ;; FIXME: is that right in lexbind code? (byte-compile-eval (byte-compile-top-level - (macroexpand-all - (cons 'progn body) - byte-compile-initial-macro-environment)))))) + (byte-compile-preprocess (cons 'progn body))))))) (eval-and-compile . (lambda (&rest body) (byte-compile-eval-before-compile (cons 'progn body)) (cons 'progn body)))) @@ -692,7 +688,7 @@ otherwise pop it") ;; 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 +;; discard (following one byte & 0x7F) stack entries _underneath_ TOS ;; (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 @@ -829,9 +825,11 @@ CONST2 may be evaulated multiple times." ;; 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) + (byte-compile-push-bytecodes opcode (logior #x7f flag) + bytes pc) (setq off (- off #x7f))) - (byte-compile-push-bytecodes opcode (logior off flag) bytes pc))) + (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)) @@ -875,7 +873,7 @@ CONST2 may be evaulated multiple times." Each function's symbol gets added to `byte-compile-noruntime-functions'." (let ((hist-orig load-history) (hist-nil-orig current-load-list)) - (prog1 (eval form) + (prog1 (eval form lexical-binding) (when (byte-compile-warning-enabled-p 'noruntime) (let ((hist-new load-history) (hist-nil-new current-load-list)) @@ -927,7 +925,7 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (defun byte-compile-eval-before-compile (form) "Evaluate FORM for `eval-and-compile'." (let ((hist-nil-orig current-load-list)) - (prog1 (eval form) + (prog1 (eval form lexical-binding) ;; (eval-and-compile (require 'cl) turns off warnings for cl functions. ;; FIXME Why does it do that - just as a hack? ;; There are other ways to do this nowadays. @@ -1018,7 +1016,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." read-symbol-positions-list (byte-compile-delete-first entry read-symbol-positions-list))) - (or (and allow-previous (not (= last byte-compile-last-position))) + (or (and allow-previous + (not (= last byte-compile-last-position))) (> last byte-compile-last-position))))))) (defvar byte-compile-last-warned-form nil) @@ -1030,7 +1029,8 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (let* ((inhibit-read-only t) (dir default-directory) (file (cond ((stringp byte-compile-current-file) - (format "%s:" (file-relative-name byte-compile-current-file dir))) + (format "%s:" (file-relative-name + byte-compile-current-file dir))) ((bufferp byte-compile-current-file) (format "Buffer %s:" (buffer-name byte-compile-current-file))) @@ -1093,13 +1093,15 @@ Each function's symbol gets added to `byte-compile-noruntime-functions'." (insert "\f\nCompiling " (if (stringp byte-compile-current-file) (concat "file " byte-compile-current-file) - (concat "buffer " (buffer-name byte-compile-current-file))) + (concat "buffer " + (buffer-name byte-compile-current-file))) " at " (current-time-string) "\n") (insert "\f\nCompiling no file at " (current-time-string) "\n")) (when dir (setq default-directory dir) (unless was-same - (insert (format "Entering directory `%s'\n" default-directory)))) + (insert (format "Entering directory `%s'\n" + default-directory)))) (setq byte-compile-last-logged-file byte-compile-current-file byte-compile-last-warned-form nil) ;; Do this after setting default-directory. @@ -1325,7 +1327,7 @@ extra args." (custom-declare-variable . defcustom)))) (cadr name))) ;; Update the current group, if needed. - (if (and byte-compile-current-file ;Only when byte-compiling a whole file. + (if (and byte-compile-current-file ;Only when compiling a whole file. (eq (car form) 'custom-declare-group) (eq (car-safe name) 'quote)) (setq byte-compile-current-group (cadr name)))))) @@ -1873,7 +1875,8 @@ With argument ARG, insert value in current buffer after the form." (let ((read-with-symbol-positions (current-buffer)) (read-symbol-positions-list nil)) (displaying-byte-compile-warnings - (byte-compile-sexp (read (current-buffer)))))))) + (byte-compile-sexp (read (current-buffer))))) + lexical-binding))) (cond (arg (message "Compiling from buffer... done.") (prin1 value (current-buffer)) @@ -2072,7 +2075,7 @@ Call from the source buffer." nil))) (defvar print-gensym-alist) ;Used before print-circle existed. -(defvar for-effect) +(defvar byte-compile--for-effect) (defun byte-compile-output-docform (preface name info form specindex quoted) "Print a form with a doc string. INFO is (prefix doc-index postfix). @@ -2147,8 +2150,10 @@ list that represents a doc string reference. (byte-compile-output-as-comment (cons (car form) (nth 1 form)) t))) - (setq position (- (position-bytes position) (point-min) -1)) - (princ (format "(#$ . %d) nil" position) bytecomp-outbuffer) + (setq position (- (position-bytes position) + (point-min) -1)) + (princ (format "(#$ . %d) nil" position) + bytecomp-outbuffer) (setq form (cdr form)) (setq index (1+ index)))) ((= index (nth 1 info)) @@ -2170,14 +2175,14 @@ list that represents a doc string reference. (if (memq byte-optimize '(t source)) (setq form (byte-optimize-form form t))) (if bytecomp-handler - (let ((for-effect t)) + (let ((byte-compile--for-effect t)) ;; To avoid consing up monstrously large forms at load time, we split ;; the output regularly. (and (memq (car-safe form) '(fset defalias)) (nthcdr 300 byte-compile-output) (byte-compile-flush-pending)) (funcall bytecomp-handler form) - (if for-effect + (if byte-compile--for-effect (byte-compile-discard))) (byte-compile-form form t)) nil) @@ -2195,13 +2200,22 @@ list that represents a doc string reference. byte-compile-maxdepth 0 byte-compile-output nil)))) +(defun byte-compile-preprocess (form &optional _for-effect) + (setq form (macroexpand-all form byte-compile-macro-environment)) + ;; FIXME: We should run byte-optimize-form here, but it currently does not + ;; recurse through all the code, so we'd have to fix this first. + ;; Maybe a good fix would be to merge byte-optimize-form into + ;; macroexpand-all. + ;; (if (memq byte-optimize '(t source)) + ;; (setq form (byte-optimize-form form for-effect))) + (if lexical-binding + (cconv-closure-convert form) + form)) + ;; byte-hunk-handlers cannot call this! (defun byte-compile-toplevel-file-form (form) (let ((byte-compile-current-form nil)) ; close over this for warnings. - (setq form (macroexpand-all form byte-compile-macro-environment)) - (if lexical-binding - (setq form (cconv-closure-convert form))) - (byte-compile-file-form form))) + (byte-compile-file-form (byte-compile-preprocess form t)))) ;; byte-hunk-handlers can call this. (defun byte-compile-file-form (form) @@ -2272,7 +2286,8 @@ list that represents a doc string reference. (byte-compile-top-level (nth 2 form) nil 'file)))) form)) -(put 'define-abbrev-table 'byte-hunk-handler 'byte-compile-file-form-define-abbrev-table) +(put 'define-abbrev-table 'byte-hunk-handler + 'byte-compile-file-form-define-abbrev-table) (defun byte-compile-file-form-define-abbrev-table (form) (if (eq 'quote (car-safe (car-safe (cdr form)))) (push (car-safe (cdr (cadr form))) byte-compile-bound-variables)) @@ -2542,11 +2557,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (setq fun (cdr fun))) (cond ((eq (car-safe fun) 'lambda) ;; Expand macros. - (setq fun - (macroexpand-all fun - byte-compile-initial-macro-environment)) - (if lexical-binding - (setq fun (cconv-closure-convert fun))) + (setq fun (byte-compile-preprocess fun)) ;; Get rid of the `function' quote added by the `lambda' macro. (if (eq (car-safe fun) 'function) (setq fun (cadr fun))) (setq fun (if macro @@ -2560,7 +2571,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." "Compile and return SEXP." (displaying-byte-compile-warnings (byte-compile-close-variables - (byte-compile-top-level sexp)))) + (byte-compile-top-level (byte-compile-preprocess sexp))))) ;; Given a function made by byte-compile-lambda, make a form which produces it. (defun byte-compile-byte-code-maker (fun) @@ -2815,14 +2826,14 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; Given an expression FORM, compile it and return an equivalent byte-code ;; expression (a call to the function byte-code). -(defun byte-compile-top-level (form &optional for-effect-arg output-type +(defun byte-compile-top-level (form &optional for-effect output-type lexenv reserved-csts) ;; OUTPUT-TYPE advises about how form is expected to be used: ;; 'eval or nil -> a single form, ;; 'progn or t -> a list of forms, ;; 'lambda -> body of a lambda, ;; 'file -> used at file-level. - (let ((for-effect for-effect-arg) + (let ((byte-compile--for-effect for-effect) (byte-compile-constants nil) (byte-compile-variables nil) (byte-compile-tag-number 0) @@ -2832,7 +2843,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-reserved-constants (or reserved-csts 0)) (byte-compile-output nil)) (if (memq byte-optimize '(t source)) - (setq form (byte-optimize-form form for-effect))) + (setq form (byte-optimize-form form byte-compile--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)) @@ -2850,11 +2861,11 @@ If FORM is a lambda or a macro, byte-compile it as a function." (when (> byte-compile-depth 0) (byte-compile-out-tag (byte-compile-make-tag)))) ;; Now compile FORM - (byte-compile-form form for-effect) - (byte-compile-out-toplevel for-effect output-type)))) + (byte-compile-form form byte-compile--for-effect) + (byte-compile-out-toplevel byte-compile--for-effect output-type)))) -(defun byte-compile-out-toplevel (&optional for-effect-arg output-type) - (if for-effect-arg +(defun byte-compile-out-toplevel (&optional for-effect output-type) + (if for-effect ;; The stack is empty. Push a value to be returned from (byte-code ..). (if (eq (car (car byte-compile-output)) 'byte-discard) (setq byte-compile-output (cdr byte-compile-output)) @@ -2890,7 +2901,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; progn -> as <> or (progn <> atom) ;; file -> as progn, but takes both quotes and atoms, and longer forms. (let (rest - (for-effect for-effect-arg) + (byte-compile--for-effect for-effect) (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. tmp body) (cond @@ -2902,34 +2913,35 @@ If FORM is a lambda or a macro, byte-compile it as a function." (progn (setq rest (nreverse (cdr (memq tmp (reverse byte-compile-output))))) - (while (cond - ((memq (car (car rest)) '(byte-varref byte-constant)) - (setq tmp (car (cdr (car rest)))) - (if (if (eq (car (car rest)) 'byte-constant) - (or (consp tmp) - (and (symbolp tmp) - (not (byte-compile-const-symbol-p tmp))))) - (if maycall - (setq body (cons (list 'quote tmp) body))) - (setq body (cons tmp body)))) - ((and maycall - ;; Allow a funcall if at most one atom follows it. - (null (nthcdr 3 rest)) - (setq tmp (get (car (car rest)) 'byte-opcode-invert)) - (or (null (cdr rest)) - (and (memq output-type '(file progn t)) - (cdr (cdr rest)) - (eq (car (nth 1 rest)) 'byte-discard) - (progn (setq rest (cdr rest)) t)))) - (setq maycall nil) ; Only allow one real function call. - (setq body (nreverse body)) - (setq body (list - (if (and (eq tmp 'funcall) - (eq (car-safe (car body)) 'quote)) - (cons (nth 1 (car body)) (cdr body)) - (cons tmp body)))) - (or (eq output-type 'file) - (not (delq nil (mapcar 'consp (cdr (car body)))))))) + (while + (cond + ((memq (car (car rest)) '(byte-varref byte-constant)) + (setq tmp (car (cdr (car rest)))) + (if (if (eq (car (car rest)) 'byte-constant) + (or (consp tmp) + (and (symbolp tmp) + (not (byte-compile-const-symbol-p tmp))))) + (if maycall + (setq body (cons (list 'quote tmp) body))) + (setq body (cons tmp body)))) + ((and maycall + ;; Allow a funcall if at most one atom follows it. + (null (nthcdr 3 rest)) + (setq tmp (get (car (car rest)) 'byte-opcode-invert)) + (or (null (cdr rest)) + (and (memq output-type '(file progn t)) + (cdr (cdr rest)) + (eq (car (nth 1 rest)) 'byte-discard) + (progn (setq rest (cdr rest)) t)))) + (setq maycall nil) ; Only allow one real function call. + (setq body (nreverse body)) + (setq body (list + (if (and (eq tmp 'funcall) + (eq (car-safe (car body)) 'quote)) + (cons (nth 1 (car body)) (cdr body)) + (cons tmp body)))) + (or (eq output-type 'file) + (not (delq nil (mapcar 'consp (cdr (car body)))))))) (setq rest (cdr rest))) rest)) (let ((byte-compile-vector (byte-compile-constants-vector))) @@ -2940,9 +2952,9 @@ If FORM is a lambda or a macro, byte-compile it as a function." ((car body))))) ;; Given BYTECOMP-BODY, compile it and return a new body. -(defun byte-compile-top-level-body (bytecomp-body &optional for-effect-arg) +(defun byte-compile-top-level-body (bytecomp-body &optional for-effect) (setq bytecomp-body - (byte-compile-top-level (cons 'progn bytecomp-body) for-effect-arg t)) + (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t)) (cond ((eq (car-safe bytecomp-body) 'progn) (cdr bytecomp-body)) (bytecomp-body @@ -2966,25 +2978,27 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; expression. ;; If for-effect is non-nil, byte-compile-form will output a byte-discard ;; before terminating (ie no value will be left on the stack). -;; A byte-compile handler may, when for-effect is non-nil, choose output code -;; which does not leave a value on the stack, and then set for-effect to nil -;; (to prevent byte-compile-form from outputting the byte-discard). +;; A byte-compile handler may, when byte-compile--for-effect is non-nil, choose +;; output code which does not leave a value on the stack, and then set +;; byte-compile--for-effect to nil (to prevent byte-compile-form from +;; outputting the byte-discard). ;; If a handler wants to call another handler, it should do so via -;; byte-compile-form, or take extreme care to handle for-effect correctly. -;; (Use byte-compile-form-do-effect to reset the for-effect flag too.) +;; byte-compile-form, or take extreme care to handle byte-compile--for-effect +;; correctly. (Use byte-compile-form-do-effect to reset the +;; byte-compile--for-effect flag too.) ;; -(defun byte-compile-form (form &optional for-effect-arg) - (let ((for-effect for-effect-arg)) +(defun byte-compile-form (form &optional for-effect) + (let ((byte-compile--for-effect for-effect)) (cond ((not (consp form)) (cond ((or (not (symbolp form)) (byte-compile-const-symbol-p form)) (when (symbolp form) (byte-compile-set-symbol-position form)) (byte-compile-constant form)) - ((and for-effect byte-compile-delete-errors) + ((and byte-compile--for-effect byte-compile-delete-errors) (when (symbolp form) (byte-compile-set-symbol-position form)) - (setq for-effect nil)) + (setq byte-compile--for-effect nil)) (t (byte-compile-variable-ref form)))) ((symbolp (car form)) @@ -3018,10 +3032,10 @@ That command is designed for interactive use only" bytecomp-fn)) ;; if the form comes out the same way it went in, that's ;; because it was malformed, and we couldn't unfold it. (not (eq form (setq form (byte-compile-unfold-lambda form))))) - (byte-compile-form form for-effect) - (setq for-effect nil)) + (byte-compile-form form byte-compile--for-effect) + (setq byte-compile--for-effect nil)) ((byte-compile-normal-call form))) - (if for-effect + (if byte-compile--for-effect (byte-compile-discard)))) (defun byte-compile-normal-call (form) @@ -3037,7 +3051,7 @@ That command is designed for interactive use only" bytecomp-fn)) (byte-compile-callargs-warn form)) (if byte-compile-generate-call-tree (byte-compile-annotate-call-tree form)) - (when (and for-effect (eq (car form) 'mapcar) + (when (and byte-compile--for-effect (eq (car form) 'mapcar) (byte-compile-warning-enabled-p 'mapcar)) (byte-compile-set-symbol-position 'mapcar) (byte-compile-warn @@ -3119,18 +3133,19 @@ If BINDING is non-nil, VAR is being bound." (car (setq byte-compile-constants (cons (list ,const) byte-compile-constants))))) -;; Use this when the value of a form is a constant. This obeys for-effect. +;; Use this when the value of a form is a constant. +;; This obeys byte-compile--for-effect. (defun byte-compile-constant (const) - (if for-effect - (setq for-effect nil) + (if byte-compile--for-effect + (setq byte-compile--for-effect nil) (when (symbolp const) (byte-compile-set-symbol-position const)) (byte-compile-out 'byte-constant (byte-compile-get-constant const)))) ;; Use this for a constant that is not the value of its containing form. -;; This ignores for-effect. +;; This ignores byte-compile--for-effect. (defun byte-compile-push-constant (const) - (let ((for-effect nil)) + (let ((byte-compile--for-effect nil)) (inline (byte-compile-constant const)))) ;; Compile those primitive ordinary functions @@ -3335,7 +3350,8 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-compile-constant nil)) (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). + "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." @@ -3357,7 +3373,7 @@ discarding." (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." + "Output byte codes to push the value at stack position STACK-POS." (let ((dist (- byte-compile-depth (1+ stack-pos)))) (if (zerop dist) ;; A simple optimization @@ -3366,7 +3382,7 @@ discarding." (byte-compile-out 'byte-stack-ref dist)))) (defun byte-compile-stack-set (stack-pos) - "Output byte codes to store the top-of-stack value at position STACK-POS in the stack." + "Output byte codes to store the TOS value at stack position STACK-POS." (byte-compile-out 'byte-stack-set (- byte-compile-depth (1+ stack-pos)))) (byte-defop-compiler-1 internal-make-closure byte-compile-make-closure) @@ -3375,7 +3391,7 @@ discarding." (defconst byte-compile--env-var (make-symbol "env")) (defun byte-compile-make-closure (form) - (if for-effect (setq for-effect nil) + (if byte-compile--for-effect (setq byte-compile--for-effect nil) (let* ((vars (nth 1 form)) (env (nth 2 form)) (body (nthcdr 3 form)) @@ -3389,7 +3405,7 @@ discarding." (defun byte-compile-get-closed-var (form) - (if for-effect (setq for-effect nil) + (if byte-compile--for-effect (setq byte-compile--for-effect nil) (byte-compile-out 'byte-constant ;; byte-closed-var (nth 1 form)))) @@ -3597,13 +3613,13 @@ discarding." (if bytecomp-args (while bytecomp-args (byte-compile-form (car (cdr bytecomp-args))) - (or for-effect (cdr (cdr bytecomp-args)) + (or byte-compile--for-effect (cdr (cdr bytecomp-args)) (byte-compile-out 'byte-dup 0)) (byte-compile-variable-set (car bytecomp-args)) (setq bytecomp-args (cdr (cdr bytecomp-args)))) ;; (setq), with no arguments. - (byte-compile-form nil for-effect)) - (setq for-effect nil))) + (byte-compile-form nil byte-compile--for-effect)) + (setq byte-compile--for-effect nil))) (defun byte-compile-setq-default (form) (setq form (cdr form)) @@ -3637,19 +3653,19 @@ discarding." ;;; control structures -(defun byte-compile-body (bytecomp-body &optional for-effect-arg) +(defun byte-compile-body (bytecomp-body &optional for-effect) (while (cdr bytecomp-body) (byte-compile-form (car bytecomp-body) t) (setq bytecomp-body (cdr bytecomp-body))) - (byte-compile-form (car bytecomp-body) for-effect-arg)) + (byte-compile-form (car bytecomp-body) for-effect)) (defsubst byte-compile-body-do-effect (bytecomp-body) - (byte-compile-body bytecomp-body for-effect) - (setq for-effect nil)) + (byte-compile-body bytecomp-body byte-compile--for-effect) + (setq byte-compile--for-effect nil)) (defsubst byte-compile-form-do-effect (form) - (byte-compile-form form for-effect) - (setq for-effect nil)) + (byte-compile-form form byte-compile--for-effect) + (setq byte-compile--for-effect nil)) (byte-defop-compiler-1 inline byte-compile-progn) (byte-defop-compiler-1 progn) @@ -3729,9 +3745,9 @@ that suppresses all warnings during execution of BODY." (byte-compile-bound-variables (append bound-list byte-compile-bound-variables))) (unwind-protect - ;; If things not being bound at all is ok, so must them being obsolete. - ;; Note that we add to the existing lists since Tramp (ab)uses - ;; this feature. + ;; If things not being bound at all is ok, so must them being + ;; obsolete. Note that we add to the existing lists since Tramp + ;; (ab)uses this feature. (let ((byte-compile-not-obsolete-vars (append byte-compile-not-obsolete-vars bound-list)) (byte-compile-not-obsolete-funcs @@ -3753,20 +3769,20 @@ that suppresses all warnings during execution of BODY." (if (null (nthcdr 3 form)) ;; No else-forms (progn - (byte-compile-goto-if nil for-effect donetag) + (byte-compile-goto-if nil byte-compile--for-effect donetag) (byte-compile-maybe-guarded clause - (byte-compile-form (nth 2 form) for-effect)) + (byte-compile-form (nth 2 form) byte-compile--for-effect)) (byte-compile-out-tag donetag)) (let ((elsetag (byte-compile-make-tag))) (byte-compile-goto 'byte-goto-if-nil elsetag) (byte-compile-maybe-guarded clause - (byte-compile-form (nth 2 form) for-effect)) + (byte-compile-form (nth 2 form) byte-compile--for-effect)) (byte-compile-goto 'byte-goto donetag) (byte-compile-out-tag elsetag) (byte-compile-maybe-guarded (list 'not clause) - (byte-compile-body (cdr (cdr (cdr form))) for-effect)) + (byte-compile-body (cdr (cdr (cdr form))) byte-compile--for-effect)) (byte-compile-out-tag donetag)))) - (setq for-effect nil)) + (setq byte-compile--for-effect nil)) (defun byte-compile-cond (clauses) (let ((donetag (byte-compile-make-tag)) @@ -3783,18 +3799,18 @@ that suppresses all warnings during execution of BODY." (byte-compile-form (car clause)) (if (null (cdr clause)) ;; First clause is a singleton. - (byte-compile-goto-if t for-effect donetag) + (byte-compile-goto-if t byte-compile--for-effect donetag) (setq nexttag (byte-compile-make-tag)) (byte-compile-goto 'byte-goto-if-nil nexttag) (byte-compile-maybe-guarded (car clause) - (byte-compile-body (cdr clause) for-effect)) + (byte-compile-body (cdr clause) byte-compile--for-effect)) (byte-compile-goto 'byte-goto donetag) (byte-compile-out-tag nexttag))))) ;; Last clause (let ((guard (car clause))) (and (cdr clause) (not (eq guard t)) (progn (byte-compile-form guard) - (byte-compile-goto-if nil for-effect donetag) + (byte-compile-goto-if nil byte-compile--for-effect donetag) (setq clause (cdr clause)))) (byte-compile-maybe-guarded guard (byte-compile-body-do-effect clause))) @@ -3813,7 +3829,7 @@ that suppresses all warnings during execution of BODY." (if (cdr rest) (progn (byte-compile-form (car rest)) - (byte-compile-goto-if nil for-effect failtag) + (byte-compile-goto-if nil byte-compile--for-effect failtag) (byte-compile-maybe-guarded (car rest) (byte-compile-and-recursion (cdr rest) failtag))) (byte-compile-form-do-effect (car rest)) @@ -3832,7 +3848,7 @@ that suppresses all warnings during execution of BODY." (if (cdr rest) (progn (byte-compile-form (car rest)) - (byte-compile-goto-if t for-effect wintag) + (byte-compile-goto-if t byte-compile--for-effect wintag) (byte-compile-maybe-guarded (list 'not (car rest)) (byte-compile-or-recursion (cdr rest) wintag))) (byte-compile-form-do-effect (car rest)) @@ -3843,11 +3859,11 @@ that suppresses all warnings during execution of BODY." (looptag (byte-compile-make-tag))) (byte-compile-out-tag looptag) (byte-compile-form (car (cdr form))) - (byte-compile-goto-if nil for-effect endtag) + (byte-compile-goto-if nil byte-compile--for-effect endtag) (byte-compile-body (cdr (cdr form)) t) (byte-compile-goto 'byte-goto looptag) (byte-compile-out-tag endtag) - (setq for-effect nil))) + (setq byte-compile--for-effect nil))) (defun byte-compile-funcall (form) (mapc 'byte-compile-form (cdr form)) @@ -4008,7 +4024,7 @@ binding slots have been popped." (byte-compile-form `(list 'funcall ,f))) (body (byte-compile-push-constant - (byte-compile-top-level (cons 'progn body) for-effect)))) + (byte-compile-top-level (cons 'progn body) byte-compile--for-effect)))) (byte-compile-out 'byte-catch 0)) (defun byte-compile-unwind-protect (form) @@ -4044,7 +4060,7 @@ binding slots have been popped." (if fun-bodies (byte-compile-form `(list 'funcall ,(nth 2 form))) (byte-compile-push-constant - (byte-compile-top-level (nth 2 form) for-effect))) + (byte-compile-top-level (nth 2 form) byte-compile--for-effect))) (let ((compiled-clauses (mapcar (lambda (clause) @@ -4072,7 +4088,7 @@ binding slots have been popped." `(list ',condition (list 'funcall ,(cadr clause) ',var)) (cons condition (byte-compile-top-level-body - (cdr clause) for-effect))))) + (cdr clause) byte-compile--for-effect))))) (cdr (cdr (cdr form)))))) (if fun-bodies (byte-compile-form `(list ,@compiled-clauses)) @@ -4113,7 +4129,7 @@ binding slots have been popped." (byte-compile-set-symbol-position (car form)) (byte-compile-set-symbol-position 'defun) (error "defun name must be a symbol, not %s" (car form))) - (let ((for-effect nil)) + (let ((byte-compile--for-effect nil)) (byte-compile-push-constant 'defalias) (byte-compile-push-constant (nth 1 form)) (byte-compile-closure (cdr (cdr form)) t)) @@ -4410,22 +4426,22 @@ invoked interactively." (if byte-compile-call-tree-sort (setq byte-compile-call-tree (sort byte-compile-call-tree - (cond ((eq byte-compile-call-tree-sort 'callers) - (function (lambda (x y) (< (length (nth 1 x)) - (length (nth 1 y)))))) - ((eq byte-compile-call-tree-sort 'calls) - (function (lambda (x y) (< (length (nth 2 x)) - (length (nth 2 y)))))) - ((eq byte-compile-call-tree-sort 'calls+callers) - (function (lambda (x y) (< (+ (length (nth 1 x)) - (length (nth 2 x))) - (+ (length (nth 1 y)) - (length (nth 2 y))))))) - ((eq byte-compile-call-tree-sort 'name) - (function (lambda (x y) (string< (car x) - (car y))))) - (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" - byte-compile-call-tree-sort)))))) + (case byte-compile-call-tree-sort + (callers + (lambda (x y) (< (length (nth 1 x)) + (length (nth 1 y))))) + (calls + (lambda (x y) (< (length (nth 2 x)) + (length (nth 2 y))))) + (calls+callers + (lambda (x y) (< (+ (length (nth 1 x)) + (length (nth 2 x))) + (+ (length (nth 1 y)) + (length (nth 2 y)))))) + (name + (lambda (x y) (string< (car x) (car y)))) + (t (error "`byte-compile-call-tree-sort': `%s' - unknown sort mode" + byte-compile-call-tree-sort)))))) (message "Generating call tree...") (let ((rest byte-compile-call-tree) (b (current-buffer)) @@ -4533,7 +4549,8 @@ Each file is processed even if an error occurred previously. For example, invoke \"emacs -batch -f batch-byte-compile $emacs/ ~/*.el\". If NOFORCE is non-nil, don't recompile a file that seems to be already up-to-date." - ;; command-line-args-left is what is left of the command line (from startup.el) + ;; command-line-args-left is what is left of the command line, from + ;; startup.el. (defvar command-line-args-left) ;Avoid 'free variable' warning (if (not noninteractive) (error "`batch-byte-compile' is to be used only with -batch")) @@ -4558,7 +4575,8 @@ already up-to-date." ;; Specific file argument (if (or (not noforce) (let* ((bytecomp-source (car command-line-args-left)) - (bytecomp-dest (byte-compile-dest-file bytecomp-source))) + (bytecomp-dest (byte-compile-dest-file + bytecomp-source))) (or (not (file-exists-p bytecomp-dest)) (file-newer-than-file-p bytecomp-source bytecomp-dest)))) (if (null (batch-byte-compile-file (car command-line-args-left))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 5be84c15d89..2229be0de58 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -67,7 +67,6 @@ ;; TODO: ;; - byte-optimize-form should be applied before cconv. -;; - maybe unify byte-optimize and compiler-macros. ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. ;; - new byte codes for unwind-protect, catch, and condition-case so that diff --git a/lisp/emacs-lisp/macroexp.el b/lisp/emacs-lisp/macroexp.el index 55ca90597d1..f0a075ace37 100644 --- a/lisp/emacs-lisp/macroexp.el +++ b/lisp/emacs-lisp/macroexp.el @@ -183,7 +183,9 @@ Assumes the caller has bound `macroexpand-all-environment'." (cons (macroexpand-all-1 (list 'function f)) (macroexpand-all-forms args))))) - ;; Macro expand compiler macros. + ;; Macro expand compiler macros. This cannot be delayed to + ;; byte-optimize-form because the output of the compiler-macro can + ;; use macros. ;; FIXME: Don't depend on CL. (`(,(pred (lambda (fun) (and (symbolp fun) @@ -191,7 +193,7 @@ Assumes the caller has bound `macroexpand-all-environment'." 'cl-byte-compile-compiler-macro) (functionp 'compiler-macroexpand)))) . ,_) - (let ((newform (compiler-macroexpand form))) + (let ((newform (with-no-warnings (compiler-macroexpand form)))) (if (eq form newform) (macroexpand-all-forms form 1) (macroexpand-all-1 newform)))) diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 0e3d54408fd..088410172e6 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -66,6 +66,15 @@ AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \ $(lisp)/cedet/semantic/loaddefs.el $(lisp)/cedet/ede/loaddefs.el \ $(lisp)/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 = 1200 +BIG_STACK_OPTS = --eval "(setq max-lisp-eval-depth $(BIG_STACK_DEPTH))" + +BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) + # Files to compile before others during a bootstrap. This is done to # speed up the bootstrap process. The CC files are compiled first # because CC mode tweaks the compilation process, and requiring @@ -75,6 +84,9 @@ AUTOGENEL = $(lisp)/loaddefs.el $(LOADDEFS) $(lisp)/cus-load.el \ COMPILE_FIRST = \ $(lisp)/emacs-lisp/byte-opt.el \ $(lisp)/emacs-lisp/bytecomp.el \ + $(lisp)/emacs-lisp/pcase.elc \ + $(lisp)/emacs-lisp/macroexp.elc \ + $(lisp)/emacs-lisp/cconv.elc \ $(lisp)/subr.el \ $(lisp)/progmodes/cc-mode.el \ $(lisp)/progmodes/cc-vars.el @@ -287,7 +299,7 @@ TAGS-LISP-CMD: $(lisptagsfiles1) $(lisptagsfiles2) $(lisptagsfiles3) $(lisptagsf .SUFFIXES: .elc .el .el.elc: - -$(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $< + -$(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $< # Compile all Lisp files, but don't recompile those that are up to # date. Some files don't actually get compiled because they set the @@ -307,22 +319,22 @@ compile: $(lisp)/subdirs.el mh-autoloads compile-$(SHELLTYPE) doit compile-CMD: # -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g for %%f in ($(COMPILE_FIRST)) do \ - $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done %%f + $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do \ - $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g + $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done %%f/%%g compile-SH: # for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done for el in $(COMPILE_FIRST); do \ echo Compiling $$el; \ - $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done $$el; \ + $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \ done for dir in $(lisp) $(WINS); do \ for el in $$dir/*.el; do \ if test -f $$el; \ then \ echo Compiling $$el; \ - $(emacs) -l loaddefs $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile-if-not-done $$el; \ + $(emacs) -l loaddefs $(BYTE_COMPILE_FLAGS) -f batch-byte-compile-if-not-done $$el; \ fi \ done; \ done @@ -335,31 +347,31 @@ compile-always: $(lisp)/subdirs.el compile-always-$(SHELLTYPE) doit compile-always-CMD: # -for %%f in ($(lisp) $(WINS)) do for %%g in (%%f\*.elc) do @attrib -r %%g - for %%f in ($(COMPILE_FIRST)) do $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile %%f - for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile %%f/%%g + for %%f in ($(COMPILE_FIRST)) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f + for %%f in (. $(WINS)) do for %%g in (%%f/*.el) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f/%%g compile-always-SH: # for elc in $(lisp)/*.elc $(lisp)/*/*.elc; do attrib -r $$elc; done for el in $(COMPILE_FIRST); do \ echo Compiling $$el; \ - $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \ + $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \ done for dir in $(lisp) $(WINS); do \ for el in $$dir/*.el; do \ echo Compiling $$el; \ - $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \ + $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \ done; \ done compile-calc: compile-calc-$(SHELLTYPE) compile-calc-CMD: - for %%f in ($(lisp)/calc/*.el) do $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile %%f + for %%f in ($(lisp)/calc/*.el) do $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile %%f compile-calc-SH: for el in $(lisp)/calc/*.el; do \ echo Compiling $$el; \ - $(emacs) $(BYTE_COMPILE_EXTRA_FLAGS) -f batch-byte-compile $$el || exit 1; \ + $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \ done # Backup compiled Lisp files in elc.tar.gz. If that file already diff --git a/lisp/simple.el b/lisp/simple.el index f84812570bf..7a191f0cc9a 100644 --- a/lisp/simple.el +++ b/lisp/simple.el @@ -28,8 +28,7 @@ ;;; Code: -;; This is for lexical-let in apply-partially. -(eval-when-compile (require 'cl)) +(eval-when-compile (require 'cl)) ;For define-minor-mode. (declare-function widget-convert "wid-edit" (type &rest args)) (declare-function shell-mode "shell" ()) @@ -6605,38 +6604,25 @@ saving the value of `buffer-invisibility-spec' and setting it to nil." buffer-invisibility-spec) (setq buffer-invisibility-spec nil))) -;; Partial application of functions (similar to "currying"). -;; This function is here rather than in subr.el because it uses CL. -;; (defalias 'apply-partially #'curry) -(defun apply-partially (fun &rest args) - "Return a function that is a partial application of FUN to ARGS. -ARGS is a list of the first N arguments to pass to FUN. -The result is a new function which does the same as FUN, except that -the first N arguments are fixed at the values with which this function -was called." - (lexical-let ((fun fun) (args1 args)) - (lambda (&rest args2) (apply fun (append args1 args2))))) - ;; Minibuffer prompt stuff. -;(defun minibuffer-prompt-modification (start end) -; (error "You cannot modify the prompt")) -; -; -;(defun minibuffer-prompt-insertion (start end) -; (let ((inhibit-modification-hooks t)) -; (delete-region start end) -; ;; Discard undo information for the text insertion itself -; ;; and for the text deletion.above. -; (when (consp buffer-undo-list) -; (setq buffer-undo-list (cddr buffer-undo-list))) -; (message "You cannot modify the prompt"))) -; -; -;(setq minibuffer-prompt-properties -; (list 'modification-hooks '(minibuffer-prompt-modification) -; 'insert-in-front-hooks '(minibuffer-prompt-insertion))) -; +;;(defun minibuffer-prompt-modification (start end) +;; (error "You cannot modify the prompt")) +;; +;; +;;(defun minibuffer-prompt-insertion (start end) +;; (let ((inhibit-modification-hooks t)) +;; (delete-region start end) +;; ;; Discard undo information for the text insertion itself +;; ;; and for the text deletion.above. +;; (when (consp buffer-undo-list) +;; (setq buffer-undo-list (cddr buffer-undo-list))) +;; (message "You cannot modify the prompt"))) +;; +;; +;;(setq minibuffer-prompt-properties +;; (list 'modification-hooks '(minibuffer-prompt-modification) +;; 'insert-in-front-hooks '(minibuffer-prompt-insertion))) ;;;; Problematic external packages. diff --git a/lisp/subr.el b/lisp/subr.el index b6f095136ff..5faaa2130a2 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -116,6 +116,17 @@ BODY should be a list of Lisp expressions. ;; depend on backquote.el. (list 'function (cons 'lambda cdr))) +;; Partial application of functions (similar to "currying"). +;; This function is here rather than in subr.el because it uses CL. +(defun apply-partially (fun &rest args) + "Return a function that is a partial application of FUN to ARGS. +ARGS is a list of the first N arguments to pass to FUN. +The result is a new function which does the same as FUN, except that +the first N arguments are fixed at the values with which this function +was called." + `(closure () lambda (&rest args) + (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) + (if (null (featurep 'cl)) (progn ;; If we reload subr.el after having loaded CL, be careful not to @@ -1675,6 +1686,8 @@ This function makes or adds to an entry on `after-load-alist'." (unless elt (setq elt (list regexp-or-feature)) (push elt after-load-alist)) + ;; Make sure `form' is evalled in the current lexical/dynamic code. + (setq form `(funcall ',(eval `(lambda () ,form) lexical-binding))) (when (symbolp regexp-or-feature) ;; For features, the after-load-alist elements get run when `provide' is ;; called rather than at the end of the file. So add an indirection to From 23aba0ea0e4922cfd8534f43667d3a758f2d2974 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sun, 13 Mar 2011 18:31:49 -0400 Subject: [PATCH 32/45] * src/eval.c (Ffunction): Use simpler format for closures. (Fcommandp, funcall_lambda): * src/doc.c (Fdocumentation, store_function_docstring): * src/data.c (Finteractive_form): * lisp/help-fns.el (help-function-arglist): * lisp/emacs-lisp/bytecomp.el (byte-compile-arglist-warn): * lisp/subr.el (apply-partially): Adjust to new closure format. * lisp/emacs-lisp/disass.el (disassemble-internal): Catch closures. --- lisp/ChangeLog | 7 +++++++ lisp/emacs-lisp/bytecomp.el | 2 +- lisp/emacs-lisp/disass.el | 3 +-- lisp/help-fns.el | 3 +-- lisp/subr.el | 2 +- src/ChangeLog | 7 +++++++ src/data.c | 4 ++-- src/doc.c | 8 +++----- src/eval.c | 9 +++++---- 9 files changed, 28 insertions(+), 17 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 01571b80124..3b93d4ecee7 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2011-03-13 Stefan Monnier + + * help-fns.el (help-function-arglist): + * emacs-lisp/bytecomp.el (byte-compile-arglist-warn): + * subr.el (apply-partially): Adjust to new format. + * emacs-lisp/disass.el (disassemble-internal): Catch closures. + 2011-03-12 Stefan Monnier * subr.el (apply-partially): Move from subr.el; don't use lexical-let. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 729d91eb1c5..69733ed2e8e 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1345,7 +1345,7 @@ extra args." (let ((sig1 (byte-compile-arglist-signature (pcase old (`(lambda ,args . ,_) args) - (`(closure ,_ ,_ ,args . ,_) args) + (`(closure ,_ ,args . ,_) args) ((pred byte-code-function-p) (aref old 0)) (t '(&rest def))))) (sig2 (byte-compile-arglist-signature (nth 2 form)))) diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 9ee02a98e5e..9318876fe61 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -86,8 +86,7 @@ redefine OBJECT if it is a symbol." (setq macro t obj (cdr obj))) (when (and (listp obj) (eq (car obj) 'closure)) - (setq lexical-binding t) - (setq obj (cddr obj))) + (error "Don't know how to compile an interpreted closure")) (if (and (listp obj) (eq (car obj) 'byte-code)) (setq obj (list 'lambda nil obj))) (if (and (listp obj) (not (eq (car obj) 'lambda))) diff --git a/lisp/help-fns.el b/lisp/help-fns.el index f81505c1cf1..8209cdebd3c 100644 --- a/lisp/help-fns.el +++ b/lisp/help-fns.el @@ -104,8 +104,6 @@ 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 ((and (byte-code-function-p def) (integerp (aref def 0))) (let* ((args-desc (aref def 0)) @@ -124,6 +122,7 @@ ARGLIST can also be t or a string of the form \"(FUN ARG1 ARG2 ...)\"." (nreverse arglist))) ((byte-code-function-p def) (aref def 0)) ((eq (car-safe def) 'lambda) (nth 1 def)) + ((eq (car-safe def) 'closure) (nth 2 def)) ((subrp def) (let ((arity (subr-arity def)) (arglist ())) diff --git a/lisp/subr.el b/lisp/subr.el index 5faaa2130a2..3a32a2f6558 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -124,7 +124,7 @@ ARGS is a list of the first N arguments to pass to FUN. The result is a new function which does the same as FUN, except that the first N arguments are fixed at the values with which this function was called." - `(closure () lambda (&rest args) + `(closure () (&rest args) (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) (if (null (featurep 'cl)) diff --git a/src/ChangeLog b/src/ChangeLog index bbf7f99bb32..00d8e4b8ee3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,10 @@ +2011-03-13 Stefan Monnier + + * eval.c (Ffunction): Use simpler format for closures. + (Fcommandp, funcall_lambda): + * doc.c (Fdocumentation, store_function_docstring): + * data.c (Finteractive_form): Adjust to new closure format. + 2011-03-11 Stefan Monnier * eval.c (Fprog1, Fprog2): Simplify and use XCDR/XCAR. diff --git a/src/data.c b/src/data.c index 186e9cb9859..6039743b1d5 100644 --- a/src/data.c +++ b/src/data.c @@ -746,8 +746,8 @@ Value, if non-nil, is a list \(interactive SPEC). */) { Lisp_Object funcar = XCAR (fun); if (EQ (funcar, Qclosure)) - fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); - if (EQ (funcar, Qlambda)) + return Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun)))); + else if (EQ (funcar, Qlambda)) return Fassq (Qinteractive, Fcdr (XCDR (fun))); else if (EQ (funcar, Qautoload)) { diff --git a/src/doc.c b/src/doc.c index de20edb2d98..b56464e7219 100644 --- a/src/doc.c +++ b/src/doc.c @@ -369,6 +369,7 @@ string is passed through `substitute-command-keys'. */) else if (EQ (funcar, Qkeymap)) return build_string ("Prefix command (definition is a keymap associating keystrokes with commands)."); else if (EQ (funcar, Qlambda) + || (EQ (funcar, Qclosure) && (fun = XCDR (fun), 1)) || EQ (funcar, Qautoload)) { Lisp_Object tem1; @@ -384,8 +385,6 @@ 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 @@ -505,7 +504,8 @@ store_function_docstring (Lisp_Object fun, EMACS_INT offset) Lisp_Object tem; tem = XCAR (fun); - if (EQ (tem, Qlambda) || EQ (tem, Qautoload)) + if (EQ (tem, Qlambda) || EQ (tem, Qautoload) + || (EQ (tem, Qclosure) && (fun = XCDR (fun), 1))) { tem = Fcdr (Fcdr (fun)); if (CONSP (tem) && INTEGERP (XCAR (tem))) @@ -513,8 +513,6 @@ store_function_docstring (Lisp_Object fun, EMACS_INT 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 36c63a5c8a7..2fb89ce404e 100644 --- a/src/eval.c +++ b/src/eval.c @@ -487,7 +487,8 @@ usage: (function ARG) */) && 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)); + return Fcons (Qclosure, Fcons (Vinternal_interpreter_environment, + XCDR (quoted))); else /* Simply quote the argument. */ return quoted; @@ -2079,8 +2080,8 @@ then strings and vectors are not accepted. */) return Qnil; funcar = XCAR (fun); if (EQ (funcar, Qclosure)) - fun = Fcdr (XCDR (fun)), funcar = Fcar (fun); - if (EQ (funcar, Qlambda)) + return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; + else if (EQ (funcar, Qlambda)) return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; else if (EQ (funcar, Qautoload)) return !NILP (Fcar (Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; @@ -3121,7 +3122,7 @@ funcall_lambda (Lisp_Object fun, int nargs, { fun = XCDR (fun); /* Drop `closure'. */ lexenv = XCAR (fun); - fun = XCDR (fun); /* Drop the lexical environment. */ + CHECK_LIST_CONS (fun, fun); } else lexenv = Qnil; From 2663659f1f1a8566cf0f602969f85965a398f618 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Mon, 14 Mar 2011 22:49:15 -0400 Subject: [PATCH 33/45] * lisp/makefile.w32-in (COMPILE_FIRST): Fix up last change. * lisp/ldefs-boot.el: Revert to upstream's version. --- lisp/ChangeLog | 5 + lisp/ldefs-boot.el | 2407 ++++++++++++++++++++++-------------------- lisp/makefile.w32-in | 6 +- 3 files changed, 1250 insertions(+), 1168 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 3b93d4ecee7..34951ff37bb 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-03-15 Stefan Monnier + + * makefile.w32-in (COMPILE_FIRST): Fix up last change. + * ldefs-boot.el: Revert to upstream's version. + 2011-03-13 Stefan Monnier * help-fns.el (help-function-arglist): diff --git a/lisp/ldefs-boot.el b/lisp/ldefs-boot.el index df19537688e..8bb01f2c793 100644 --- a/lisp/ldefs-boot.el +++ b/lisp/ldefs-boot.el @@ -5,7 +5,7 @@ ;;;### (autoloads (5x5-crack 5x5-crack-xor-mutate 5x5-crack-mutating-best ;;;;;; 5x5-crack-mutating-current 5x5-crack-randomly 5x5) "5x5" -;;;;;; "play/5x5.el" (19640 47194)) +;;;;;; "play/5x5.el" (19775 2029)) ;;; Generated autoloads from play/5x5.el (autoload '5x5 "5x5" "\ @@ -65,7 +65,7 @@ should return a grid vector array that is the new solution. ;;;*** ;;;### (autoloads (list-one-abbrev-table) "abbrevlist" "abbrevlist.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2027)) ;;; Generated autoloads from abbrevlist.el (autoload 'list-one-abbrev-table "abbrevlist" "\ @@ -76,7 +76,7 @@ Display alphabetical listing of ABBREV-TABLE in buffer OUTPUT-BUFFER. ;;;*** ;;;### (autoloads (ada-mode ada-add-extensions) "ada-mode" "progmodes/ada-mode.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/ada-mode.el (autoload 'ada-add-extensions "ada-mode" "\ @@ -96,7 +96,7 @@ Ada mode is the major mode for editing Ada code. ;;;*** ;;;### (autoloads (ada-header) "ada-stmt" "progmodes/ada-stmt.el" -;;;;;; (19598 13691)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/ada-stmt.el (autoload 'ada-header "ada-stmt" "\ @@ -107,7 +107,7 @@ Insert a descriptive header at the top of the file. ;;;*** ;;;### (autoloads (ada-find-file) "ada-xref" "progmodes/ada-xref.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/ada-xref.el (autoload 'ada-find-file "ada-xref" "\ @@ -122,7 +122,7 @@ Completion is available. ;;;;;; add-change-log-entry-other-window add-change-log-entry find-change-log ;;;;;; prompt-for-change-log-name add-log-mailing-address add-log-full-name ;;;;;; add-log-current-defun-function) "add-log" "vc/add-log.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2030)) ;;; Generated autoloads from vc/add-log.el (put 'change-log-default-name 'safe-local-variable 'string-or-null-p) @@ -261,7 +261,7 @@ old-style time formats for entries are supported. ;;;### (autoloads (defadvice ad-activate ad-add-advice ad-disable-advice ;;;;;; ad-enable-advice ad-default-compilation-action ad-redefinition-action) -;;;;;; "advice" "emacs-lisp/advice.el" (19598 13691)) +;;;;;; "advice" "emacs-lisp/advice.el" (19780 4513)) ;;; Generated autoloads from emacs-lisp/advice.el (defvar ad-redefinition-action 'warn "\ @@ -406,7 +406,7 @@ usage: (defadvice FUNCTION (CLASS NAME [POSITION] [ARGLIST] FLAG...) ;;;### (autoloads (align-newline-and-indent align-unhighlight-rule ;;;;;; align-highlight-rule align-current align-entire align-regexp -;;;;;; align) "align" "align.el" (19598 13691)) +;;;;;; align) "align" "align.el" (19775 2027)) ;;; Generated autoloads from align.el (autoload 'align "align" "\ @@ -496,7 +496,7 @@ A replacement function for `newline-and-indent', aligning as it goes. ;;;*** ;;;### (autoloads (outlineify-sticky allout-mode) "allout" "allout.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2027)) ;;; Generated autoloads from allout.el (put 'allout-use-hanging-indents 'safe-local-variable (if (fboundp 'booleanp) 'booleanp '(lambda (x) (member x '(t nil))))) @@ -533,18 +533,16 @@ A replacement function for `newline-and-indent', aligning as it goes. (autoload 'allout-mode "allout" "\ Toggle minor mode for controlling exposure and editing of text outlines. -\\ +\\ -Optional prefix argument TOGGLE forces the mode to re-initialize -if it is positive, otherwise it turns the mode off. Allout -outline mode always runs as a minor mode. +Allout outline mode always runs as a minor mode. -Allout outline mode provides extensive outline oriented formatting and -manipulation. It enables structural editing of outlines, as well as -navigation and exposure. It also is specifically aimed at -accommodating syntax-sensitive text like programming languages. (For -an example, see the allout code itself, which is organized as an allout -outline.) +Allout outline mode provides extensive outline oriented +formatting and manipulation. It enables structural editing of +outlines, as well as navigation and exposure. It also is +specifically aimed at accommodating syntax-sensitive text like +programming languages. (For example, see the allout code itself, +which is organized as an allout outline.) In addition to typical outline navigation and exposure, allout includes: @@ -552,27 +550,30 @@ In addition to typical outline navigation and exposure, allout includes: repositioning, promotion/demotion, cut, and paste - incremental search with dynamic exposure and reconcealment of hidden text - adjustable format, so programming code can be developed in outline-structure - - easy topic encryption and decryption + - easy topic encryption and decryption, symmetric or key-pair - \"Hot-spot\" operation, for single-keystroke maneuvering and exposure control - integral outline layout, for automatic initial exposure when visiting a file - independent extensibility, using comprehensive exposure and authoring hooks and many other features. -Below is a description of the key bindings, and then explanation of -special `allout-mode' features and terminology. See also the outline -menubar additions for quick reference to many of the features, and see -the docstring of the function `allout-init' for instructions on -priming your emacs session for automatic activation of `allout-mode'. +Below is a description of the key bindings, and then description +of special `allout-mode' features and terminology. See also the +outline menubar additions for quick reference to many of the +features, and see the docstring of the function `allout-init' for +instructions on priming your emacs session for automatic +activation of `allout-mode'. -The bindings are dictated by the customizable `allout-keybindings-list' -variable. We recommend customizing `allout-command-prefix' to use just -`\\C-c' as the command prefix, if the allout bindings don't conflict with -any personal bindings you have on \\C-c. In any case, outline structure -navigation and authoring is simplified by positioning the cursor on an -item's bullet character, the \"hot-spot\" -- then you can invoke allout -commands with just the un-prefixed, un-control-shifted command letters. -This is described further in the HOT-SPOT Operation section. +The bindings are those listed in `allout-prefixed-keybindings' +and `allout-unprefixed-keybindings'. We recommend customizing +`allout-command-prefix' to use just `\\C-c' as the command +prefix, if the allout bindings don't conflict with any personal +bindings you have on \\C-c. In any case, outline structure +navigation and authoring is simplified by positioning the cursor +on an item's bullet character, the \"hot-spot\" -- then you can +invoke allout commands with just the un-prefixed, +un-control-shifted command letters. This is described further in +the HOT-SPOT Operation section. Exposure Control: ---------------- @@ -651,19 +652,22 @@ M-x outlineify-sticky Activate outline mode for current buffer, Topic Encryption Outline mode supports gpg encryption of topics, with support for -symmetric and key-pair modes, passphrase timeout, passphrase -consistency checking, user-provided hinting for symmetric key -mode, and auto-encryption of topics pending encryption on save. +symmetric and key-pair modes, and auto-encryption of topics +pending encryption on save. Topics pending encryption are, by default, automatically -encrypted during file saves. If the contents of the topic -containing the cursor was encrypted for a save, it is -automatically decrypted for continued editing. +encrypted during file saves, including checkpoint saves, to avoid +exposing the plain text of encrypted topics in the file system. +If the content of the topic containing the cursor was encrypted +for a save, it is automatically decrypted for continued editing. -The aim of these measures is reliable topic privacy while -preventing accidents like neglected encryption before saves, -forgetting which passphrase was used, and other practical -pitfalls. +NOTE: A few GnuPG v2 versions improperly preserve incorrect +symmetric decryption keys, preventing entry of the correct key on +subsequent decryption attempts until the cache times-out. That +can take several minutes. (Decryption of other entries is not +affected.) Upgrade your EasyPG version, if you can, and you can +deliberately clear your gpg-agent's cache by sending it a '-HUP' +signal. See `allout-toggle-current-subtree-encryption' function docstring and `allout-encrypt-unencrypted-on-saves' customization variable @@ -701,7 +705,8 @@ hooks, by which independent code can cooperate with allout without changes to the allout core. Here are key ones: `allout-mode-hook' -`allout-mode-deactivate-hook' +`allout-mode-deactivate-hook' (deprecated) +`allout-mode-off-hook' `allout-exposure-change-hook' `allout-structure-added-hook' `allout-structure-deleted-hook' @@ -788,7 +793,7 @@ CONCEALED: CLOSED: A TOPIC whose immediate OFFSPRING and body-text is CONCEALED. OPEN: A TOPIC that is not CLOSED, though its OFFSPRING or BODY may be. -\(fn &optional TOGGLE)" t nil) +\(fn &optional ARG)" t nil) (defalias 'outlinify-sticky 'outlineify-sticky) @@ -803,7 +808,7 @@ setup for auto-startup. ;;;*** ;;;### (autoloads (ange-ftp-hook-function ange-ftp-reread-dir) "ange-ftp" -;;;;;; "net/ange-ftp.el" (19714 43298)) +;;;;;; "net/ange-ftp.el" (19780 4514)) ;;; Generated autoloads from net/ange-ftp.el (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir) @@ -825,7 +830,7 @@ Not documented ;;;*** ;;;### (autoloads (animate-birthday-present animate-sequence animate-string) -;;;;;; "animate" "play/animate.el" (19562 42953)) +;;;;;; "animate" "play/animate.el" (19775 2029)) ;;; Generated autoloads from play/animate.el (autoload 'animate-string "animate" "\ @@ -853,7 +858,7 @@ You can specify the one's name by NAME; the default value is \"Sarah\". ;;;*** ;;;### (autoloads (ansi-color-process-output ansi-color-for-comint-mode-on) -;;;;;; "ansi-color" "ansi-color.el" (19714 43298)) +;;;;;; "ansi-color" "ansi-color.el" (19775 2027)) ;;; Generated autoloads from ansi-color.el (autoload 'ansi-color-for-comint-mode-on "ansi-color" "\ @@ -879,7 +884,7 @@ This is a good function to put in `comint-output-filter-functions'. ;;;*** ;;;### (autoloads (antlr-set-tabs antlr-mode antlr-show-makefile-rules) -;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (19714 43298)) +;;;;;; "antlr-mode" "progmodes/antlr-mode.el" (19775 2029)) ;;; Generated autoloads from progmodes/antlr-mode.el (autoload 'antlr-show-makefile-rules "antlr-mode" "\ @@ -915,7 +920,7 @@ Used in `antlr-mode'. Also a useful function in `java-mode-hook'. ;;;*** ;;;### (autoloads (appt-activate appt-add) "appt" "calendar/appt.el" -;;;;;; (19640 47194)) +;;;;;; (19780 4513)) ;;; Generated autoloads from calendar/appt.el (autoload 'appt-add "appt" "\ @@ -938,7 +943,7 @@ ARG is positive, otherwise off. ;;;### (autoloads (apropos-documentation apropos-value apropos-library ;;;;;; apropos apropos-documentation-property apropos-command apropos-variable -;;;;;; apropos-read-pattern) "apropos" "apropos.el" (19598 13691)) +;;;;;; apropos-read-pattern) "apropos" "apropos.el" (19775 2027)) ;;; Generated autoloads from apropos.el (autoload 'apropos-read-pattern "apropos" "\ @@ -1041,8 +1046,8 @@ Returns list of symbols and documentation found. ;;;*** -;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (archive-mode) "arc-mode" "arc-mode.el" (19775 +;;;;;; 2027)) ;;; Generated autoloads from arc-mode.el (autoload 'archive-mode "arc-mode" "\ @@ -1062,7 +1067,7 @@ archive. ;;;*** -;;;### (autoloads (array-mode) "array" "array.el" (19714 43298)) +;;;### (autoloads (array-mode) "array" "array.el" (19775 2027)) ;;; Generated autoloads from array.el (autoload 'array-mode "array" "\ @@ -1133,8 +1138,8 @@ Entering array mode calls the function `array-mode-hook'. ;;;*** -;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (19640 -;;;;;; 47194)) +;;;### (autoloads (artist-mode) "artist" "textmodes/artist.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from textmodes/artist.el (autoload 'artist-mode "artist" "\ @@ -1340,8 +1345,8 @@ Keymap summary ;;;*** -;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (asm-mode) "asm-mode" "progmodes/asm-mode.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from progmodes/asm-mode.el (autoload 'asm-mode "asm-mode" "\ @@ -1369,7 +1374,7 @@ Special commands: ;;;*** ;;;### (autoloads (autoarg-kp-mode autoarg-mode) "autoarg" "autoarg.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2027)) ;;; Generated autoloads from autoarg.el (defvar autoarg-mode nil "\ @@ -1423,7 +1428,7 @@ etc. to supply digit arguments. ;;;*** ;;;### (autoloads (autoconf-mode) "autoconf" "progmodes/autoconf.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/autoconf.el (autoload 'autoconf-mode "autoconf" "\ @@ -1434,7 +1439,7 @@ Major mode for editing Autoconf configure.in files. ;;;*** ;;;### (autoloads (auto-insert-mode define-auto-insert auto-insert) -;;;;;; "autoinsert" "autoinsert.el" (19591 62571)) +;;;;;; "autoinsert" "autoinsert.el" (19780 4512)) ;;; Generated autoloads from autoinsert.el (autoload 'auto-insert "autoinsert" "\ @@ -1473,7 +1478,7 @@ insert a template for the file depending on the mode of the buffer. ;;;### (autoloads (batch-update-autoloads update-directory-autoloads ;;;;;; update-file-autoloads) "autoload" "emacs-lisp/autoload.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4513)) ;;; Generated autoloads from emacs-lisp/autoload.el (put 'generated-autoload-file 'safe-local-variable 'stringp) @@ -1512,7 +1517,7 @@ Calls `update-directory-autoloads' on the command line arguments. ;;;### (autoloads (global-auto-revert-mode turn-on-auto-revert-tail-mode ;;;;;; auto-revert-tail-mode turn-on-auto-revert-mode auto-revert-mode) -;;;;;; "autorevert" "autorevert.el" (19562 42953)) +;;;;;; "autorevert" "autorevert.el" (19775 2027)) ;;; Generated autoloads from autorevert.el (autoload 'auto-revert-mode "autorevert" "\ @@ -1593,7 +1598,7 @@ specifies in the mode line. ;;;*** ;;;### (autoloads (mouse-avoidance-mode mouse-avoidance-mode) "avoid" -;;;;;; "avoid.el" (19714 43298)) +;;;;;; "avoid.el" (19775 2027)) ;;; Generated autoloads from avoid.el (defvar mouse-avoidance-mode nil "\ @@ -1634,7 +1639,7 @@ definition of \"random distance\".) ;;;*** ;;;### (autoloads (display-battery-mode battery) "battery" "battery.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2027)) ;;; Generated autoloads from battery.el (put 'battery-mode-line-string 'risky-local-variable t) @@ -1666,7 +1671,7 @@ seconds. ;;;*** ;;;### (autoloads (benchmark benchmark-run-compiled benchmark-run) -;;;;;; "benchmark" "emacs-lisp/benchmark.el" (19562 42953)) +;;;;;; "benchmark" "emacs-lisp/benchmark.el" (19780 4513)) ;;; Generated autoloads from emacs-lisp/benchmark.el (autoload 'benchmark-run "benchmark" "\ @@ -1699,7 +1704,7 @@ For non-interactive use see also `benchmark-run' and ;;;*** ;;;### (autoloads (bibtex-search-entry bibtex-mode bibtex-initialize) -;;;;;; "bibtex" "textmodes/bibtex.el" (19714 43298)) +;;;;;; "bibtex" "textmodes/bibtex.el" (19780 4514)) ;;; Generated autoloads from textmodes/bibtex.el (autoload 'bibtex-initialize "bibtex" "\ @@ -1786,7 +1791,7 @@ mode is not `bibtex-mode', START is nil, and DISPLAY is t. ;;;*** ;;;### (autoloads (bibtex-style-mode) "bibtex-style" "textmodes/bibtex-style.el" -;;;;;; (19619 52030)) +;;;;;; (19780 4514)) ;;; Generated autoloads from textmodes/bibtex-style.el (autoload 'bibtex-style-mode "bibtex-style" "\ @@ -1798,7 +1803,7 @@ Major mode for editing BibTeX style files. ;;;### (autoloads (binhex-decode-region binhex-decode-region-external ;;;;;; binhex-decode-region-internal) "binhex" "mail/binhex.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from mail/binhex.el (defconst binhex-begin-line "^:...............................................................$") @@ -1821,8 +1826,8 @@ Binhex decode region between START and END. ;;;*** -;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (blackbox) "blackbox" "play/blackbox.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from play/blackbox.el (autoload 'blackbox "blackbox" "\ @@ -1945,7 +1950,7 @@ a reflection. ;;;;;; bookmark-save bookmark-write bookmark-delete bookmark-insert ;;;;;; bookmark-rename bookmark-insert-location bookmark-relocate ;;;;;; bookmark-jump-other-window bookmark-jump bookmark-set) "bookmark" -;;;;;; "bookmark.el" (19717 39999)) +;;;;;; "bookmark.el" (19780 4512)) ;;; Generated autoloads from bookmark.el (define-key ctl-x-r-map "b" 'bookmark-jump) (define-key ctl-x-r-map "m" 'bookmark-set) @@ -2146,7 +2151,7 @@ Incremental search of bookmarks, hiding the non-matches as we go. ;;;;;; browse-url-at-mouse browse-url-at-point browse-url browse-url-of-region ;;;;;; browse-url-of-dired-file browse-url-of-buffer browse-url-of-file ;;;;;; browse-url-browser-function) "browse-url" "net/browse-url.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from net/browse-url.el (defvar browse-url-browser-function (cond ((memq system-type '(windows-nt ms-dos cygwin)) 'browse-url-default-windows-browser) ((memq system-type '(darwin)) 'browse-url-default-macosx-browser) (t 'browse-url-default-browser)) "\ @@ -2451,8 +2456,8 @@ from `browse-url-elinks-wrapper'. ;;;*** -;;;### (autoloads (snarf-bruces bruce) "bruce" "play/bruce.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (snarf-bruces bruce) "bruce" "play/bruce.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from play/bruce.el (autoload 'bruce "bruce" "\ @@ -2468,7 +2473,7 @@ Return a vector containing the lines from `bruce-phrases-file'. ;;;*** ;;;### (autoloads (bs-show bs-customize bs-cycle-previous bs-cycle-next) -;;;;;; "bs" "bs.el" (19562 42953)) +;;;;;; "bs" "bs.el" (19775 2027)) ;;; Generated autoloads from bs.el (autoload 'bs-cycle-next "bs" "\ @@ -2508,7 +2513,7 @@ name of buffer configuration. ;;;*** -;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (19619 52030)) +;;;### (autoloads (bubbles) "bubbles" "play/bubbles.el" (19775 2029)) ;;; Generated autoloads from play/bubbles.el (autoload 'bubbles "bubbles" "\ @@ -2527,10 +2532,28 @@ columns on its right towards the left. \(fn)" t nil) +;;;*** + +;;;### (autoloads (list-buffers) "buff-menu" "buff-menu.el" (19775 +;;;;;; 2027)) +;;; Generated autoloads from buff-menu.el + +(define-key ctl-x-map "" 'list-buffers) + +(autoload 'list-buffers "buff-menu" "\ +Display a list of names of existing buffers. +The list is displayed in a buffer named `*Buffer List*'. +Note that buffers with names starting with spaces are omitted. +Non-null optional arg FILES-ONLY means mention only file buffers. + +For more information, see the function `buffer-menu'. + +\(fn &optional FILES-ONLY)" t nil) + ;;;*** ;;;### (autoloads (bug-reference-prog-mode bug-reference-mode) "bug-reference" -;;;;;; "progmodes/bug-reference.el" (19562 42953)) +;;;;;; "progmodes/bug-reference.el" (19775 2029)) ;;; Generated autoloads from progmodes/bug-reference.el (put 'bug-reference-url-format 'safe-local-variable (lambda (s) (or (stringp s) (and (symbolp s) (get s 'bug-reference-url-format))))) @@ -2551,7 +2574,7 @@ Like `bug-reference-mode', but only buttonize in comments and strings. ;;;;;; batch-byte-compile-if-not-done display-call-tree byte-compile ;;;;;; compile-defun byte-compile-file byte-recompile-directory ;;;;;; byte-force-recompile byte-compile-enable-warning byte-compile-disable-warning) -;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (19737 17936)) +;;;;;; "bytecomp" "emacs-lisp/bytecomp.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/bytecomp.el (put 'byte-compile-dynamic 'safe-local-variable 'booleanp) (put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp) @@ -2671,8 +2694,8 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (19598 -;;;;;; 13691)) +;;;### (autoloads nil "cal-china" "calendar/cal-china.el" (19775 +;;;;;; 2027)) ;;; Generated autoloads from calendar/cal-china.el (put 'calendar-chinese-time-zone 'risky-local-variable t) @@ -2681,7 +2704,7 @@ and corresponding effects. ;;;*** -;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (19598 13691)) +;;;### (autoloads nil "cal-dst" "calendar/cal-dst.el" (19775 2027)) ;;; Generated autoloads from calendar/cal-dst.el (put 'calendar-daylight-savings-starts 'risky-local-variable t) @@ -2693,7 +2716,7 @@ and corresponding effects. ;;;*** ;;;### (autoloads (calendar-hebrew-list-yahrzeits) "cal-hebrew" "calendar/cal-hebrew.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2027)) ;;; Generated autoloads from calendar/cal-hebrew.el (autoload 'calendar-hebrew-list-yahrzeits "cal-hebrew" "\ @@ -2709,8 +2732,8 @@ from the cursor position. ;;;### (autoloads (defmath calc-embedded-activate calc-embedded calc-grab-rectangle ;;;;;; calc-grab-region full-calc-keypad calc-keypad calc-eval quick-calc -;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (19591 -;;;;;; 62571)) +;;;;;; full-calc calc calc-dispatch) "calc" "calc/calc.el" (19775 +;;;;;; 2027)) ;;; Generated autoloads from calc/calc.el (define-key ctl-x-map "*" 'calc-dispatch) @@ -2794,8 +2817,19 @@ See Info node `(calc)Defining Functions'. ;;;*** -;;;### (autoloads (calculator) "calculator" "calculator.el" (19619 -;;;;;; 52030)) +;;;### (autoloads (calc-undo) "calc-undo" "calc/calc-undo.el" (19775 +;;;;;; 2027)) +;;; Generated autoloads from calc/calc-undo.el + +(autoload 'calc-undo "calc-undo" "\ +Not documented + +\(fn N)" t nil) + +;;;*** + +;;;### (autoloads (calculator) "calculator" "calculator.el" (19775 +;;;;;; 2027)) ;;; Generated autoloads from calculator.el (autoload 'calculator "calculator" "\ @@ -2806,8 +2840,8 @@ See the documentation for `calculator-mode' for more information. ;;;*** -;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (calendar) "calendar" "calendar/calendar.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from calendar/calendar.el (autoload 'calendar "calendar" "\ @@ -2851,7 +2885,7 @@ This function is suitable for execution in a .emacs file. ;;;*** ;;;### (autoloads (canlock-verify canlock-insert-header) "canlock" -;;;;;; "gnus/canlock.el" (19598 13691)) +;;;;;; "gnus/canlock.el" (19775 2028)) ;;; Generated autoloads from gnus/canlock.el (autoload 'canlock-insert-header "canlock" "\ @@ -2869,7 +2903,7 @@ it fails. ;;;*** ;;;### (autoloads (capitalized-words-mode) "cap-words" "progmodes/cap-words.el" -;;;;;; (19562 42953)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/cap-words.el (autoload 'capitalized-words-mode "cap-words" "\ @@ -2904,15 +2938,15 @@ Obsoletes `c-forward-into-nomenclature'. ;;;*** -;;;### (autoloads nil "cc-compat" "progmodes/cc-compat.el" (19598 -;;;;;; 13691)) +;;;### (autoloads nil "cc-compat" "progmodes/cc-compat.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from progmodes/cc-compat.el (put 'c-indent-level 'safe-local-variable 'integerp) ;;;*** ;;;### (autoloads (c-guess-basic-syntax) "cc-engine" "progmodes/cc-engine.el" -;;;;;; (19717 39999)) +;;;;;; (19780 45051)) ;;; Generated autoloads from progmodes/cc-engine.el (autoload 'c-guess-basic-syntax "cc-engine" "\ @@ -2924,7 +2958,7 @@ Return the syntactic context of the current line. ;;;### (autoloads (pike-mode idl-mode java-mode objc-mode c++-mode ;;;;;; c-mode c-initialize-cc-mode) "cc-mode" "progmodes/cc-mode.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/cc-mode.el (autoload 'c-initialize-cc-mode "cc-mode" "\ @@ -3084,7 +3118,7 @@ Key bindings: ;;;*** ;;;### (autoloads (c-set-offset c-add-style c-set-style) "cc-styles" -;;;;;; "progmodes/cc-styles.el" (19714 43298)) +;;;;;; "progmodes/cc-styles.el" (19780 4514)) ;;; Generated autoloads from progmodes/cc-styles.el (autoload 'c-set-style "cc-styles" "\ @@ -3135,7 +3169,7 @@ and exists only for compatibility reasons. ;;;*** -;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (19598 13691)) +;;;### (autoloads nil "cc-vars" "progmodes/cc-vars.el" (19780 4514)) ;;; Generated autoloads from progmodes/cc-vars.el (put 'c-basic-offset 'safe-local-variable 'integerp) (put 'c-backslash-column 'safe-local-variable 'integerp) @@ -3145,7 +3179,7 @@ and exists only for compatibility reasons. ;;;### (autoloads (ccl-execute-with-args check-ccl-program define-ccl-program ;;;;;; declare-ccl-program ccl-dump ccl-compile) "ccl" "international/ccl.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2028)) ;;; Generated autoloads from international/ccl.el (autoload 'ccl-compile "ccl" "\ @@ -3406,7 +3440,7 @@ See the documentation of `define-ccl-program' for the detail of CCL program. ;;;*** ;;;### (autoloads (cfengine-mode) "cfengine" "progmodes/cfengine.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/cfengine.el (autoload 'cfengine-mode "cfengine" "\ @@ -3421,7 +3455,7 @@ to the action header. ;;;*** ;;;### (autoloads (check-declare-directory check-declare-file) "check-declare" -;;;;;; "emacs-lisp/check-declare.el" (19562 42953)) +;;;;;; "emacs-lisp/check-declare.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/check-declare.el (autoload 'check-declare-file "check-declare" "\ @@ -3446,7 +3480,7 @@ Returns non-nil if any false statements are found. ;;;;;; checkdoc-comments checkdoc-continue checkdoc-start checkdoc-current-buffer ;;;;;; checkdoc-eval-current-buffer checkdoc-message-interactive ;;;;;; checkdoc-interactive checkdoc checkdoc-list-of-strings-p) -;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (19714 43298)) +;;;;;; "checkdoc" "emacs-lisp/checkdoc.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/checkdoc.el (put 'checkdoc-force-docstrings-flag 'safe-local-variable 'booleanp) (put 'checkdoc-force-history-flag 'safe-local-variable 'booleanp) @@ -3641,7 +3675,7 @@ checking of documentation strings. ;;;### (autoloads (pre-write-encode-hz post-read-decode-hz encode-hz-buffer ;;;;;; encode-hz-region decode-hz-buffer decode-hz-region) "china-util" -;;;;;; "language/china-util.el" (19562 42953)) +;;;;;; "language/china-util.el" (19780 4513)) ;;; Generated autoloads from language/china-util.el (autoload 'decode-hz-region "china-util" "\ @@ -3679,7 +3713,7 @@ Not documented ;;;*** ;;;### (autoloads (command-history list-command-history repeat-matching-complex-command) -;;;;;; "chistory" "chistory.el" (19562 42953)) +;;;;;; "chistory" "chistory.el" (19775 2027)) ;;; Generated autoloads from chistory.el (autoload 'repeat-matching-complex-command "chistory" "\ @@ -3718,7 +3752,7 @@ and runs the normal hook `command-history-hook'. ;;;*** -;;;### (autoloads nil "cl" "emacs-lisp/cl.el" (19640 47194)) +;;;### (autoloads nil "cl" "emacs-lisp/cl.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/cl.el (defvar custom-print-functions nil "\ @@ -3734,7 +3768,7 @@ a future Emacs interpreter will be able to use it.") ;;;*** ;;;### (autoloads (common-lisp-indent-function) "cl-indent" "emacs-lisp/cl-indent.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/cl-indent.el (autoload 'common-lisp-indent-function "cl-indent" "\ @@ -3813,7 +3847,7 @@ For example, the function `case' has an indent property ;;;*** ;;;### (autoloads (c-macro-expand) "cmacexp" "progmodes/cmacexp.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/cmacexp.el (autoload 'c-macro-expand "cmacexp" "\ @@ -3833,8 +3867,8 @@ For use inside Lisp programs, see also `c-macro-expansion'. ;;;*** -;;;### (autoloads (run-scheme) "cmuscheme" "cmuscheme.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (run-scheme) "cmuscheme" "cmuscheme.el" (19775 +;;;;;; 2027)) ;;; Generated autoloads from cmuscheme.el (autoload 'run-scheme "cmuscheme" "\ @@ -3858,7 +3892,7 @@ is run). ;;;### (autoloads (comint-redirect-results-list-from-process comint-redirect-results-list ;;;;;; comint-redirect-send-command-to-process comint-redirect-send-command ;;;;;; comint-run make-comint make-comint-in-buffer) "comint" "comint.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2027)) ;;; Generated autoloads from comint.el (defvar comint-output-filter-functions '(comint-postoutput-scroll-to-bottom comint-watch-for-password-prompt) "\ @@ -3953,7 +3987,7 @@ REGEXP-GROUP is the regular expression group in REGEXP to use. ;;;*** ;;;### (autoloads (compare-windows) "compare-w" "vc/compare-w.el" -;;;;;; (19562 42953)) +;;;;;; (19780 4514)) ;;; Generated autoloads from vc/compare-w.el (autoload 'compare-windows "compare-w" "\ @@ -3990,8 +4024,8 @@ on third call it again advances points to the next difference and so on. ;;;;;; compilation-shell-minor-mode compilation-mode compilation-start ;;;;;; compile compilation-disable-input compile-command compilation-search-path ;;;;;; compilation-ask-about-save compilation-window-height compilation-start-hook -;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (19714 -;;;;;; 43298)) +;;;;;; compilation-mode-hook) "compile" "progmodes/compile.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from progmodes/compile.el (defvar compilation-mode-hook nil "\ @@ -4018,9 +4052,7 @@ Number of lines in a compilation window. If nil, use Emacs default.") *Function to call to customize the compilation process. This function is called immediately before the compilation process is started. It can be used to set any variables or functions that are used -while processing the output of the compilation process. The function -is called with variables `compilation-buffer' and `compilation-window' -bound to the compilation buffer and window, respectively.") +while processing the output of the compilation process.") (defvar compilation-buffer-name-function nil "\ Function to compute the name of a compilation buffer. @@ -4167,7 +4199,7 @@ This is the value of `next-error-function' in Compilation buffers. ;;;*** ;;;### (autoloads (dynamic-completion-mode) "completion" "completion.el" -;;;;;; (19562 42953)) +;;;;;; (19780 4513)) ;;; Generated autoloads from completion.el (defvar dynamic-completion-mode nil "\ @@ -4184,12 +4216,48 @@ Enable dynamic word-completion. \(fn &optional ARG)" t nil) +;;;*** + +;;;### (autoloads (global-auto-composition-mode auto-composition-mode +;;;;;; encode-composition-rule) "composite" "composite.el" (19760 +;;;;;; 54262)) +;;; Generated autoloads from composite.el + +(autoload 'encode-composition-rule "composite" "\ +Encode composition rule RULE into an integer value. +RULE is a cons of global and new reference point symbols +\(see `reference-point-alist'). + +\(fn RULE)" nil nil) + +(autoload 'auto-composition-mode "composite" "\ +Toggle Auto Composition mode. +With ARG, turn Auto Composition mode off if and only if ARG is a non-positive +number; if ARG is nil, toggle Auto Composition mode; anything else turns Auto +Composition on. + +When Auto Composition is enabled, text characters are automatically composed +by functions registered in `composition-function-table' (which see). + +You can use `global-auto-composition-mode' to turn on +Auto Composition mode in all buffers (this is the default). + +\(fn &optional ARG)" t nil) + +(autoload 'global-auto-composition-mode "composite" "\ +Toggle Auto-Composition mode in every possible buffer. +With prefix arg, turn Global-Auto-Composition mode on if and only if arg +is positive. +See `auto-composition-mode' for more information on Auto-Composition mode. + +\(fn &optional ARG)" t nil) + ;;;*** ;;;### (autoloads (conf-xdefaults-mode conf-ppd-mode conf-colon-mode ;;;;;; conf-space-keywords conf-space-mode conf-javaprop-mode conf-windows-mode ;;;;;; conf-unix-mode conf-mode) "conf-mode" "textmodes/conf-mode.el" -;;;;;; (19562 42953)) +;;;;;; (19780 4514)) ;;; Generated autoloads from textmodes/conf-mode.el (autoload 'conf-mode "conf-mode" "\ @@ -4345,7 +4413,7 @@ For details see `conf-mode'. Example: ;;;*** ;;;### (autoloads (shuffle-vector cookie-snarf cookie-insert cookie) -;;;;;; "cookie1" "play/cookie1.el" (19598 13691)) +;;;;;; "cookie1" "play/cookie1.el" (19775 2029)) ;;; Generated autoloads from play/cookie1.el (autoload 'cookie "cookie1" "\ @@ -4377,9 +4445,12 @@ Randomly permute the elements of VECTOR (all permutations equally likely). ;;;*** ;;;### (autoloads (copyright-update-directory copyright copyright-fix-years -;;;;;; copyright-update) "copyright" "emacs-lisp/copyright.el" (19598 -;;;;;; 13691)) +;;;;;; copyright-update) "copyright" "emacs-lisp/copyright.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from emacs-lisp/copyright.el +(put 'copyright-at-end-flag 'safe-local-variable 'booleanp) +(put 'copyright-names-regexp 'safe-local-variable 'stringp) +(put 'copyright-year-ranges 'safe-local-variable 'booleanp) (autoload 'copyright-update "copyright" "\ Update copyright notice to indicate the current year. @@ -4395,6 +4466,8 @@ interactively. (autoload 'copyright-fix-years "copyright" "\ Convert 2 digit years to 4 digit years. Uses heuristic: year >= 50 means 19xx, < 50 means 20xx. +If `copyright-year-ranges' (which see) is non-nil, also +independently replaces consecutive years with a range. \(fn)" t nil) @@ -4405,13 +4478,14 @@ Insert a copyright by $ORGANIZATION notice at cursor. (autoload 'copyright-update-directory "copyright" "\ Update copyright notice for all files in DIRECTORY matching MATCH. +If FIX is non-nil, run `copyright-fix-years' instead. -\(fn DIRECTORY MATCH)" t nil) +\(fn DIRECTORY MATCH &optional FIX)" t nil) ;;;*** ;;;### (autoloads (cperl-perldoc-at-point cperl-perldoc cperl-mode) -;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (19714 43298)) +;;;;;; "cperl-mode" "progmodes/cperl-mode.el" (19775 2029)) ;;; Generated autoloads from progmodes/cperl-mode.el (put 'cperl-indent-level 'safe-local-variable 'integerp) (put 'cperl-brace-offset 'safe-local-variable 'integerp) @@ -4610,7 +4684,7 @@ Run a `perldoc' on the word around point. ;;;*** ;;;### (autoloads (cpp-parse-edit cpp-highlight-buffer) "cpp" "progmodes/cpp.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/cpp.el (autoload 'cpp-highlight-buffer "cpp" "\ @@ -4629,7 +4703,7 @@ Edit display information for cpp conditionals. ;;;*** ;;;### (autoloads (crisp-mode crisp-mode) "crisp" "emulation/crisp.el" -;;;;;; (19619 52030)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emulation/crisp.el (defvar crisp-mode nil "\ @@ -4653,7 +4727,7 @@ With ARG, turn CRiSP mode on if ARG is positive, off otherwise. ;;;*** ;;;### (autoloads (completing-read-multiple) "crm" "emacs-lisp/crm.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/crm.el (autoload 'completing-read-multiple "crm" "\ @@ -4688,8 +4762,8 @@ INHERIT-INPUT-METHOD. ;;;*** -;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (19619 -;;;;;; 52030)) +;;;### (autoloads (css-mode) "css-mode" "textmodes/css-mode.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from textmodes/css-mode.el (autoload 'css-mode "css-mode" "\ @@ -4700,7 +4774,7 @@ Major mode to edit Cascading Style Sheets. ;;;*** ;;;### (autoloads (cua-selection-mode cua-mode) "cua-base" "emulation/cua-base.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emulation/cua-base.el (defvar cua-mode nil "\ @@ -4759,7 +4833,7 @@ Enable CUA selection mode without the C-z/C-x/C-c/C-v bindings. ;;;;;; customize-mode customize customize-save-variable customize-set-variable ;;;;;; customize-set-value custom-menu-sort-alphabetically custom-buffer-sort-alphabetically ;;;;;; custom-browse-sort-alphabetically) "cus-edit" "cus-edit.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2027)) ;;; Generated autoloads from cus-edit.el (defvar custom-browse-sort-alphabetically nil "\ @@ -5062,7 +5136,7 @@ The format is suitable for use with `easy-menu-define'. ;;;*** ;;;### (autoloads (customize-themes describe-theme customize-create-theme) -;;;;;; "cus-theme" "cus-theme.el" (19714 43298)) +;;;;;; "cus-theme" "cus-theme.el" (19775 2028)) ;;; Generated autoloads from cus-theme.el (autoload 'customize-create-theme "cus-theme" "\ @@ -5089,7 +5163,7 @@ omitted, a buffer named *Custom Themes* is used. ;;;*** ;;;### (autoloads (cvs-status-mode) "cvs-status" "vc/cvs-status.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2030)) ;;; Generated autoloads from vc/cvs-status.el (autoload 'cvs-status-mode "cvs-status" "\ @@ -5100,7 +5174,7 @@ Mode used for cvs status output. ;;;*** ;;;### (autoloads (global-cwarn-mode turn-on-cwarn-mode cwarn-mode) -;;;;;; "cwarn" "progmodes/cwarn.el" (19598 13691)) +;;;;;; "cwarn" "progmodes/cwarn.el" (19780 4514)) ;;; Generated autoloads from progmodes/cwarn.el (autoload 'cwarn-mode "cwarn" "\ @@ -5147,7 +5221,7 @@ See `cwarn-mode' for more information on Cwarn mode. ;;;### (autoloads (standard-display-cyrillic-translit cyrillic-encode-alternativnyj-char ;;;;;; cyrillic-encode-koi8-r-char) "cyril-util" "language/cyril-util.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from language/cyril-util.el (autoload 'cyrillic-encode-koi8-r-char "cyril-util" "\ @@ -5176,7 +5250,7 @@ If the argument is nil, we return the display table to its standard state. ;;;*** ;;;### (autoloads (dabbrev-expand dabbrev-completion) "dabbrev" "dabbrev.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2028)) ;;; Generated autoloads from dabbrev.el (put 'dabbrev-case-fold-search 'risky-local-variable t) (put 'dabbrev-case-replace 'risky-local-variable t) @@ -5223,7 +5297,7 @@ See also `dabbrev-abbrev-char-regexp' and \\[dabbrev-completion]. ;;;*** ;;;### (autoloads (data-debug-new-buffer) "data-debug" "cedet/data-debug.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2027)) ;;; Generated autoloads from cedet/data-debug.el (autoload 'data-debug-new-buffer "data-debug" "\ @@ -5233,8 +5307,8 @@ Create a new data-debug buffer with NAME. ;;;*** -;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (dbus-handle-event) "dbus" "net/dbus.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from net/dbus.el (autoload 'dbus-handle-event "dbus" "\ @@ -5247,8 +5321,8 @@ If the HANDLER returns a `dbus-error', it is propagated as return message. ;;;*** -;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (dcl-mode) "dcl-mode" "progmodes/dcl-mode.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from progmodes/dcl-mode.el (autoload 'dcl-mode "dcl-mode" "\ @@ -5375,7 +5449,7 @@ There is some minimal font-lock support (see vars ;;;*** ;;;### (autoloads (cancel-debug-on-entry debug-on-entry debug) "debug" -;;;;;; "emacs-lisp/debug.el" (19598 13691)) +;;;;;; "emacs-lisp/debug.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/debug.el (setq debugger 'debug) @@ -5419,7 +5493,7 @@ To specify a nil argument interactively, exit with an empty minibuffer. ;;;*** ;;;### (autoloads (decipher-mode decipher) "decipher" "play/decipher.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from play/decipher.el (autoload 'decipher "decipher" "\ @@ -5448,8 +5522,8 @@ The most useful commands are: ;;;*** ;;;### (autoloads (delimit-columns-rectangle delimit-columns-region -;;;;;; delimit-columns-customize) "delim-col" "delim-col.el" (19562 -;;;;;; 42953)) +;;;;;; delimit-columns-customize) "delim-col" "delim-col.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from delim-col.el (autoload 'delimit-columns-customize "delim-col" "\ @@ -5473,8 +5547,8 @@ START and END delimits the corners of text rectangle. ;;;*** -;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (delphi-mode) "delphi" "progmodes/delphi.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from progmodes/delphi.el (autoload 'delphi-mode "delphi" "\ @@ -5525,8 +5599,8 @@ no args, if that value is non-nil. ;;;*** -;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (delete-selection-mode) "delsel" "delsel.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from delsel.el (defalias 'pending-delete-mode 'delete-selection-mode) @@ -5555,7 +5629,7 @@ any selection. ;;;*** ;;;### (autoloads (derived-mode-init-mode-variables define-derived-mode) -;;;;;; "derived" "emacs-lisp/derived.el" (19598 13691)) +;;;;;; "derived" "emacs-lisp/derived.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/derived.el (autoload 'define-derived-mode "derived" "\ @@ -5622,7 +5696,7 @@ the first time the mode is used. ;;;*** ;;;### (autoloads (describe-char describe-text-properties) "descr-text" -;;;;;; "descr-text.el" (19591 62571)) +;;;;;; "descr-text.el" (19775 2028)) ;;; Generated autoloads from descr-text.el (autoload 'describe-text-properties "descr-text" "\ @@ -5650,7 +5724,7 @@ as well as widgets, buttons, overlays, and text properties. ;;;### (autoloads (desktop-revert desktop-save-in-desktop-dir desktop-change-dir ;;;;;; desktop-load-default desktop-read desktop-remove desktop-save ;;;;;; desktop-clear desktop-locals-to-save desktop-save-mode) "desktop" -;;;;;; "desktop.el" (19598 13691)) +;;;;;; "desktop.el" (19780 4513)) ;;; Generated autoloads from desktop.el (defvar desktop-save-mode nil "\ @@ -5834,7 +5908,7 @@ Revert to the last loaded desktop. ;;;### (autoloads (gnus-article-outlook-deuglify-article gnus-outlook-deuglify-article ;;;;;; gnus-article-outlook-repair-attribution gnus-article-outlook-unwrap-lines) -;;;;;; "deuglify" "gnus/deuglify.el" (19598 13691)) +;;;;;; "deuglify" "gnus/deuglify.el" (19780 4513)) ;;; Generated autoloads from gnus/deuglify.el (autoload 'gnus-article-outlook-unwrap-lines "deuglify" "\ @@ -5867,7 +5941,7 @@ Deuglify broken Outlook (Express) articles and redisplay. ;;;*** ;;;### (autoloads (diary-mode diary-mail-entries diary) "diary-lib" -;;;;;; "calendar/diary-lib.el" (19714 43298)) +;;;;;; "calendar/diary-lib.el" (19775 2027)) ;;; Generated autoloads from calendar/diary-lib.el (autoload 'diary "diary-lib" "\ @@ -5910,7 +5984,7 @@ Major mode for editing the diary file. ;;;*** ;;;### (autoloads (diff-buffer-with-file diff-backup diff diff-command -;;;;;; diff-switches) "diff" "vc/diff.el" (19714 43298)) +;;;;;; diff-switches) "diff" "vc/diff.el" (19775 2030)) ;;; Generated autoloads from vc/diff.el (defvar diff-switches (purecopy "-c") "\ @@ -5954,7 +6028,7 @@ This requires the external program `diff' to be in your `exec-path'. ;;;*** ;;;### (autoloads (diff-minor-mode diff-mode) "diff-mode" "vc/diff-mode.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2030)) ;;; Generated autoloads from vc/diff-mode.el (autoload 'diff-mode "diff-mode" "\ @@ -5982,7 +6056,7 @@ Minor mode for viewing/editing context diffs. ;;;*** -;;;### (autoloads (dig) "dig" "net/dig.el" (19640 47194)) +;;;### (autoloads (dig) "dig" "net/dig.el" (19775 2029)) ;;; Generated autoloads from net/dig.el (autoload 'dig "dig" "\ @@ -5993,9 +6067,8 @@ Optional arguments are passed to `dig-invoke'. ;;;*** -;;;### (autoloads (dired-mode dired-auto-revert-buffer dired-noselect -;;;;;; dired-other-frame dired-other-window dired dired-trivial-filenames -;;;;;; dired-listing-switches) "dired" "dired.el" (19714 43298)) +;;;### (autoloads (dired-mode dired-noselect dired-other-frame dired-other-window +;;;;;; dired dired-listing-switches) "dired" "dired.el" (19780 4513)) ;;; Generated autoloads from dired.el (defvar dired-listing-switches (purecopy "-al") "\ @@ -6009,16 +6082,6 @@ some of the `ls' switches are not supported; see the doc string of (custom-autoload 'dired-listing-switches "dired" t) -(defvar dired-chown-program (purecopy (if (memq system-type '(hpux usg-unix-v irix gnu/linux cygwin)) "chown" (if (file-exists-p "/usr/sbin/chown") "/usr/sbin/chown" "/etc/chown"))) "\ -Name of chown command (usually `chown' or `/etc/chown').") - -(defvar dired-trivial-filenames (purecopy "^\\.\\.?$\\|^#") "\ -Regexp of files to skip when finding first file of a directory. -A value of nil means move to the subdir line. -A value of t means move to first file.") - -(custom-autoload 'dired-trivial-filenames "dired" t) - (defvar dired-directory nil "\ The directory name or wildcard spec that this dired directory lists. Local to each dired buffer. May be a list, in which case the car is the @@ -6060,18 +6123,6 @@ Like `dired' but returns the dired buffer as value, does not select it. \(fn DIR-OR-LIST &optional SWITCHES)" nil nil) -(defvar dired-auto-revert-buffer nil "\ -Automatically revert dired buffer on revisiting. -If t, revisiting an existing dired buffer automatically reverts it. -If its value is a function, call this function with the directory -name as single argument and revert the buffer if it returns non-nil. -Otherwise, a message offering to revert the changed dired buffer -is displayed. -Note that this is not the same as `auto-revert-mode' that -periodically reverts at specified time intervals.") - -(custom-autoload 'dired-auto-revert-buffer "dired" t) - (autoload 'dired-mode "dired" "\ Mode for \"editing\" directory listings. In Dired, you are \"editing\" a list of the files in a directory and @@ -6140,7 +6191,7 @@ Keybindings: ;;;*** ;;;### (autoloads (dirtrack dirtrack-mode) "dirtrack" "dirtrack.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from dirtrack.el (autoload 'dirtrack-mode "dirtrack" "\ @@ -6166,8 +6217,8 @@ function `dirtrack-debug-mode' to turn on debugging output. ;;;*** -;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (19598 -;;;;;; 13508)) +;;;### (autoloads (disassemble) "disass" "emacs-lisp/disass.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from emacs-lisp/disass.el (autoload 'disassemble "disass" "\ @@ -6186,7 +6237,7 @@ redefine OBJECT if it is a symbol. ;;;;;; standard-display-g1 standard-display-ascii standard-display-default ;;;;;; standard-display-8bit describe-current-display-table describe-display-table ;;;;;; set-display-table-slot display-table-slot make-display-table) -;;;;;; "disp-table" "disp-table.el" (19598 13691)) +;;;;;; "disp-table" "disp-table.el" (19780 4513)) ;;; Generated autoloads from disp-table.el (autoload 'make-display-table "disp-table" "\ @@ -6308,7 +6359,7 @@ in `.emacs'. ;;;*** ;;;### (autoloads (dissociated-press) "dissociate" "play/dissociate.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from play/dissociate.el (autoload 'dissociated-press "dissociate" "\ @@ -6324,7 +6375,7 @@ Default is 2. ;;;*** -;;;### (autoloads (dnd-protocol-alist) "dnd" "dnd.el" (19640 47194)) +;;;### (autoloads (dnd-protocol-alist) "dnd" "dnd.el" (19780 4513)) ;;; Generated autoloads from dnd.el (defvar dnd-protocol-alist `((,(purecopy "^file:///") . dnd-open-local-file) (,(purecopy "^file://") . dnd-open-file) (,(purecopy "^file:") . dnd-open-local-file) (,(purecopy "^\\(https?\\|ftp\\|file\\|nfs\\)://") . dnd-open-file)) "\ @@ -6345,7 +6396,7 @@ if some action was made, or nil if the URL is ignored.") ;;;*** ;;;### (autoloads (dns-mode-soa-increment-serial dns-mode) "dns-mode" -;;;;;; "textmodes/dns-mode.el" (19619 52030)) +;;;;;; "textmodes/dns-mode.el" (19780 4514)) ;;; Generated autoloads from textmodes/dns-mode.el (autoload 'dns-mode "dns-mode" "\ @@ -6368,13 +6419,15 @@ Locate SOA record and increment the serial field. ;;;*** -;;;### (autoloads (doc-view-bookmark-jump doc-view-minor-mode doc-view-mode -;;;;;; doc-view-mode-p) "doc-view" "doc-view.el" (19714 43269)) +;;;### (autoloads (doc-view-bookmark-jump doc-view-minor-mode doc-view-mode-maybe +;;;;;; doc-view-mode doc-view-mode-p) "doc-view" "doc-view.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from doc-view.el (autoload 'doc-view-mode-p "doc-view" "\ -Return non-nil if image type TYPE is available for `doc-view'. -Image types are symbols like `dvi', `postscript' or `pdf'. +Return non-nil if document type TYPE is available for `doc-view'. +Document types are symbols like `dvi', `ps', `pdf', or `odf' (any +OpenDocument format). \(fn TYPE)" nil nil) @@ -6390,6 +6443,13 @@ toggle between displaying the document or editing it as text. \(fn)" t nil) +(autoload 'doc-view-mode-maybe "doc-view" "\ +Switch to `doc-view-mode' if possible. +If the required external tools are not available, then fallback +to the next best mode. + +\(fn)" nil nil) + (autoload 'doc-view-minor-mode "doc-view" "\ Toggle Doc view minor mode. With arg, turn Doc view minor mode on if arg is positive, off otherwise. @@ -6404,7 +6464,7 @@ Not documented ;;;*** -;;;### (autoloads (doctor) "doctor" "play/doctor.el" (19714 43298)) +;;;### (autoloads (doctor) "doctor" "play/doctor.el" (19780 4514)) ;;; Generated autoloads from play/doctor.el (autoload 'doctor "doctor" "\ @@ -6414,7 +6474,7 @@ Switch to *doctor* buffer and start giving psychotherapy. ;;;*** -;;;### (autoloads (double-mode) "double" "double.el" (19562 42953)) +;;;### (autoloads (double-mode) "double" "double.el" (19775 2028)) ;;; Generated autoloads from double.el (autoload 'double-mode "double" "\ @@ -6429,7 +6489,7 @@ when pressed twice. See variable `double-map' for details. ;;;*** -;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (19562 42953)) +;;;### (autoloads (dunnet) "dunnet" "play/dunnet.el" (19775 2029)) ;;; Generated autoloads from play/dunnet.el (autoload 'dunnet "dunnet" "\ @@ -6441,7 +6501,7 @@ Switch to *dungeon* buffer and start game. ;;;### (autoloads (easy-mmode-defsyntax easy-mmode-defmap easy-mmode-define-keymap ;;;;;; define-globalized-minor-mode define-minor-mode) "easy-mmode" -;;;;;; "emacs-lisp/easy-mmode.el" (19714 43298)) +;;;;;; "emacs-lisp/easy-mmode.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/easy-mmode.el (defalias 'easy-mmode-define-minor-mode 'define-minor-mode) @@ -6455,8 +6515,9 @@ Optional INIT-VALUE is the initial value of the mode's variable. Optional LIGHTER is displayed in the modeline when the mode is on. Optional KEYMAP is the default keymap bound to the mode keymap. If non-nil, it should be a variable name (whose value is a keymap), - a keymap, or a list of arguments for `easy-mmode-define-keymap'. - If KEYMAP is a keymap or list, this also defines the variable MODE-map. + or an expression that returns either a keymap or a list of + arguments for `easy-mmode-define-keymap'. If KEYMAP is not a symbol, + this also defines the variable MODE-map. BODY contains code to execute each time the mode is enabled or disabled. It is executed after toggling the mode, and before running MODE-hook. @@ -6550,8 +6611,8 @@ CSS contains a list of syntax specifications of the form (CHAR . SYNTAX). ;;;*** ;;;### (autoloads (easy-menu-change easy-menu-create-menu easy-menu-do-define -;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (19598 -;;;;;; 13691)) +;;;;;; easy-menu-define) "easymenu" "emacs-lisp/easymenu.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from emacs-lisp/easymenu.el (autoload 'easy-menu-define "easymenu" "\ @@ -6576,8 +6637,8 @@ expression has a non-nil value. `:included' is an alias for `:visible'. :active ENABLE -ENABLE is an expression; the menu is enabled for selection -whenever this expression's value is non-nil. +ENABLE is an expression; the menu is enabled for selection whenever +this expression's value is non-nil. `:enable' is an alias for `:active'. The rest of the elements in MENU, are menu items. @@ -6614,8 +6675,8 @@ keyboard equivalent. :active ENABLE -ENABLE is an expression; the item is enabled for selection -whenever this expression's value is non-nil. +ENABLE is an expression; the item is enabled for selection whenever +this expression's value is non-nil. `:enable' is an alias for `:active'. :visible INCLUDE @@ -6705,7 +6766,7 @@ To implement dynamic menus, either call this from ;;;;;; ebnf-eps-file ebnf-eps-directory ebnf-spool-region ebnf-spool-buffer ;;;;;; ebnf-spool-file ebnf-spool-directory ebnf-print-region ebnf-print-buffer ;;;;;; ebnf-print-file ebnf-print-directory ebnf-customize) "ebnf2ps" -;;;;;; "progmodes/ebnf2ps.el" (19714 43298)) +;;;;;; "progmodes/ebnf2ps.el" (19775 2029)) ;;; Generated autoloads from progmodes/ebnf2ps.el (autoload 'ebnf-customize "ebnf2ps" "\ @@ -6979,8 +7040,8 @@ See `ebnf-style-database' documentation. ;;;;;; ebrowse-tags-find-declaration-other-window ebrowse-tags-find-definition ;;;;;; ebrowse-tags-view-definition ebrowse-tags-find-declaration ;;;;;; ebrowse-tags-view-declaration ebrowse-member-mode ebrowse-electric-choose-tree -;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (19714 -;;;;;; 43298)) +;;;;;; ebrowse-tree-mode) "ebrowse" "progmodes/ebrowse.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from progmodes/ebrowse.el (autoload 'ebrowse-tree-mode "ebrowse" "\ @@ -7129,7 +7190,7 @@ Display statistics for a class tree. ;;;*** ;;;### (autoloads (electric-buffer-list) "ebuff-menu" "ebuff-menu.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from ebuff-menu.el (autoload 'electric-buffer-list "ebuff-menu" "\ @@ -7154,7 +7215,7 @@ Run hooks in `electric-buffer-menu-mode-hook' on entry. ;;;*** ;;;### (autoloads (Electric-command-history-redo-expression) "echistory" -;;;;;; "echistory.el" (19562 42953)) +;;;;;; "echistory.el" (19775 2028)) ;;; Generated autoloads from echistory.el (autoload 'Electric-command-history-redo-expression "echistory" "\ @@ -7166,7 +7227,7 @@ With prefix arg NOCONFIRM, execute current line as-is without editing. ;;;*** ;;;### (autoloads (ecomplete-setup) "ecomplete" "gnus/ecomplete.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4513)) ;;; Generated autoloads from gnus/ecomplete.el (autoload 'ecomplete-setup "ecomplete" "\ @@ -7176,7 +7237,7 @@ Not documented ;;;*** -;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (19714 43298)) +;;;### (autoloads (global-ede-mode) "ede" "cedet/ede.el" (19775 2027)) ;;; Generated autoloads from cedet/ede.el (defvar global-ede-mode nil "\ @@ -7202,7 +7263,7 @@ an EDE controlled project. ;;;### (autoloads (edebug-all-forms edebug-all-defs edebug-eval-top-level-form ;;;;;; edebug-basic-spec edebug-all-forms edebug-all-defs) "edebug" -;;;;;; "emacs-lisp/edebug.el" (19720 57265)) +;;;;;; "emacs-lisp/edebug.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/edebug.el (defvar edebug-all-defs nil "\ @@ -7275,7 +7336,7 @@ Toggle edebugging of all forms. ;;;;;; ediff-merge-directories-with-ancestor ediff-merge-directories ;;;;;; ediff-directories3 ediff-directory-revisions ediff-directories ;;;;;; ediff-buffers3 ediff-buffers ediff-backup ediff-current-file -;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (19598 13691)) +;;;;;; ediff-files3 ediff-files) "ediff" "vc/ediff.el" (19775 2030)) ;;; Generated autoloads from vc/ediff.el (autoload 'ediff-files "ediff" "\ @@ -7507,7 +7568,7 @@ With optional NODE, goes to that node. ;;;*** ;;;### (autoloads (ediff-customize) "ediff-help" "vc/ediff-help.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2030)) ;;; Generated autoloads from vc/ediff-help.el (autoload 'ediff-customize "ediff-help" "\ @@ -7515,10 +7576,17 @@ Not documented \(fn)" t nil) +;;;*** + +;;;### (autoloads nil "ediff-hook" "vc/ediff-hook.el" (19775 2030)) +;;; Generated autoloads from vc/ediff-hook.el + +(if (featurep 'xemacs) (progn (defun ediff-xemacs-init-menus nil (when (featurep 'menubar) (add-submenu '("Tools") ediff-menu "OO-Browser...") (add-submenu '("Tools") ediff-merge-menu "OO-Browser...") (add-submenu '("Tools") epatch-menu "OO-Browser...") (add-submenu '("Tools") ediff-misc-menu "OO-Browser...") (add-menu-button '("Tools") "-------" "OO-Browser..."))) (defvar ediff-menu '("Compare" ["Two Files..." ediff-files t] ["Two Buffers..." ediff-buffers t] ["Three Files..." ediff-files3 t] ["Three Buffers..." ediff-buffers3 t] "---" ["Two Directories..." ediff-directories t] ["Three Directories..." ediff-directories3 t] "---" ["File with Revision..." ediff-revision t] ["Directory Revisions..." ediff-directory-revisions t] "---" ["Windows Word-by-word..." ediff-windows-wordwise t] ["Windows Line-by-line..." ediff-windows-linewise t] "---" ["Regions Word-by-word..." ediff-regions-wordwise t] ["Regions Line-by-line..." ediff-regions-linewise t])) (defvar ediff-merge-menu '("Merge" ["Files..." ediff-merge-files t] ["Files with Ancestor..." ediff-merge-files-with-ancestor t] ["Buffers..." ediff-merge-buffers t] ["Buffers with Ancestor..." ediff-merge-buffers-with-ancestor t] "---" ["Directories..." ediff-merge-directories t] ["Directories with Ancestor..." ediff-merge-directories-with-ancestor t] "---" ["Revisions..." ediff-merge-revisions t] ["Revisions with Ancestor..." ediff-merge-revisions-with-ancestor t] ["Directory Revisions..." ediff-merge-directory-revisions t] ["Directory Revisions with Ancestor..." ediff-merge-directory-revisions-with-ancestor t])) (defvar epatch-menu '("Apply Patch" ["To a file..." ediff-patch-file t] ["To a buffer..." ediff-patch-buffer t])) (defvar ediff-misc-menu '("Ediff Miscellanea" ["Ediff Manual" ediff-documentation t] ["Customize Ediff" ediff-customize t] ["List Ediff Sessions" ediff-show-registry t] ["Use separate frame for Ediff control buffer" ediff-toggle-multiframe :style toggle :selected (if (and (featurep 'ediff-util) (boundp 'ediff-window-setup-function)) (eq ediff-window-setup-function 'ediff-setup-windows-multiframe))] ["Use a toolbar with Ediff control buffer" ediff-toggle-use-toolbar :style toggle :selected (if (featurep 'ediff-tbar) (ediff-use-toolbar-p))])) (if (and (featurep 'menubar) (not (featurep 'infodock)) (not (featurep 'ediff-hook))) (ediff-xemacs-init-menus))) (defvar menu-bar-ediff-misc-menu (make-sparse-keymap "Ediff Miscellanea")) (fset 'menu-bar-ediff-misc-menu (symbol-value 'menu-bar-ediff-misc-menu)) (defvar menu-bar-epatch-menu (make-sparse-keymap "Apply Patch")) (fset 'menu-bar-epatch-menu (symbol-value 'menu-bar-epatch-menu)) (defvar menu-bar-ediff-merge-menu (make-sparse-keymap "Merge")) (fset 'menu-bar-ediff-merge-menu (symbol-value 'menu-bar-ediff-merge-menu)) (defvar menu-bar-ediff-menu (make-sparse-keymap "Compare")) (fset 'menu-bar-ediff-menu (symbol-value 'menu-bar-ediff-menu)) (define-key menu-bar-ediff-menu [ediff-misc] `(menu-item ,(purecopy "Ediff Miscellanea") menu-bar-ediff-misc-menu)) (define-key menu-bar-ediff-menu [separator-ediff-misc] menu-bar-separator) (define-key menu-bar-ediff-menu [window] `(menu-item ,(purecopy "This Window and Next Window") compare-windows :help ,(purecopy "Compare the current window and the next window"))) (define-key menu-bar-ediff-menu [ediff-windows-linewise] `(menu-item ,(purecopy "Windows Line-by-line...") ediff-windows-linewise :help ,(purecopy "Compare windows line-wise"))) (define-key menu-bar-ediff-menu [ediff-windows-wordwise] `(menu-item ,(purecopy "Windows Word-by-word...") ediff-windows-wordwise :help ,(purecopy "Compare windows word-wise"))) (define-key menu-bar-ediff-menu [separator-ediff-windows] menu-bar-separator) (define-key menu-bar-ediff-menu [ediff-regions-linewise] `(menu-item ,(purecopy "Regions Line-by-line...") ediff-regions-linewise :help ,(purecopy "Compare regions line-wise"))) (define-key menu-bar-ediff-menu [ediff-regions-wordwise] `(menu-item ,(purecopy "Regions Word-by-word...") ediff-regions-wordwise :help ,(purecopy "Compare regions word-wise"))) (define-key menu-bar-ediff-menu [separator-ediff-regions] menu-bar-separator) (define-key menu-bar-ediff-menu [ediff-dir-revision] `(menu-item ,(purecopy "Directory Revisions...") ediff-directory-revisions :help ,(purecopy "Compare directory files with their older versions"))) (define-key menu-bar-ediff-menu [ediff-revision] `(menu-item ,(purecopy "File with Revision...") ediff-revision :help ,(purecopy "Compare file with its older versions"))) (define-key menu-bar-ediff-menu [separator-ediff-directories] menu-bar-separator) (define-key menu-bar-ediff-menu [ediff-directories3] `(menu-item ,(purecopy "Three Directories...") ediff-directories3 :help ,(purecopy "Compare files common to three directories simultaneously"))) (define-key menu-bar-ediff-menu [ediff-directories] `(menu-item ,(purecopy "Two Directories...") ediff-directories :help ,(purecopy "Compare files common to two directories simultaneously"))) (define-key menu-bar-ediff-menu [separator-ediff-files] menu-bar-separator) (define-key menu-bar-ediff-menu [ediff-buffers3] `(menu-item ,(purecopy "Three Buffers...") ediff-buffers3 :help ,(purecopy "Compare three buffers simultaneously"))) (define-key menu-bar-ediff-menu [ediff-files3] `(menu-item ,(purecopy "Three Files...") ediff-files3 :help ,(purecopy "Compare three files simultaneously"))) (define-key menu-bar-ediff-menu [ediff-buffers] `(menu-item ,(purecopy "Two Buffers...") ediff-buffers :help ,(purecopy "Compare two buffers simultaneously"))) (define-key menu-bar-ediff-menu [ediff-files] `(menu-item ,(purecopy "Two Files...") ediff-files :help ,(purecopy "Compare two files simultaneously"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions-with-ancestor] `(menu-item ,(purecopy "Directory Revisions with Ancestor...") ediff-merge-directory-revisions-with-ancestor :help ,(purecopy "Merge versions of the files in the same directory by comparing the files with common ancestors"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-dir-revisions] `(menu-item ,(purecopy "Directory Revisions...") ediff-merge-directory-revisions :help ,(purecopy "Merge versions of the files in the same directory (without using ancestor information)"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions-with-ancestor] `(menu-item ,(purecopy "Revisions with Ancestor...") ediff-merge-revisions-with-ancestor :help ,(purecopy "Merge versions of the same file by comparing them with a common ancestor"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-revisions] `(menu-item ,(purecopy "Revisions...") ediff-merge-revisions :help ,(purecopy "Merge versions of the same file (without using ancestor information)"))) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge] menu-bar-separator) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories-with-ancestor] `(menu-item ,(purecopy "Directories with Ancestor...") ediff-merge-directories-with-ancestor :help ,(purecopy "Merge files common to a pair of directories by comparing the files with common ancestors"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-directories] `(menu-item ,(purecopy "Directories...") ediff-merge-directories :help ,(purecopy "Merge files common to a pair of directories"))) (define-key menu-bar-ediff-merge-menu [separator-ediff-merge-dirs] menu-bar-separator) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers-with-ancestor] `(menu-item ,(purecopy "Buffers with Ancestor...") ediff-merge-buffers-with-ancestor :help ,(purecopy "Merge buffers by comparing their contents with a common ancestor"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-buffers] `(menu-item ,(purecopy "Buffers...") ediff-merge-buffers :help ,(purecopy "Merge buffers (without using ancestor information)"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-files-with-ancestor] `(menu-item ,(purecopy "Files with Ancestor...") ediff-merge-files-with-ancestor :help ,(purecopy "Merge files by comparing them with a common ancestor"))) (define-key menu-bar-ediff-merge-menu [ediff-merge-files] `(menu-item ,(purecopy "Files...") ediff-merge-files :help ,(purecopy "Merge files (without using ancestor information)"))) (define-key menu-bar-epatch-menu [ediff-patch-buffer] `(menu-item ,(purecopy "To a Buffer...") ediff-patch-buffer :help ,(purecopy "Apply a patch to the contents of a buffer"))) (define-key menu-bar-epatch-menu [ediff-patch-file] `(menu-item ,(purecopy "To a File...") ediff-patch-file :help ,(purecopy "Apply a patch to a file"))) (define-key menu-bar-ediff-misc-menu [emultiframe] `(menu-item ,(purecopy "Use separate control buffer frame") ediff-toggle-multiframe :help ,(purecopy "Switch between the single-frame presentation mode and the multi-frame mode"))) (define-key menu-bar-ediff-misc-menu [eregistry] `(menu-item ,(purecopy "List Ediff Sessions") ediff-show-registry :help ,(purecopy "List all active Ediff sessions; it is a convenient way to find and resume such a session"))) (define-key menu-bar-ediff-misc-menu [ediff-cust] `(menu-item ,(purecopy "Customize Ediff") ediff-customize :help ,(purecopy "Change some of the parameters that govern the behavior of Ediff"))) (define-key menu-bar-ediff-misc-menu [ediff-doc] `(menu-item ,(purecopy "Ediff Manual") ediff-documentation :help ,(purecopy "Bring up the Ediff manual")))) + ;;;*** ;;;### (autoloads (ediff-show-registry) "ediff-mult" "vc/ediff-mult.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2030)) ;;; Generated autoloads from vc/ediff-mult.el (autoload 'ediff-show-registry "ediff-mult" "\ @@ -7531,7 +7599,7 @@ Display Ediff's registry. ;;;*** ;;;### (autoloads (ediff-toggle-use-toolbar ediff-toggle-multiframe) -;;;;;; "ediff-util" "vc/ediff-util.el" (19714 43298)) +;;;;;; "ediff-util" "vc/ediff-util.el" (19780 4514)) ;;; Generated autoloads from vc/ediff-util.el (autoload 'ediff-toggle-multiframe "ediff-util" "\ @@ -7552,7 +7620,7 @@ To change the default, set the variable `ediff-use-toolbar-p', which see. ;;;### (autoloads (format-kbd-macro read-kbd-macro edit-named-kbd-macro ;;;;;; edit-last-kbd-macro edit-kbd-macro) "edmacro" "edmacro.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2028)) ;;; Generated autoloads from edmacro.el (defvar edmacro-eight-bits nil "\ @@ -7605,7 +7673,7 @@ or nil, use a compact 80-column format. ;;;*** ;;;### (autoloads (edt-emulation-on edt-set-scroll-margins) "edt" -;;;;;; "emulation/edt.el" (19714 43298)) +;;;;;; "emulation/edt.el" (19780 4513)) ;;; Generated autoloads from emulation/edt.el (autoload 'edt-set-scroll-margins "edt" "\ @@ -7623,7 +7691,7 @@ Turn on EDT Emulation. ;;;*** ;;;### (autoloads (electric-helpify with-electric-help) "ehelp" "ehelp.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from ehelp.el (autoload 'with-electric-help "ehelp" "\ @@ -7660,7 +7728,7 @@ Not documented ;;;*** ;;;### (autoloads (turn-on-eldoc-mode eldoc-mode eldoc-minor-mode-string) -;;;;;; "eldoc" "emacs-lisp/eldoc.el" (19562 42953)) +;;;;;; "eldoc" "emacs-lisp/eldoc.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/eldoc.el (defvar eldoc-minor-mode-string (purecopy " ElDoc") "\ @@ -7704,7 +7772,7 @@ Emacs Lisp mode) that support ElDoc.") ;;;*** ;;;### (autoloads (electric-layout-mode electric-pair-mode electric-indent-mode) -;;;;;; "electric" "electric.el" (19714 43298)) +;;;;;; "electric" "electric.el" (19775 2028)) ;;; Generated autoloads from electric.el (defvar electric-indent-chars '(10) "\ @@ -7755,8 +7823,8 @@ Automatically insert newlines around some chars. ;;;*** -;;;### (autoloads (elide-head) "elide-head" "elide-head.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (elide-head) "elide-head" "elide-head.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from elide-head.el (autoload 'elide-head "elide-head" "\ @@ -7773,7 +7841,7 @@ This is suitable as an entry on `find-file-hook' or appropriate mode hooks. ;;;### (autoloads (elint-initialize elint-defun elint-current-buffer ;;;;;; elint-directory elint-file) "elint" "emacs-lisp/elint.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/elint.el (autoload 'elint-file "elint" "\ @@ -7809,8 +7877,8 @@ optional prefix argument REINIT is non-nil. ;;;*** ;;;### (autoloads (elp-results elp-instrument-package elp-instrument-list -;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (19562 -;;;;;; 42953)) +;;;;;; elp-instrument-function) "elp" "emacs-lisp/elp.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from emacs-lisp/elp.el (autoload 'elp-instrument-function "elp" "\ @@ -7845,7 +7913,7 @@ displayed. ;;;*** ;;;### (autoloads (report-emacs-bug) "emacsbug" "mail/emacsbug.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from mail/emacsbug.el (autoload 'report-emacs-bug "emacsbug" "\ @@ -7860,7 +7928,7 @@ Prompts for bug subject. Leaves you in a mail buffer. ;;;;;; emerge-revisions emerge-files-with-ancestor-remote emerge-files-remote ;;;;;; emerge-files-with-ancestor-command emerge-files-command emerge-buffers-with-ancestor ;;;;;; emerge-buffers emerge-files-with-ancestor emerge-files) "emerge" -;;;;;; "vc/emerge.el" (19714 43298)) +;;;;;; "vc/emerge.el" (19677 34570)) ;;; Generated autoloads from vc/emerge.el (autoload 'emerge-files "emerge" "\ @@ -7921,7 +7989,7 @@ Not documented ;;;*** ;;;### (autoloads (enriched-decode enriched-encode enriched-mode) -;;;;;; "enriched" "textmodes/enriched.el" (19619 52030)) +;;;;;; "enriched" "textmodes/enriched.el" (19775 2030)) ;;; Generated autoloads from textmodes/enriched.el (autoload 'enriched-mode "enriched" "\ @@ -7956,8 +8024,8 @@ Not documented ;;;;;; epa-sign-region epa-verify-cleartext-in-region epa-verify-region ;;;;;; epa-decrypt-armor-in-region epa-decrypt-region epa-encrypt-file ;;;;;; epa-sign-file epa-verify-file epa-decrypt-file epa-select-keys -;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (19714 -;;;;;; 43298)) +;;;;;; epa-list-secret-keys epa-list-keys) "epa" "epa.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from epa.el (autoload 'epa-list-keys "epa" "\ @@ -8130,7 +8198,7 @@ Insert selected KEYS after the point. ;;;*** ;;;### (autoloads (epa-dired-do-encrypt epa-dired-do-sign epa-dired-do-verify -;;;;;; epa-dired-do-decrypt) "epa-dired" "epa-dired.el" (19598 13691)) +;;;;;; epa-dired-do-decrypt) "epa-dired" "epa-dired.el" (19775 2028)) ;;; Generated autoloads from epa-dired.el (autoload 'epa-dired-do-decrypt "epa-dired" "\ @@ -8156,7 +8224,7 @@ Encrypt marked files. ;;;*** ;;;### (autoloads (epa-file-disable epa-file-enable epa-file-handler) -;;;;;; "epa-file" "epa-file.el" (19640 47194)) +;;;;;; "epa-file" "epa-file.el" (19775 2028)) ;;; Generated autoloads from epa-file.el (autoload 'epa-file-handler "epa-file" "\ @@ -8178,7 +8246,7 @@ Not documented ;;;### (autoloads (epa-global-mail-mode epa-mail-import-keys epa-mail-encrypt ;;;;;; epa-mail-sign epa-mail-verify epa-mail-decrypt epa-mail-mode) -;;;;;; "epa-mail" "epa-mail.el" (19714 43298)) +;;;;;; "epa-mail" "epa-mail.el" (19775 2028)) ;;; Generated autoloads from epa-mail.el (autoload 'epa-mail-mode "epa-mail" "\ @@ -8242,7 +8310,7 @@ Minor mode to hook EasyPG into Mail mode. ;;;*** -;;;### (autoloads (epg-make-context) "epg" "epg.el" (19714 43298)) +;;;### (autoloads (epg-make-context) "epg" "epg.el" (19780 4513)) ;;; Generated autoloads from epg.el (autoload 'epg-make-context "epg" "\ @@ -8253,7 +8321,7 @@ Return a context object. ;;;*** ;;;### (autoloads (epg-expand-group epg-check-configuration epg-configuration) -;;;;;; "epg-config" "epg-config.el" (19714 43298)) +;;;;;; "epg-config" "epg-config.el" (19775 2028)) ;;; Generated autoloads from epg-config.el (autoload 'epg-configuration "epg-config" "\ @@ -8274,7 +8342,7 @@ Look at CONFIG and try to expand GROUP. ;;;*** ;;;### (autoloads (erc-handle-irc-url erc erc-select-read-args) "erc" -;;;;;; "erc/erc.el" (19598 13691)) +;;;;;; "erc/erc.el" (19775 2028)) ;;; Generated autoloads from erc/erc.el (autoload 'erc-select-read-args "erc" "\ @@ -8316,33 +8384,33 @@ Otherwise, connect to HOST:PORT as USER and /join CHANNEL. ;;;*** -;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (19562 -;;;;;; 42953)) +;;;### (autoloads nil "erc-autoaway" "erc/erc-autoaway.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from erc/erc-autoaway.el (autoload 'erc-autoaway-mode "erc-autoaway") ;;;*** -;;;### (autoloads nil "erc-button" "erc/erc-button.el" (19562 42953)) +;;;### (autoloads nil "erc-button" "erc/erc-button.el" (19775 2028)) ;;; Generated autoloads from erc/erc-button.el (autoload 'erc-button-mode "erc-button" nil t) ;;;*** -;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (19562 42953)) +;;;### (autoloads nil "erc-capab" "erc/erc-capab.el" (19775 2028)) ;;; Generated autoloads from erc/erc-capab.el (autoload 'erc-capab-identify-mode "erc-capab" nil t) ;;;*** -;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (19562 42953)) +;;;### (autoloads nil "erc-compat" "erc/erc-compat.el" (19780 4513)) ;;; Generated autoloads from erc/erc-compat.el (autoload 'erc-define-minor-mode "erc-compat") ;;;*** ;;;### (autoloads (erc-ctcp-query-DCC pcomplete/erc-mode/DCC erc-cmd-DCC) -;;;;;; "erc-dcc" "erc/erc-dcc.el" (19562 42953)) +;;;;;; "erc-dcc" "erc/erc-dcc.el" (19780 4513)) ;;; Generated autoloads from erc/erc-dcc.el (autoload 'erc-dcc-mode "erc-dcc") @@ -8375,7 +8443,7 @@ that subcommand. ;;;;;; erc-ezb-add-session erc-ezb-end-of-session-list erc-ezb-init-session-list ;;;;;; erc-ezb-identify erc-ezb-notice-autodetect erc-ezb-lookup-action ;;;;;; erc-ezb-get-login erc-cmd-ezb) "erc-ezbounce" "erc/erc-ezbounce.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from erc/erc-ezbounce.el (autoload 'erc-cmd-ezb "erc-ezbounce" "\ @@ -8437,8 +8505,8 @@ Add EZBouncer convenience functions to ERC. ;;;*** -;;;### (autoloads (erc-fill) "erc-fill" "erc/erc-fill.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (erc-fill) "erc-fill" "erc/erc-fill.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from erc/erc-fill.el (autoload 'erc-fill-mode "erc-fill" nil t) @@ -8450,15 +8518,15 @@ You can put this on `erc-insert-modify-hook' and/or `erc-send-modify-hook'. ;;;*** -;;;### (autoloads nil "erc-hecomplete" "erc/erc-hecomplete.el" (19591 -;;;;;; 62571)) +;;;### (autoloads nil "erc-hecomplete" "erc/erc-hecomplete.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from erc/erc-hecomplete.el (autoload 'erc-hecomplete-mode "erc-hecomplete" nil t) ;;;*** ;;;### (autoloads (erc-identd-stop erc-identd-start) "erc-identd" -;;;;;; "erc/erc-identd.el" (19562 42953)) +;;;;;; "erc/erc-identd.el" (19775 2028)) ;;; Generated autoloads from erc/erc-identd.el (autoload 'erc-identd-mode "erc-identd") @@ -8480,7 +8548,7 @@ Not documented ;;;*** ;;;### (autoloads (erc-create-imenu-index) "erc-imenu" "erc/erc-imenu.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from erc/erc-imenu.el (autoload 'erc-create-imenu-index "erc-imenu" "\ @@ -8490,20 +8558,20 @@ Not documented ;;;*** -;;;### (autoloads nil "erc-join" "erc/erc-join.el" (19598 13691)) +;;;### (autoloads nil "erc-join" "erc/erc-join.el" (19775 2028)) ;;; Generated autoloads from erc/erc-join.el (autoload 'erc-autojoin-mode "erc-join" nil t) ;;;*** -;;;### (autoloads nil "erc-list" "erc/erc-list.el" (19640 47194)) +;;;### (autoloads nil "erc-list" "erc/erc-list.el" (19775 2028)) ;;; Generated autoloads from erc/erc-list.el (autoload 'erc-list-mode "erc-list") ;;;*** ;;;### (autoloads (erc-save-buffer-in-logs erc-logging-enabled) "erc-log" -;;;;;; "erc/erc-log.el" (19562 42953)) +;;;;;; "erc/erc-log.el" (19775 2028)) ;;; Generated autoloads from erc/erc-log.el (autoload 'erc-log-mode "erc-log" nil t) @@ -8535,7 +8603,7 @@ You can save every individual message by putting this function on ;;;### (autoloads (erc-delete-dangerous-host erc-add-dangerous-host ;;;;;; erc-delete-keyword erc-add-keyword erc-delete-fool erc-add-fool ;;;;;; erc-delete-pal erc-add-pal) "erc-match" "erc/erc-match.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from erc/erc-match.el (autoload 'erc-match-mode "erc-match") @@ -8581,14 +8649,14 @@ Delete dangerous-host interactively to `erc-dangerous-hosts'. ;;;*** -;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (19562 42953)) +;;;### (autoloads nil "erc-menu" "erc/erc-menu.el" (19775 2028)) ;;; Generated autoloads from erc/erc-menu.el (autoload 'erc-menu-mode "erc-menu" nil t) ;;;*** ;;;### (autoloads (erc-cmd-WHOLEFT) "erc-netsplit" "erc/erc-netsplit.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from erc/erc-netsplit.el (autoload 'erc-netsplit-mode "erc-netsplit") @@ -8600,7 +8668,7 @@ Show who's gone. ;;;*** ;;;### (autoloads (erc-server-select erc-determine-network) "erc-networks" -;;;;;; "erc/erc-networks.el" (19562 42953)) +;;;;;; "erc/erc-networks.el" (19775 2028)) ;;; Generated autoloads from erc/erc-networks.el (autoload 'erc-determine-network "erc-networks" "\ @@ -8618,7 +8686,7 @@ Interactively select a server to connect to using `erc-server-alist'. ;;;*** ;;;### (autoloads (pcomplete/erc-mode/NOTIFY erc-cmd-NOTIFY) "erc-notify" -;;;;;; "erc/erc-notify.el" (19562 42953)) +;;;;;; "erc/erc-notify.el" (19775 2028)) ;;; Generated autoloads from erc/erc-notify.el (autoload 'erc-notify-mode "erc-notify" nil t) @@ -8636,33 +8704,33 @@ Not documented ;;;*** -;;;### (autoloads nil "erc-page" "erc/erc-page.el" (19562 42953)) +;;;### (autoloads nil "erc-page" "erc/erc-page.el" (19775 2028)) ;;; Generated autoloads from erc/erc-page.el (autoload 'erc-page-mode "erc-page") ;;;*** -;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (19562 -;;;;;; 42953)) +;;;### (autoloads nil "erc-pcomplete" "erc/erc-pcomplete.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from erc/erc-pcomplete.el (autoload 'erc-completion-mode "erc-pcomplete" nil t) ;;;*** -;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (19562 42953)) +;;;### (autoloads nil "erc-replace" "erc/erc-replace.el" (19775 2028)) ;;; Generated autoloads from erc/erc-replace.el (autoload 'erc-replace-mode "erc-replace") ;;;*** -;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (19562 42953)) +;;;### (autoloads nil "erc-ring" "erc/erc-ring.el" (19775 2028)) ;;; Generated autoloads from erc/erc-ring.el (autoload 'erc-ring-mode "erc-ring" nil t) ;;;*** ;;;### (autoloads (erc-nickserv-identify erc-nickserv-identify-mode) -;;;;;; "erc-services" "erc/erc-services.el" (19562 42953)) +;;;;;; "erc-services" "erc/erc-services.el" (19775 2028)) ;;; Generated autoloads from erc/erc-services.el (autoload 'erc-services-mode "erc-services" nil t) @@ -8679,14 +8747,14 @@ When called interactively, read the password using `read-passwd'. ;;;*** -;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (19562 42953)) +;;;### (autoloads nil "erc-sound" "erc/erc-sound.el" (19775 2028)) ;;; Generated autoloads from erc/erc-sound.el (autoload 'erc-sound-mode "erc-sound") ;;;*** ;;;### (autoloads (erc-speedbar-browser) "erc-speedbar" "erc/erc-speedbar.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from erc/erc-speedbar.el (autoload 'erc-speedbar-browser "erc-speedbar" "\ @@ -8697,21 +8765,21 @@ This will add a speedbar major display mode. ;;;*** -;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (19562 -;;;;;; 42953)) +;;;### (autoloads nil "erc-spelling" "erc/erc-spelling.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from erc/erc-spelling.el (autoload 'erc-spelling-mode "erc-spelling" nil t) ;;;*** -;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (19562 42953)) +;;;### (autoloads nil "erc-stamp" "erc/erc-stamp.el" (19780 4513)) ;;; Generated autoloads from erc/erc-stamp.el (autoload 'erc-timestamp-mode "erc-stamp" nil t) ;;;*** ;;;### (autoloads (erc-track-minor-mode) "erc-track" "erc/erc-track.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from erc/erc-track.el (defvar erc-track-minor-mode nil "\ @@ -8734,7 +8802,7 @@ module, otherwise the keybindings will not do anything useful. ;;;*** ;;;### (autoloads (erc-truncate-buffer erc-truncate-buffer-to-size) -;;;;;; "erc-truncate" "erc/erc-truncate.el" (19562 42953)) +;;;;;; "erc-truncate" "erc/erc-truncate.el" (19775 2028)) ;;; Generated autoloads from erc/erc-truncate.el (autoload 'erc-truncate-mode "erc-truncate" nil t) @@ -8754,7 +8822,7 @@ Meant to be used in hooks, like `erc-insert-post-hook'. ;;;*** ;;;### (autoloads (erc-xdcc-add-file) "erc-xdcc" "erc/erc-xdcc.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2028)) ;;; Generated autoloads from erc/erc-xdcc.el (autoload 'erc-xdcc-mode "erc-xdcc") @@ -8765,8 +8833,92 @@ Add a file to `erc-xdcc-files'. ;;;*** -;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (19619 -;;;;;; 52030)) +;;;### (autoloads (ert-describe-test ert-run-tests-interactively +;;;;;; ert-run-tests-batch-and-exit ert-run-tests-batch ert-deftest) +;;;;;; "ert" "emacs-lisp/ert.el" (19775 2028)) +;;; Generated autoloads from emacs-lisp/ert.el + +(autoload 'ert-deftest "ert" "\ +Define NAME (a symbol) as a test. + +BODY is evaluated as a `progn' when the test is run. It should +signal a condition on failure or just return if the test passes. + +`should', `should-not' and `should-error' are useful for +assertions in BODY. + +Use `ert' to run tests interactively. + +Tests that are expected to fail can be marked as such +using :expected-result. See `ert-test-result-type-p' for a +description of valid values for RESULT-TYPE. + +\(fn NAME () [DOCSTRING] [:expected-result RESULT-TYPE] [:tags '(TAG...)] BODY...)" nil (quote macro)) + +(put 'ert-deftest 'lisp-indent-function '2) + +(put 'ert-deftest 'doc-string-elt '3) + +(put 'ert-deftest 'lisp-indent-function 2) + +(put 'ert-info 'lisp-indent-function 1) + +(autoload 'ert-run-tests-batch "ert" "\ +Run the tests specified by SELECTOR, printing results to the terminal. + +SELECTOR works as described in `ert-select-tests', except if +SELECTOR is nil, in which case all tests rather than none will be +run; this makes the command line \"emacs -batch -l my-tests.el -f +ert-run-tests-batch-and-exit\" useful. + +Returns the stats object. + +\(fn &optional SELECTOR)" nil nil) + +(autoload 'ert-run-tests-batch-and-exit "ert" "\ +Like `ert-run-tests-batch', but exits Emacs when done. + +The exit status will be 0 if all test results were as expected, 1 +on unexpected results, or 2 if the tool detected an error outside +of the tests (e.g. invalid SELECTOR or bug in the code that runs +the tests). + +\(fn &optional SELECTOR)" nil nil) + +(autoload 'ert-run-tests-interactively "ert" "\ +Run the tests specified by SELECTOR and display the results in a buffer. + +SELECTOR works as described in `ert-select-tests'. +OUTPUT-BUFFER-NAME and MESSAGE-FN should normally be nil; they +are used for automated self-tests and specify which buffer to use +and how to display message. + +\(fn SELECTOR &optional OUTPUT-BUFFER-NAME MESSAGE-FN)" t nil) + +(defalias 'ert 'ert-run-tests-interactively) + +(autoload 'ert-describe-test "ert" "\ +Display the documentation for TEST-OR-TEST-NAME (a symbol or ert-test). + +\(fn TEST-OR-TEST-NAME)" t nil) + +;;;*** + +;;;### (autoloads (ert-kill-all-test-buffers) "ert-x" "emacs-lisp/ert-x.el" +;;;;;; (19775 2028)) +;;; Generated autoloads from emacs-lisp/ert-x.el + +(put 'ert-with-test-buffer 'lisp-indent-function 1) + +(autoload 'ert-kill-all-test-buffers "ert-x" "\ +Kill all test buffers that are still live. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads (eshell-mode) "esh-mode" "eshell/esh-mode.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from eshell/esh-mode.el (autoload 'eshell-mode "esh-mode" "\ @@ -8778,8 +8930,8 @@ Emacs shell interactive mode. ;;;*** -;;;### (autoloads (eshell-test) "esh-test" "eshell/esh-test.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (eshell-test) "esh-test" "eshell/esh-test.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from eshell/esh-test.el (autoload 'eshell-test "esh-test" "\ @@ -8790,7 +8942,7 @@ Test Eshell to verify that it works as expected. ;;;*** ;;;### (autoloads (eshell-command-result eshell-command eshell) "eshell" -;;;;;; "eshell/eshell.el" (19562 42953)) +;;;;;; "eshell/eshell.el" (19775 2028)) ;;; Generated autoloads from eshell/eshell.el (autoload 'eshell "eshell" "\ @@ -8831,7 +8983,7 @@ corresponding to a successful execution. ;;;;;; visit-tags-table tags-table-mode find-tag-default-function ;;;;;; find-tag-hook tags-add-tables tags-compression-info-list ;;;;;; tags-table-list tags-case-fold-search) "etags" "progmodes/etags.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/etags.el (defvar tags-file-name nil "\ @@ -9145,7 +9297,7 @@ for \\[find-tag] (which see). ;;;;;; ethio-fidel-to-sera-marker ethio-fidel-to-sera-region ethio-fidel-to-sera-buffer ;;;;;; ethio-sera-to-fidel-marker ethio-sera-to-fidel-region ethio-sera-to-fidel-buffer ;;;;;; setup-ethiopic-environment-internal) "ethio-util" "language/ethio-util.el" -;;;;;; (19562 42953)) +;;;;;; (19780 4513)) ;;; Generated autoloads from language/ethio-util.el (autoload 'setup-ethiopic-environment-internal "ethio-util" "\ @@ -9315,7 +9467,7 @@ Not documented ;;;### (autoloads (eudc-load-eudc eudc-query-form eudc-expand-inline ;;;;;; eudc-get-phone eudc-get-email eudc-set-server) "eudc" "net/eudc.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from net/eudc.el (autoload 'eudc-set-server "eudc" "\ @@ -9371,7 +9523,7 @@ This does nothing except loading eudc by autoload side-effect. ;;;### (autoloads (eudc-display-jpeg-as-button eudc-display-jpeg-inline ;;;;;; eudc-display-sound eudc-display-mail eudc-display-url eudc-display-generic-binary) -;;;;;; "eudc-bob" "net/eudc-bob.el" (19598 13691)) +;;;;;; "eudc-bob" "net/eudc-bob.el" (19775 2029)) ;;; Generated autoloads from net/eudc-bob.el (autoload 'eudc-display-generic-binary "eudc-bob" "\ @@ -9407,7 +9559,7 @@ Display a button for the JPEG DATA. ;;;*** ;;;### (autoloads (eudc-try-bbdb-insert eudc-insert-record-at-point-into-bbdb) -;;;;;; "eudc-export" "net/eudc-export.el" (19598 13691)) +;;;;;; "eudc-export" "net/eudc-export.el" (19775 2029)) ;;; Generated autoloads from net/eudc-export.el (autoload 'eudc-insert-record-at-point-into-bbdb "eudc-export" "\ @@ -9424,7 +9576,7 @@ Call `eudc-insert-record-at-point-into-bbdb' if on a record. ;;;*** ;;;### (autoloads (eudc-edit-hotlist) "eudc-hotlist" "net/eudc-hotlist.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2029)) ;;; Generated autoloads from net/eudc-hotlist.el (autoload 'eudc-edit-hotlist "eudc-hotlist" "\ @@ -9434,8 +9586,8 @@ Edit the hotlist of directory servers in a specialized buffer. ;;;*** -;;;### (autoloads (ewoc-create) "ewoc" "emacs-lisp/ewoc.el" (19591 -;;;;;; 62571)) +;;;### (autoloads (ewoc-create) "ewoc" "emacs-lisp/ewoc.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from emacs-lisp/ewoc.el (autoload 'ewoc-create "ewoc" "\ @@ -9464,7 +9616,7 @@ fourth arg NOSEP non-nil inhibits this. ;;;### (autoloads (executable-make-buffer-file-executable-if-script-p ;;;;;; executable-self-display executable-set-magic executable-interpret ;;;;;; executable-command-find-posix-p) "executable" "progmodes/executable.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/executable.el (autoload 'executable-command-find-posix-p "executable" "\ @@ -9507,7 +9659,7 @@ file modes. ;;;### (autoloads (expand-jump-to-next-slot expand-jump-to-previous-slot ;;;;;; expand-abbrev-hook expand-add-abbrevs) "expand" "expand.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from expand.el (autoload 'expand-add-abbrevs "expand" "\ @@ -9556,7 +9708,7 @@ This is used only in conjunction with `expand-add-abbrevs'. ;;;*** -;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (19714 43298)) +;;;### (autoloads (f90-mode) "f90" "progmodes/f90.el" (19775 2029)) ;;; Generated autoloads from progmodes/f90.el (autoload 'f90-mode "f90" "\ @@ -9622,8 +9774,8 @@ with no args, if that value is non-nil. ;;;### (autoloads (variable-pitch-mode buffer-face-toggle buffer-face-set ;;;;;; buffer-face-mode text-scale-adjust text-scale-decrease text-scale-increase ;;;;;; text-scale-set face-remap-set-base face-remap-reset-base -;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (19714 -;;;;;; 43298)) +;;;;;; face-remap-add-relative) "face-remap" "face-remap.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from face-remap.el (autoload 'face-remap-add-relative "face-remap" "\ @@ -9763,7 +9915,7 @@ Besides the choice of face, it is the same as `buffer-face-mode'. ;;;### (autoloads (feedmail-queue-reminder feedmail-run-the-queue ;;;;;; feedmail-run-the-queue-global-prompt feedmail-run-the-queue-no-prompts -;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (19619 52030)) +;;;;;; feedmail-send-it) "feedmail" "mail/feedmail.el" (19763 27286)) ;;; Generated autoloads from mail/feedmail.el (autoload 'feedmail-send-it "feedmail" "\ @@ -9817,7 +9969,7 @@ you can set `feedmail-queue-reminder-alist' to nil. ;;;*** ;;;### (autoloads (ffap-bindings dired-at-point ffap-at-mouse ffap-menu -;;;;;; find-file-at-point ffap-next) "ffap" "ffap.el" (19591 62571)) +;;;;;; find-file-at-point ffap-next) "ffap" "ffap.el" (19775 2028)) ;;; Generated autoloads from ffap.el (autoload 'ffap-next "ffap" "\ @@ -9881,7 +10033,7 @@ Evaluate the forms in variable `ffap-bindings'. ;;;### (autoloads (file-cache-minibuffer-complete file-cache-add-directory-recursively ;;;;;; file-cache-add-directory-using-locate file-cache-add-directory-using-find ;;;;;; file-cache-add-file file-cache-add-directory-list file-cache-add-directory) -;;;;;; "filecache" "filecache.el" (19714 43298)) +;;;;;; "filecache" "filecache.el" (19775 2028)) ;;; Generated autoloads from filecache.el (autoload 'file-cache-add-directory "filecache" "\ @@ -9941,7 +10093,7 @@ the name is considered already unique; only the second substitution ;;;;;; copy-file-locals-to-dir-locals delete-dir-local-variable ;;;;;; add-dir-local-variable delete-file-local-variable-prop-line ;;;;;; add-file-local-variable-prop-line delete-file-local-variable -;;;;;; add-file-local-variable) "files-x" "files-x.el" (19598 13691)) +;;;;;; add-file-local-variable) "files-x" "files-x.el" (19775 2028)) ;;; Generated autoloads from files-x.el (autoload 'add-file-local-variable "files-x" "\ @@ -10006,8 +10158,8 @@ Copy directory-local variables to the -*- line. ;;;*** -;;;### (autoloads (filesets-init) "filesets" "filesets.el" (19619 -;;;;;; 52030)) +;;;### (autoloads (filesets-init) "filesets" "filesets.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from filesets.el (autoload 'filesets-init "filesets" "\ @@ -10018,7 +10170,7 @@ Set up hooks, load the cache file -- if existing -- and build the menu. ;;;*** -;;;### (autoloads (find-cmd) "find-cmd" "find-cmd.el" (19562 42953)) +;;;### (autoloads (find-cmd) "find-cmd" "find-cmd.el" (19775 2028)) ;;; Generated autoloads from find-cmd.el (autoload 'find-cmd "find-cmd" "\ @@ -10039,7 +10191,7 @@ result is a string that should be ready for the command line. ;;;### (autoloads (find-grep-dired find-name-dired find-dired find-grep-options ;;;;;; find-ls-subdir-switches find-ls-option) "find-dired" "find-dired.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from find-dired.el (defvar find-ls-option (if (eq system-type 'berkeley-unix) (purecopy '("-ls" . "-gilsb")) (purecopy '("-exec ls -ld {} \\;" . "-ld"))) "\ @@ -10100,7 +10252,7 @@ Thus ARG can also contain additional grep options. ;;;### (autoloads (ff-mouse-find-other-file-other-window ff-mouse-find-other-file ;;;;;; ff-find-other-file ff-get-other-file) "find-file" "find-file.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from find-file.el (defvar ff-special-constructs `((,(purecopy "^#\\s *\\(include\\|import\\)\\s +[<\"]\\(.*\\)[>\"]") lambda nil (buffer-substring (match-beginning 2) (match-end 2)))) "\ @@ -10194,7 +10346,7 @@ Visit the file you click on in another window. ;;;;;; find-variable find-variable-noselect find-function-other-frame ;;;;;; find-function-other-window find-function find-function-noselect ;;;;;; find-function-search-for-symbol find-library) "find-func" -;;;;;; "emacs-lisp/find-func.el" (19714 43298)) +;;;;;; "emacs-lisp/find-func.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/find-func.el (autoload 'find-library "find-func" "\ @@ -10349,7 +10501,7 @@ Define some key bindings for the find-function family of functions. ;;;*** ;;;### (autoloads (find-lisp-find-dired-filter find-lisp-find-dired-subdirectories -;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (19591 62571)) +;;;;;; find-lisp-find-dired) "find-lisp" "find-lisp.el" (19775 2028)) ;;; Generated autoloads from find-lisp.el (autoload 'find-lisp-find-dired "find-lisp" "\ @@ -10370,7 +10522,7 @@ Change the filter on a find-lisp-find-dired buffer to REGEXP. ;;;*** ;;;### (autoloads (finder-by-keyword finder-commentary finder-list-keywords) -;;;;;; "finder" "finder.el" (19714 43298)) +;;;;;; "finder" "finder.el" (19775 2028)) ;;; Generated autoloads from finder.el (autoload 'finder-list-keywords "finder" "\ @@ -10392,7 +10544,7 @@ Find packages matching a given keyword. ;;;*** ;;;### (autoloads (enable-flow-control-on enable-flow-control) "flow-ctrl" -;;;;;; "flow-ctrl.el" (19591 62571)) +;;;;;; "flow-ctrl.el" (19775 2028)) ;;; Generated autoloads from flow-ctrl.el (autoload 'enable-flow-control "flow-ctrl" "\ @@ -10414,7 +10566,7 @@ to get the effect of a C-q. ;;;*** ;;;### (autoloads (fill-flowed fill-flowed-encode) "flow-fill" "gnus/flow-fill.el" -;;;;;; (19619 52030)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/flow-fill.el (autoload 'fill-flowed-encode "flow-fill" "\ @@ -10430,7 +10582,7 @@ Not documented ;;;*** ;;;### (autoloads (flymake-mode-off flymake-mode-on flymake-mode) -;;;;;; "flymake" "progmodes/flymake.el" (19714 43298)) +;;;;;; "flymake" "progmodes/flymake.el" (19780 4514)) ;;; Generated autoloads from progmodes/flymake.el (autoload 'flymake-mode "flymake" "\ @@ -10454,7 +10606,7 @@ Turn flymake mode off. ;;;### (autoloads (flyspell-buffer flyspell-region flyspell-mode-off ;;;;;; turn-off-flyspell turn-on-flyspell flyspell-mode flyspell-prog-mode) -;;;;;; "flyspell" "textmodes/flyspell.el" (19714 43298)) +;;;;;; "flyspell" "textmodes/flyspell.el" (19775 2030)) ;;; Generated autoloads from textmodes/flyspell.el (autoload 'flyspell-prog-mode "flyspell" "\ @@ -10524,7 +10676,7 @@ Flyspell whole buffer. ;;;### (autoloads (follow-delete-other-windows-and-split follow-mode ;;;;;; turn-off-follow-mode turn-on-follow-mode) "follow" "follow.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from follow.el (autoload 'turn-on-follow-mode "follow" "\ @@ -10597,8 +10749,15 @@ in your `~/.emacs' file, replacing [f7] by your favourite key: ;;;*** -;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (19562 -;;;;;; 42953)) +;;;### (autoloads nil "font-core" "font-core.el" (19780 4513)) +;;; Generated autoloads from font-core.el + +(put 'font-lock-defaults 'risky-local-variable t) + +;;;*** + +;;;### (autoloads (footnote-mode) "footnote" "mail/footnote.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from mail/footnote.el (autoload 'footnote-mode "footnote" "\ @@ -10609,10 +10768,17 @@ started, play around with the following keys: \(fn &optional ARG)" t nil) +;;;*** + +;;;### (autoloads nil "format" "format.el" (19780 4513)) +;;; Generated autoloads from format.el + +(put 'format-alist 'risky-local-variable t) + ;;;*** ;;;### (autoloads (forms-find-file-other-window forms-find-file forms-mode) -;;;;;; "forms" "forms.el" (19562 42953)) +;;;;;; "forms" "forms.el" (19775 2028)) ;;; Generated autoloads from forms.el (autoload 'forms-mode "forms" "\ @@ -10649,7 +10815,7 @@ Visit a file in Forms mode in other window. ;;;*** ;;;### (autoloads (fortran-mode) "fortran" "progmodes/fortran.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/fortran.el (autoload 'fortran-mode "fortran" "\ @@ -10727,7 +10893,7 @@ with no args, if that value is non-nil. ;;;*** ;;;### (autoloads (fortune fortune-to-signature fortune-compile fortune-from-region -;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (19714 43298)) +;;;;;; fortune-add-fortune) "fortune" "play/fortune.el" (19775 2029)) ;;; Generated autoloads from play/fortune.el (autoload 'fortune-add-fortune "fortune" "\ @@ -10776,7 +10942,7 @@ and choose the directory as the fortune-file. ;;;*** ;;;### (autoloads (gdb gdb-enable-debug) "gdb-mi" "progmodes/gdb-mi.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/gdb-mi.el (defvar gdb-enable-debug nil "\ @@ -10837,8 +11003,8 @@ detailed description of this mode. ;;;*** ;;;### (autoloads (generic-make-keywords-list generic-mode generic-mode-internal -;;;;;; define-generic-mode) "generic" "emacs-lisp/generic.el" (19598 -;;;;;; 13691)) +;;;;;; define-generic-mode) "generic" "emacs-lisp/generic.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from emacs-lisp/generic.el (defvar generic-mode-list nil "\ @@ -10915,7 +11081,7 @@ regular expression that can be used as an element of ;;;*** ;;;### (autoloads (glasses-mode) "glasses" "progmodes/glasses.el" -;;;;;; (19562 42953)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/glasses.el (autoload 'glasses-mode "glasses" "\ @@ -10929,7 +11095,7 @@ at places they belong to. ;;;### (autoloads (gmm-tool-bar-from-list gmm-widget-p gmm-error ;;;;;; gmm-message gmm-regexp-concat) "gmm-utils" "gnus/gmm-utils.el" -;;;;;; (19640 47194)) +;;;;;; (19780 4513)) ;;; Generated autoloads from gnus/gmm-utils.el (autoload 'gmm-regexp-concat "gmm-utils" "\ @@ -10984,7 +11150,7 @@ DEFAULT-MAP specifies the default key map for ICON-LIST. ;;;*** ;;;### (autoloads (gnus gnus-other-frame gnus-slave gnus-no-server -;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (19714 43298)) +;;;;;; gnus-slave-no-server) "gnus" "gnus/gnus.el" (19780 4513)) ;;; Generated autoloads from gnus/gnus.el (when (fboundp 'custom-autoload) (custom-autoload 'gnus-select-method "gnus")) @@ -11037,7 +11203,7 @@ prompt the user for the name of an NNTP server to use. ;;;;;; gnus-agent-get-undownloaded-list gnus-agent-delete-group ;;;;;; gnus-agent-rename-group gnus-agent-possibly-save-gcc gnus-agentize ;;;;;; gnus-slave-unplugged gnus-plugged gnus-unplugged) "gnus-agent" -;;;;;; "gnus/gnus-agent.el" (19714 43298)) +;;;;;; "gnus/gnus-agent.el" (19775 2028)) ;;; Generated autoloads from gnus/gnus-agent.el (autoload 'gnus-unplugged "gnus-agent" "\ @@ -11128,7 +11294,7 @@ If CLEAN, obsolete (ignore). ;;;*** ;;;### (autoloads (gnus-article-prepare-display) "gnus-art" "gnus/gnus-art.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4513)) ;;; Generated autoloads from gnus/gnus-art.el (autoload 'gnus-article-prepare-display "gnus-art" "\ @@ -11139,7 +11305,7 @@ Make the current buffer look like a nice article. ;;;*** ;;;### (autoloads (gnus-bookmark-bmenu-list gnus-bookmark-jump gnus-bookmark-set) -;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (19714 43298)) +;;;;;; "gnus-bookmark" "gnus/gnus-bookmark.el" (19780 4513)) ;;; Generated autoloads from gnus/gnus-bookmark.el (autoload 'gnus-bookmark-set "gnus-bookmark" "\ @@ -11164,8 +11330,8 @@ deletion, or > if it is flagged for displaying. ;;;### (autoloads (gnus-cache-delete-group gnus-cache-rename-group ;;;;;; gnus-cache-generate-nov-databases gnus-cache-generate-active -;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (19714 -;;;;;; 43298)) +;;;;;; gnus-jog-cache) "gnus-cache" "gnus/gnus-cache.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from gnus/gnus-cache.el (autoload 'gnus-jog-cache "gnus-cache" "\ @@ -11207,7 +11373,7 @@ supported. ;;;*** ;;;### (autoloads (gnus-delay-initialize gnus-delay-send-queue gnus-delay-article) -;;;;;; "gnus-delay" "gnus/gnus-delay.el" (19714 43298)) +;;;;;; "gnus-delay" "gnus/gnus-delay.el" (19780 4513)) ;;; Generated autoloads from gnus/gnus-delay.el (autoload 'gnus-delay-article "gnus-delay" "\ @@ -11243,7 +11409,7 @@ Checking delayed messages is skipped if optional arg NO-CHECK is non-nil. ;;;*** ;;;### (autoloads (gnus-user-format-function-D gnus-user-format-function-d) -;;;;;; "gnus-diary" "gnus/gnus-diary.el" (19714 43298)) +;;;;;; "gnus-diary" "gnus/gnus-diary.el" (19775 2028)) ;;; Generated autoloads from gnus/gnus-diary.el (autoload 'gnus-user-format-function-d "gnus-diary" "\ @@ -11259,7 +11425,7 @@ Not documented ;;;*** ;;;### (autoloads (turn-on-gnus-dired-mode) "gnus-dired" "gnus/gnus-dired.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/gnus-dired.el (autoload 'turn-on-gnus-dired-mode "gnus-dired" "\ @@ -11270,7 +11436,7 @@ Convenience method to turn on gnus-dired-mode. ;;;*** ;;;### (autoloads (gnus-draft-reminder) "gnus-draft" "gnus/gnus-draft.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4513)) ;;; Generated autoloads from gnus/gnus-draft.el (autoload 'gnus-draft-reminder "gnus-draft" "\ @@ -11282,8 +11448,8 @@ Reminder user if there are unsent drafts. ;;;### (autoloads (gnus-convert-png-to-face gnus-convert-face-to-png ;;;;;; gnus-face-from-file gnus-x-face-from-file gnus-insert-random-x-face-header -;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (19640 -;;;;;; 47194)) +;;;;;; gnus-random-x-face) "gnus-fun" "gnus/gnus-fun.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from gnus/gnus-fun.el (autoload 'gnus-random-x-face "gnus-fun" "\ @@ -11328,7 +11494,7 @@ FILE should be a PNG file that's 48x48 and smaller than or equal to ;;;*** ;;;### (autoloads (gnus-treat-mail-gravatar gnus-treat-from-gravatar) -;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (19717 39999)) +;;;;;; "gnus-gravatar" "gnus/gnus-gravatar.el" (19775 2028)) ;;; Generated autoloads from gnus/gnus-gravatar.el (autoload 'gnus-treat-from-gravatar "gnus-gravatar" "\ @@ -11346,7 +11512,7 @@ If gravatars are already displayed, remove them. ;;;*** ;;;### (autoloads (gnus-fetch-group-other-frame gnus-fetch-group) -;;;;;; "gnus-group" "gnus/gnus-group.el" (19714 43298)) +;;;;;; "gnus-group" "gnus/gnus-group.el" (19780 4513)) ;;; Generated autoloads from gnus/gnus-group.el (autoload 'gnus-fetch-group "gnus-group" "\ @@ -11364,7 +11530,7 @@ Pop up a frame and enter GROUP. ;;;*** ;;;### (autoloads (gnus-html-prefetch-images gnus-article-html) "gnus-html" -;;;;;; "gnus/gnus-html.el" (19714 43298)) +;;;;;; "gnus/gnus-html.el" (19775 2028)) ;;; Generated autoloads from gnus/gnus-html.el (autoload 'gnus-article-html "gnus-html" "\ @@ -11380,7 +11546,7 @@ Not documented ;;;*** ;;;### (autoloads (gnus-batch-score) "gnus-kill" "gnus/gnus-kill.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/gnus-kill.el (defalias 'gnus-batch-kill 'gnus-batch-score) @@ -11395,7 +11561,7 @@ Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score ;;;### (autoloads (gnus-mailing-list-mode gnus-mailing-list-insinuate ;;;;;; turn-on-gnus-mailing-list-mode) "gnus-ml" "gnus/gnus-ml.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/gnus-ml.el (autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" "\ @@ -11420,7 +11586,7 @@ Minor mode for providing mailing-list commands. ;;;### (autoloads (gnus-group-split-fancy gnus-group-split gnus-group-split-update ;;;;;; gnus-group-split-setup) "gnus-mlspl" "gnus/gnus-mlspl.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/gnus-mlspl.el (autoload 'gnus-group-split-setup "gnus-mlspl" "\ @@ -11521,7 +11687,7 @@ Calling (gnus-group-split-fancy nil nil \"mail.others\") returns: ;;;*** ;;;### (autoloads (gnus-button-reply gnus-button-mailto gnus-msg-mail) -;;;;;; "gnus-msg" "gnus/gnus-msg.el" (19714 43298)) +;;;;;; "gnus-msg" "gnus/gnus-msg.el" (19780 4513)) ;;; Generated autoloads from gnus/gnus-msg.el (autoload 'gnus-msg-mail "gnus-msg" "\ @@ -11529,7 +11695,7 @@ Start editing a mail message to be sent. Like `message-mail', but with Gnus paraphernalia, particularly the Gcc: header for archiving purposes. -\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-ACTION YANK-ACTION SEND-ACTIONS)" t nil) +\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-ACTION YANK-ACTION SEND-ACTIONS RETURN-ACTION)" t nil) (autoload 'gnus-button-mailto "gnus-msg" "\ Mail to ADDRESS. @@ -11547,7 +11713,7 @@ Like `message-reply'. ;;;### (autoloads (gnus-treat-newsgroups-picon gnus-treat-mail-picon ;;;;;; gnus-treat-from-picon) "gnus-picon" "gnus/gnus-picon.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/gnus-picon.el (autoload 'gnus-treat-from-picon "gnus-picon" "\ @@ -11574,7 +11740,7 @@ If picons are already displayed, remove them. ;;;;;; gnus-sorted-nintersection gnus-sorted-range-intersection ;;;;;; gnus-sorted-intersection gnus-intersection gnus-sorted-complement ;;;;;; gnus-sorted-ndifference gnus-sorted-difference) "gnus-range" -;;;;;; "gnus/gnus-range.el" (19619 52030)) +;;;;;; "gnus/gnus-range.el" (19775 2028)) ;;; Generated autoloads from gnus/gnus-range.el (autoload 'gnus-sorted-difference "gnus-range" "\ @@ -11642,7 +11808,7 @@ Add NUM into sorted LIST by side effect. ;;;*** ;;;### (autoloads (gnus-registry-install-hooks gnus-registry-initialize) -;;;;;; "gnus-registry" "gnus/gnus-registry.el" (19714 43298)) +;;;;;; "gnus-registry" "gnus/gnus-registry.el" (19775 2028)) ;;; Generated autoloads from gnus/gnus-registry.el (autoload 'gnus-registry-initialize "gnus-registry" "\ @@ -11658,8 +11824,8 @@ Install the registry hooks. ;;;*** ;;;### (autoloads (gnus-sieve-article-add-rule gnus-sieve-generate -;;;;;; gnus-sieve-update) "gnus-sieve" "gnus/gnus-sieve.el" (19598 -;;;;;; 13691)) +;;;;;; gnus-sieve-update) "gnus-sieve" "gnus/gnus-sieve.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from gnus/gnus-sieve.el (autoload 'gnus-sieve-update "gnus-sieve" "\ @@ -11687,7 +11853,7 @@ Not documented ;;;*** ;;;### (autoloads (gnus-update-format) "gnus-spec" "gnus/gnus-spec.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/gnus-spec.el (autoload 'gnus-update-format "gnus-spec" "\ @@ -11698,7 +11864,7 @@ Update the format specification near point. ;;;*** ;;;### (autoloads (gnus-declare-backend) "gnus-start" "gnus/gnus-start.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/gnus-start.el (autoload 'gnus-declare-backend "gnus-start" "\ @@ -11709,7 +11875,7 @@ Declare back end NAME with ABILITIES as a Gnus back end. ;;;*** ;;;### (autoloads (gnus-summary-bookmark-jump) "gnus-sum" "gnus/gnus-sum.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4513)) ;;; Generated autoloads from gnus/gnus-sum.el (autoload 'gnus-summary-bookmark-jump "gnus-sum" "\ @@ -11721,7 +11887,7 @@ BOOKMARK is a bookmark name or a bookmark record. ;;;*** ;;;### (autoloads (gnus-sync-install-hooks gnus-sync-initialize) -;;;;;; "gnus-sync" "gnus/gnus-sync.el" (19640 47194)) +;;;;;; "gnus-sync" "gnus/gnus-sync.el" (19775 2028)) ;;; Generated autoloads from gnus/gnus-sync.el (autoload 'gnus-sync-initialize "gnus-sync" "\ @@ -11737,7 +11903,7 @@ Install the sync hooks. ;;;*** ;;;### (autoloads (gnus-add-configuration) "gnus-win" "gnus/gnus-win.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4513)) ;;; Generated autoloads from gnus/gnus-win.el (autoload 'gnus-add-configuration "gnus-win" "\ @@ -11747,7 +11913,7 @@ Add the window configuration CONF to `gnus-buffer-configuration'. ;;;*** -;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (19714 43298)) +;;;### (autoloads (gomoku) "gomoku" "play/gomoku.el" (19775 2029)) ;;; Generated autoloads from play/gomoku.el (autoload 'gomoku "gomoku" "\ @@ -11774,8 +11940,8 @@ Use \\[describe-mode] for more info. ;;;*** ;;;### (autoloads (goto-address-prog-mode goto-address-mode goto-address -;;;;;; goto-address-at-point) "goto-addr" "net/goto-addr.el" (19562 -;;;;;; 42953)) +;;;;;; goto-address-at-point) "goto-addr" "net/goto-addr.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from net/goto-addr.el (define-obsolete-function-alias 'goto-address-at-mouse 'goto-address-at-point "22.1") @@ -11813,8 +11979,8 @@ Turn on `goto-address-mode', but only in comments and strings. ;;;*** -;;;### (autoloads (gravatar-retrieve) "gravatar" "gnus/gravatar.el" -;;;;;; (19640 47194)) +;;;### (autoloads (gravatar-retrieve-synchronously gravatar-retrieve) +;;;;;; "gravatar" "gnus/gravatar.el" (19775 2028)) ;;; Generated autoloads from gnus/gravatar.el (autoload 'gravatar-retrieve "gravatar" "\ @@ -11823,11 +11989,16 @@ You can provide a list of argument to pass to CB in CBARGS. \(fn MAIL-ADDRESS CB &optional CBARGS)" nil nil) +(autoload 'gravatar-retrieve-synchronously "gravatar" "\ +Retrieve MAIL-ADDRESS gravatar and returns it. + +\(fn MAIL-ADDRESS)" nil nil) + ;;;*** ;;;### (autoloads (zrgrep rgrep lgrep grep-find grep grep-mode grep-compute-defaults ;;;;;; grep-process-setup grep-setup-hook grep-find-command grep-command -;;;;;; grep-window-height) "grep" "progmodes/grep.el" (19714 43298)) +;;;;;; grep-window-height) "grep" "progmodes/grep.el" (19780 4514)) ;;; Generated autoloads from progmodes/grep.el (defvar grep-window-height nil "\ @@ -11860,7 +12031,7 @@ List of hook functions run by `grep-process-setup' (see `run-hooks').") (custom-autoload 'grep-setup-hook "grep" t) -(defconst grep-regexp-alist '(("^\\(.+?\\)\\(:[ ]*\\)\\([0-9]+\\)\\2" 1 3) ("^\\(\\(.+?\\):\\([1-9][0-9]*\\):\\).*?\\(\\[01;31m\\(?:\\[K\\)?\\)\\(.*?\\)\\(\\[[0-9]*m\\)" 2 3 ((lambda nil (setq compilation-error-screen-columns nil) (- (match-beginning 4) (match-end 1))) lambda nil (- (match-end 5) (match-end 1) (- (match-end 4) (match-beginning 4)))) nil 1) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ +(defconst grep-regexp-alist '(("^\\(.+?\\)\\(:[ ]*\\)\\([1-9][0-9]*\\)\\2" 1 3) ("^\\(\\(.+?\\):\\([1-9][0-9]*\\):\\).*?\\(\\[01;31m\\(?:\\[K\\)?\\)\\(.*?\\)\\(\\[[0-9]*m\\)" 2 3 ((lambda nil (setq compilation-error-screen-columns nil) (- (match-beginning 4) (match-end 1))) lambda nil (- (match-end 5) (match-end 1) (- (match-end 4) (match-beginning 4)))) nil 1) ("^Binary file \\(.+\\) matches$" 1 nil nil 0 1)) "\ Regexp used to match grep hits. See `compilation-error-regexp-alist'.") (defvar grep-program (purecopy "grep") "\ @@ -11983,7 +12154,7 @@ file name to `*.gz', and sets `grep-highlight-matches' to `always'. ;;;*** -;;;### (autoloads (gs-load-image) "gs" "gs.el" (19562 42953)) +;;;### (autoloads (gs-load-image) "gs" "gs.el" (19775 2028)) ;;; Generated autoloads from gs.el (autoload 'gs-load-image "gs" "\ @@ -11997,7 +12168,7 @@ the form \"WINDOW-ID PIXMAP-ID\". Value is non-nil if successful. ;;;*** ;;;### (autoloads (gud-tooltip-mode gdb-script-mode jdb pdb perldb -;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (19714 43298)) +;;;;;; xdb dbx sdb gud-gdb) "gud" "progmodes/gud.el" (19775 2029)) ;;; Generated autoloads from progmodes/gud.el (autoload 'gud-gdb "gud" "\ @@ -12083,8 +12254,8 @@ Toggle the display of GUD tooltips. ;;;*** -;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (handwrite) "handwrite" "play/handwrite.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from play/handwrite.el (autoload 'handwrite "handwrite" "\ @@ -12102,7 +12273,7 @@ Variables: handwrite-linespace (default 12) ;;;*** ;;;### (autoloads (hanoi-unix-64 hanoi-unix hanoi) "hanoi" "play/hanoi.el" -;;;;;; (19562 42953)) +;;;;;; (19763 27287)) ;;; Generated autoloads from play/hanoi.el (autoload 'hanoi "hanoi" "\ @@ -12131,7 +12302,7 @@ to be updated. ;;;### (autoloads (mail-check-payment mail-add-payment-async mail-add-payment ;;;;;; hashcash-verify-payment hashcash-insert-payment-async hashcash-insert-payment) -;;;;;; "hashcash" "mail/hashcash.el" (19640 47194)) +;;;;;; "hashcash" "mail/hashcash.el" (19780 4513)) ;;; Generated autoloads from mail/hashcash.el (autoload 'hashcash-insert-payment "hashcash" "\ @@ -12176,7 +12347,7 @@ Prefix arg sets default accept amount temporarily. ;;;### (autoloads (scan-buf-previous-region scan-buf-next-region ;;;;;; scan-buf-move-to-region help-at-pt-display-when-idle help-at-pt-set-timer ;;;;;; help-at-pt-cancel-timer display-local-help help-at-pt-kbd-string -;;;;;; help-at-pt-string) "help-at-pt" "help-at-pt.el" (19562 42953)) +;;;;;; help-at-pt-string) "help-at-pt" "help-at-pt.el" (19775 2028)) ;;; Generated autoloads from help-at-pt.el (autoload 'help-at-pt-string "help-at-pt" "\ @@ -12306,7 +12477,7 @@ different regions. With numeric argument ARG, behaves like ;;;### (autoloads (doc-file-to-info doc-file-to-man describe-categories ;;;;;; describe-syntax describe-variable variable-at-point describe-function-1 ;;;;;; find-lisp-object-file-name help-C-file-name describe-function) -;;;;;; "help-fns" "help-fns.el" (19714 43298)) +;;;;;; "help-fns" "help-fns.el" (19775 2028)) ;;; Generated autoloads from help-fns.el (autoload 'describe-function "help-fns" "\ @@ -12386,7 +12557,7 @@ Produce a texinfo buffer with sorted doc-strings from the DOC file. ;;;*** ;;;### (autoloads (three-step-help) "help-macro" "help-macro.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from help-macro.el (defvar three-step-help nil "\ @@ -12402,8 +12573,8 @@ gives the window that lists the options.") ;;;### (autoloads (help-xref-on-pp help-insert-xref-button help-xref-button ;;;;;; help-make-xrefs help-buffer help-setup-xref help-mode-finish -;;;;;; help-mode-setup help-mode) "help-mode" "help-mode.el" (19640 -;;;;;; 47194)) +;;;;;; help-mode-setup help-mode) "help-mode" "help-mode.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from help-mode.el (autoload 'help-mode "help-mode" "\ @@ -12495,7 +12666,7 @@ Add xrefs for symbols in `pp's output between FROM and TO. ;;;*** ;;;### (autoloads (Helper-help Helper-describe-bindings) "helper" -;;;;;; "emacs-lisp/helper.el" (19598 13691)) +;;;;;; "emacs-lisp/helper.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/helper.el (autoload 'Helper-describe-bindings "helper" "\ @@ -12511,7 +12682,7 @@ Provide help for current mode. ;;;*** ;;;### (autoloads (hexlify-buffer hexl-find-file hexl-mode) "hexl" -;;;;;; "hexl.el" (19714 43298)) +;;;;;; "hexl.el" (19775 2028)) ;;; Generated autoloads from hexl.el (autoload 'hexl-mode "hexl" "\ @@ -12608,7 +12779,7 @@ This discards the buffer's undo information. ;;;### (autoloads (hi-lock-write-interactive-patterns hi-lock-unface-buffer ;;;;;; hi-lock-face-phrase-buffer hi-lock-face-buffer hi-lock-line-face-buffer ;;;;;; global-hi-lock-mode hi-lock-mode) "hi-lock" "hi-lock.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2028)) ;;; Generated autoloads from hi-lock.el (autoload 'hi-lock-mode "hi-lock" "\ @@ -12742,7 +12913,7 @@ be found in variable `hi-lock-interactive-patterns'. ;;;*** ;;;### (autoloads (hide-ifdef-mode) "hideif" "progmodes/hideif.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/hideif.el (autoload 'hide-ifdef-mode "hideif" "\ @@ -12782,7 +12953,7 @@ how the hiding is done: ;;;*** ;;;### (autoloads (turn-off-hideshow hs-minor-mode) "hideshow" "progmodes/hideshow.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/hideshow.el (defvar hs-special-modes-alist (mapcar 'purecopy '((c-mode "{" "}" "/[*/]" nil nil) (c++-mode "{" "}" "/[*/]" nil nil) (bibtex-mode ("@\\S(*\\(\\s(\\)" 1)) (java-mode "{" "}" "/[*/]" nil nil) (js-mode "{" "}" "/[*/]" nil))) "\ @@ -12844,8 +13015,8 @@ Unconditionally turn off `hs-minor-mode'. ;;;;;; highlight-compare-buffers highlight-changes-rotate-faces ;;;;;; highlight-changes-previous-change highlight-changes-next-change ;;;;;; highlight-changes-remove-highlight highlight-changes-visible-mode -;;;;;; highlight-changes-mode) "hilit-chg" "hilit-chg.el" (19640 -;;;;;; 47194)) +;;;;;; highlight-changes-mode) "hilit-chg" "hilit-chg.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from hilit-chg.el (autoload 'highlight-changes-mode "hilit-chg" "\ @@ -12974,7 +13145,7 @@ See `highlight-changes-mode' for more information on Highlight-Changes mode. ;;;;;; hippie-expand-ignore-buffers hippie-expand-max-buffers hippie-expand-no-restriction ;;;;;; hippie-expand-dabbrev-as-symbol hippie-expand-dabbrev-skip-space ;;;;;; hippie-expand-verbose hippie-expand-try-functions-list) "hippie-exp" -;;;;;; "hippie-exp.el" (19714 43298)) +;;;;;; "hippie-exp.el" (19775 2028)) ;;; Generated autoloads from hippie-exp.el (defvar hippie-expand-try-functions-list '(try-complete-file-name-partially try-complete-file-name try-expand-all-abbrevs try-expand-list try-expand-line try-expand-dabbrev try-expand-dabbrev-all-buffers try-expand-dabbrev-from-kill try-complete-lisp-symbol-partially try-complete-lisp-symbol) "\ @@ -13047,7 +13218,7 @@ argument VERBOSE non-nil makes the function verbose. ;;;*** ;;;### (autoloads (global-hl-line-mode hl-line-mode) "hl-line" "hl-line.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from hl-line.el (autoload 'hl-line-mode "hl-line" "\ @@ -13091,7 +13262,7 @@ Global-Hl-Line mode uses the functions `global-hl-line-unhighlight' and ;;;;;; holiday-bahai-holidays holiday-islamic-holidays holiday-christian-holidays ;;;;;; holiday-hebrew-holidays holiday-other-holidays holiday-local-holidays ;;;;;; holiday-oriental-holidays holiday-general-holidays) "holidays" -;;;;;; "calendar/holidays.el" (19714 43298)) +;;;;;; "calendar/holidays.el" (19775 2027)) ;;; Generated autoloads from calendar/holidays.el (define-obsolete-variable-alias 'general-holidays 'holiday-general-holidays "23.1") @@ -13239,8 +13410,8 @@ The optional LABEL is used to label the buffer created. ;;;*** -;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (html2text) "html2text" "gnus/html2text.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from gnus/html2text.el (autoload 'html2text "html2text" "\ @@ -13251,7 +13422,7 @@ Convert HTML to plain text in the current buffer. ;;;*** ;;;### (autoloads (htmlfontify-copy-and-link-dir htmlfontify-buffer) -;;;;;; "htmlfontify" "htmlfontify.el" (19640 47194)) +;;;;;; "htmlfontify" "htmlfontify.el" (19780 4513)) ;;; Generated autoloads from htmlfontify.el (autoload 'htmlfontify-buffer "htmlfontify" "\ @@ -13284,8 +13455,8 @@ You may also want to set `hfy-page-header' and `hfy-page-footer'. ;;;*** ;;;### (autoloads (define-ibuffer-filter define-ibuffer-op define-ibuffer-sorter -;;;;;; define-ibuffer-column) "ibuf-macs" "ibuf-macs.el" (19598 -;;;;;; 13691)) +;;;;;; define-ibuffer-column) "ibuf-macs" "ibuf-macs.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from ibuf-macs.el (autoload 'define-ibuffer-column "ibuf-macs" "\ @@ -13382,7 +13553,7 @@ bound to the current value of the filter. ;;;*** ;;;### (autoloads (ibuffer ibuffer-other-window ibuffer-list-buffers) -;;;;;; "ibuffer" "ibuffer.el" (19714 43298)) +;;;;;; "ibuffer" "ibuffer.el" (19780 4513)) ;;; Generated autoloads from ibuffer.el (autoload 'ibuffer-list-buffers "ibuffer" "\ @@ -13423,7 +13594,7 @@ FORMATS is the value to use for `ibuffer-formats'. ;;;### (autoloads (icalendar-import-buffer icalendar-import-file ;;;;;; icalendar-export-region icalendar-export-file) "icalendar" -;;;;;; "calendar/icalendar.el" (19598 13691)) +;;;;;; "calendar/icalendar.el" (19780 4513)) ;;; Generated autoloads from calendar/icalendar.el (autoload 'icalendar-export-file "icalendar" "\ @@ -13475,8 +13646,8 @@ buffer `*icalendar-errors*'. ;;;*** -;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (19591 -;;;;;; 62571)) +;;;### (autoloads (icomplete-mode) "icomplete" "icomplete.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from icomplete.el (defvar icomplete-mode nil "\ @@ -13497,7 +13668,7 @@ otherwise turn it off. ;;;*** -;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (19714 43298)) +;;;### (autoloads (icon-mode) "icon" "progmodes/icon.el" (19775 2029)) ;;; Generated autoloads from progmodes/icon.el (autoload 'icon-mode "icon" "\ @@ -13538,7 +13709,7 @@ with no args, if that value is non-nil. ;;;*** ;;;### (autoloads (idlwave-shell) "idlw-shell" "progmodes/idlw-shell.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/idlw-shell.el (autoload 'idlwave-shell "idlw-shell" "\ @@ -13564,7 +13735,7 @@ See also the variable `idlwave-shell-prompt-pattern'. ;;;*** ;;;### (autoloads (idlwave-mode) "idlwave" "progmodes/idlwave.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/idlwave.el (autoload 'idlwave-mode "idlwave" "\ @@ -13698,8 +13869,8 @@ The main features of this mode are ;;;;;; ido-find-alternate-file ido-find-file-other-window ido-find-file ;;;;;; ido-find-file-in-dir ido-switch-buffer-other-frame ido-insert-buffer ;;;;;; ido-kill-buffer ido-display-buffer ido-switch-buffer-other-window -;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (19619 -;;;;;; 52030)) +;;;;;; ido-switch-buffer ido-mode ido-mode) "ido" "ido.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from ido.el (defvar ido-mode nil "\ @@ -13960,7 +14131,7 @@ DEF, if non-nil, is the default value. ;;;*** -;;;### (autoloads (ielm) "ielm" "ielm.el" (19720 64949)) +;;;### (autoloads (ielm) "ielm" "ielm.el" (19775 2028)) ;;; Generated autoloads from ielm.el (add-hook 'same-window-buffer-names (purecopy "*ielm*")) @@ -13972,7 +14143,7 @@ Switches to the buffer `*ielm*', or creates it if it does not exist. ;;;*** -;;;### (autoloads (iimage-mode) "iimage" "iimage.el" (19640 47194)) +;;;### (autoloads (iimage-mode) "iimage" "iimage.el" (19780 4513)) ;;; Generated autoloads from iimage.el (define-obsolete-function-alias 'turn-on-iimage-mode 'iimage-mode "24.1") @@ -13989,7 +14160,7 @@ Toggle inline image minor mode. ;;;;;; put-image create-image image-type-auto-detected-p image-type-available-p ;;;;;; image-type image-type-from-file-name image-type-from-file-header ;;;;;; image-type-from-buffer image-type-from-data) "image" "image.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from image.el (autoload 'image-type-from-data "image" "\ @@ -14195,7 +14366,7 @@ Register the file types that ImageMagick is able to handle. ;;;;;; image-dired-jump-thumbnail-buffer image-dired-delete-tag ;;;;;; image-dired-tag-files image-dired-show-all-from-dir image-dired-display-thumbs ;;;;;; image-dired-dired-with-window-configuration image-dired-dired-toggle-marked-thumbs) -;;;;;; "image-dired" "image-dired.el" (19562 42953)) +;;;;;; "image-dired" "image-dired.el" (19780 45051)) ;;; Generated autoloads from image-dired.el (autoload 'image-dired-dired-toggle-marked-thumbs "image-dired" "\ @@ -14333,7 +14504,7 @@ easy-to-use form. ;;;### (autoloads (auto-image-file-mode insert-image-file image-file-name-regexp ;;;;;; image-file-name-regexps image-file-name-extensions) "image-file" -;;;;;; "image-file.el" (19562 42953)) +;;;;;; "image-file.el" (19775 2028)) ;;; Generated autoloads from image-file.el (defvar image-file-name-extensions (purecopy '("png" "jpeg" "jpg" "gif" "tiff" "tif" "xbm" "xpm" "pbm" "pgm" "ppm" "pnm" "svg")) "\ @@ -14395,7 +14566,7 @@ Image files are those whose name has an extension in ;;;*** ;;;### (autoloads (image-bookmark-jump image-mode-as-text image-minor-mode -;;;;;; image-mode) "image-mode" "image-mode.el" (19619 52030)) +;;;;;; image-mode) "image-mode" "image-mode.el" (19780 4513)) ;;; Generated autoloads from image-mode.el (autoload 'image-mode "image-mode" "\ @@ -14436,7 +14607,7 @@ Not documented ;;;*** ;;;### (autoloads (imenu imenu-add-menubar-index imenu-add-to-menubar -;;;;;; imenu-sort-function) "imenu" "imenu.el" (19619 52030)) +;;;;;; imenu-sort-function) "imenu" "imenu.el" (19775 2028)) ;;; Generated autoloads from imenu.el (defvar imenu-sort-function nil "\ @@ -14553,7 +14724,7 @@ for more information. ;;;### (autoloads (indian-2-column-to-ucs-region in-is13194-pre-write-conversion ;;;;;; in-is13194-post-read-conversion indian-compose-string indian-compose-region) -;;;;;; "ind-util" "language/ind-util.el" (19562 42953)) +;;;;;; "ind-util" "language/ind-util.el" (19780 4513)) ;;; Generated autoloads from language/ind-util.el (autoload 'indian-compose-region "ind-util" "\ @@ -14585,7 +14756,7 @@ Convert old Emacs Devanagari characters to UCS. ;;;### (autoloads (inferior-lisp inferior-lisp-prompt inferior-lisp-load-command ;;;;;; inferior-lisp-program inferior-lisp-filter-regexp) "inf-lisp" -;;;;;; "progmodes/inf-lisp.el" (19714 43298)) +;;;;;; "progmodes/inf-lisp.el" (19780 4514)) ;;; Generated autoloads from progmodes/inf-lisp.el (defvar inferior-lisp-filter-regexp (purecopy "\\`\\s *\\(:\\(\\w\\|\\s_\\)\\)?\\s *\\'") "\ @@ -14653,7 +14824,7 @@ of `inferior-lisp-program'). Runs the hooks from ;;;;;; Info-goto-emacs-command-node Info-mode info-finder info-apropos ;;;;;; Info-index Info-directory Info-on-current-buffer info-standalone ;;;;;; info-emacs-manual info info-other-window) "info" "info.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from info.el (autoload 'info-other-window "info" "\ @@ -14835,7 +15006,7 @@ type returned by `Info-bookmark-make-record', which see. ;;;### (autoloads (info-complete-file info-complete-symbol info-lookup-file ;;;;;; info-lookup-symbol info-lookup-reset) "info-look" "info-look.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2028)) ;;; Generated autoloads from info-look.el (autoload 'info-lookup-reset "info-look" "\ @@ -14882,35 +15053,92 @@ Perform completion on file preceding point. ;;;*** -;;;### (autoloads (info-xref-check-all-custom info-xref-check-all -;;;;;; info-xref-check) "info-xref" "info-xref.el" (19562 42953)) +;;;### (autoloads (info-xref-docstrings info-xref-check-all-custom +;;;;;; info-xref-check-all info-xref-check) "info-xref" "info-xref.el" +;;;;;; (19780 4513)) ;;; Generated autoloads from info-xref.el (autoload 'info-xref-check "info-xref" "\ Check external references in FILENAME, an info document. +Interactively from an `Info-mode' or `texinfo-mode' buffer the +current info file is the default. + +Results are shown in a `compilation-mode' buffer. The format is +a bit rough, but there shouldn't be many problems normally. The +file:line:column: is the info document, but of course normally +any correction should be made in the original .texi file. +Finding the right place in the .texi is a manual process. + +When a target info file doesn't exist there's obviously no way to +validate node references within it. A message is given for +missing target files once per source document. It could be +simply that you don't have the target installed, or it could be a +mistake in the reference. + +Indirect info files are understood, just pass the top-level +foo.info to `info-xref-check' and it traverses all sub-files. +Compressed info files are accepted too as usual for `Info-mode'. + +\"makeinfo\" checks references internal to an info document, but +not external references, which makes it rather easy for mistakes +to creep in or node name changes to go unnoticed. +`Info-validate' doesn't check external references either. \(fn FILENAME)" t nil) (autoload 'info-xref-check-all "info-xref" "\ -Check external references in all info documents in the usual path. -The usual path is `Info-directory-list' and `Info-additional-directory-list'. +Check external references in all info documents in the info path. +`Info-directory-list' and `Info-additional-directory-list' are +the info paths. See `info-xref-check' for how each file is +checked. + +The search for \"all\" info files is rather permissive, since +info files don't necessarily have a \".info\" extension and in +particular the Emacs manuals normally don't. If you have a +source code directory in `Info-directory-list' then a lot of +extraneous files might be read. This will be time consuming but +should be harmless. \(fn)" t nil) (autoload 'info-xref-check-all-custom "info-xref" "\ Check info references in all customize groups and variables. -`custom-manual' and `info-link' entries in the `custom-links' list are checked. +Info references can be in `custom-manual' or `info-link' entries +of the `custom-links' for a variable. -`custom-load' autoloads for all symbols are loaded in order to get all the -link information. This will be a lot of lisp packages loaded, and can take -quite a while. +Any `custom-load' autoloads in variables are loaded in order to +get full link information. This will be a lot of Lisp packages +and can take a long time. \(fn)" t nil) +(autoload 'info-xref-docstrings "info-xref" "\ +Check docstring info node references in source files. +The given files are searched for docstring hyperlinks like + + Info node `(elisp)Documentation Tips' + +and those links checked by attempting to visit the target nodes +as per `info-xref-check' does. + +Interactively filenames are read as a wildcard pattern like +\"foo*.el\", with the current file as a default. Usually this +will be lisp sources, but anything with such hyperlinks can be +checked, including the Emacs .c sources (or the etc/DOC file of +all builtins). + +Because info node hyperlinks are found by a simple regexp search +in the files, the Lisp code checked doesn't have to be loaded, +and links can be in the file commentary or elsewhere too. Even +.elc files can usually be checked successfully if you don't have +the sources handy. + +\(fn FILENAME-LIST)" t nil) + ;;;*** ;;;### (autoloads (batch-info-validate Info-validate Info-split Info-split-threshold -;;;;;; Info-tagify) "informat" "informat.el" (19591 62571)) +;;;;;; Info-tagify) "informat" "informat.el" (19775 2028)) ;;; Generated autoloads from informat.el (autoload 'Info-tagify "informat" "\ @@ -14957,7 +15185,7 @@ For example, invoke \"emacs -batch -f batch-info-validate $info/ ~/*.info\" ;;;### (autoloads (isearch-process-search-multibyte-characters isearch-toggle-input-method ;;;;;; isearch-toggle-specified-input-method) "isearch-x" "international/isearch-x.el" -;;;;;; (19562 42953)) +;;;;;; (19780 4513)) ;;; Generated autoloads from international/isearch-x.el (autoload 'isearch-toggle-specified-input-method "isearch-x" "\ @@ -14977,8 +15205,8 @@ Not documented ;;;*** -;;;### (autoloads (isearchb-activate) "isearchb" "isearchb.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (isearchb-activate) "isearchb" "isearchb.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from isearchb.el (autoload 'isearchb-activate "isearchb" "\ @@ -14994,7 +15222,7 @@ accessed via isearchb. ;;;### (autoloads (iso-cvt-define-menu iso-cvt-write-only iso-cvt-read-only ;;;;;; iso-sgml2iso iso-iso2sgml iso-iso2duden iso-iso2gtex iso-gtex2iso ;;;;;; iso-tex2iso iso-iso2tex iso-german iso-spanish) "iso-cvt" -;;;;;; "international/iso-cvt.el" (19562 42953)) +;;;;;; "international/iso-cvt.el" (19775 2028)) ;;; Generated autoloads from international/iso-cvt.el (autoload 'iso-spanish "iso-cvt" "\ @@ -15085,7 +15313,7 @@ Add submenus to the File menu, to convert to and from various formats. ;;;*** ;;;### (autoloads nil "iso-transl" "international/iso-transl.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2028)) ;;; Generated autoloads from international/iso-transl.el (or key-translation-map (setq key-translation-map (make-sparse-keymap))) (define-key key-translation-map "\C-x8" 'iso-transl-ctl-x-8-map) @@ -15097,7 +15325,7 @@ Add submenus to the File menu, to convert to and from various formats. ;;;;;; ispell-complete-word ispell-continue ispell-buffer ispell-comments-and-strings ;;;;;; ispell-region ispell-change-dictionary ispell-kill-ispell ;;;;;; ispell-help ispell-pdict-save ispell-word ispell-personal-dictionary) -;;;;;; "ispell" "textmodes/ispell.el" (19714 43298)) +;;;;;; "ispell" "textmodes/ispell.el" (19780 4514)) ;;; Generated autoloads from textmodes/ispell.el (put 'ispell-check-comments 'safe-local-variable (lambda (a) (memq a '(nil t exclusive)))) @@ -15317,8 +15545,8 @@ You can bind this to the key C-c i in GNUS or mail by adding to ;;;*** -;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (iswitchb-mode) "iswitchb" "iswitchb.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from iswitchb.el (defvar iswitchb-mode nil "\ @@ -15343,7 +15571,7 @@ This mode enables switching between buffers using substrings. See ;;;### (autoloads (read-hiragana-string japanese-zenkaku-region japanese-hankaku-region ;;;;;; japanese-hiragana-region japanese-katakana-region japanese-zenkaku ;;;;;; japanese-hankaku japanese-hiragana japanese-katakana setup-japanese-environment-internal) -;;;;;; "japan-util" "language/japan-util.el" (19562 42953)) +;;;;;; "japan-util" "language/japan-util.el" (19780 4513)) ;;; Generated autoloads from language/japan-util.el (autoload 'setup-japanese-environment-internal "japan-util" "\ @@ -15421,7 +15649,7 @@ If non-nil, second arg INITIAL-INPUT is a string to insert before reading. ;;;*** ;;;### (autoloads (jka-compr-uninstall jka-compr-handler) "jka-compr" -;;;;;; "jka-compr.el" (19562 42953)) +;;;;;; "jka-compr.el" (19775 2028)) ;;; Generated autoloads from jka-compr.el (defvar jka-compr-inhibit nil "\ @@ -15444,7 +15672,7 @@ by `jka-compr-installed'. ;;;*** -;;;### (autoloads (js-mode) "js" "progmodes/js.el" (19714 43298)) +;;;### (autoloads (js-mode) "js" "progmodes/js.el" (19775 2029)) ;;; Generated autoloads from progmodes/js.el (autoload 'js-mode "js" "\ @@ -15458,7 +15686,7 @@ Major mode for editing JavaScript. ;;;### (autoloads (keypad-setup keypad-numlock-shifted-setup keypad-shifted-setup ;;;;;; keypad-numlock-setup keypad-setup) "keypad" "emulation/keypad.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emulation/keypad.el (defvar keypad-setup nil "\ @@ -15514,7 +15742,7 @@ the decimal key on the keypad is mapped to DECIMAL instead of `.' ;;;*** ;;;### (autoloads (kinsoku) "kinsoku" "international/kinsoku.el" -;;;;;; (19562 42953)) +;;;;;; (19780 4513)) ;;; Generated autoloads from international/kinsoku.el (autoload 'kinsoku "kinsoku" "\ @@ -15535,8 +15763,8 @@ the context of text formatting. ;;;*** -;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (19619 -;;;;;; 52030)) +;;;### (autoloads (kkc-region) "kkc" "international/kkc.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from international/kkc.el (defvar kkc-after-update-conversion-functions nil "\ @@ -15561,7 +15789,7 @@ and the return value is the length of the conversion. ;;;### (autoloads (kmacro-end-call-mouse kmacro-end-and-call-macro ;;;;;; kmacro-end-or-call-macro kmacro-start-macro-or-insert-counter ;;;;;; kmacro-call-macro kmacro-end-macro kmacro-start-macro kmacro-exec-ring-item) -;;;;;; "kmacro" "kmacro.el" (19591 62571)) +;;;;;; "kmacro" "kmacro.el" (19780 4513)) ;;; Generated autoloads from kmacro.el (global-set-key "\C-x(" 'kmacro-start-macro) (global-set-key "\C-x)" 'kmacro-end-macro) @@ -15672,7 +15900,7 @@ If kbd macro currently being defined end it before activating it. ;;;*** ;;;### (autoloads (setup-korean-environment-internal) "korea-util" -;;;;;; "language/korea-util.el" (19562 42953)) +;;;;;; "language/korea-util.el" (19780 4513)) ;;; Generated autoloads from language/korea-util.el (defvar default-korean-keyboard (purecopy (if (string-match "3" (or (getenv "HANGUL_KEYBOARD_TYPE") "")) "3" "")) "\ @@ -15686,21 +15914,19 @@ Not documented ;;;*** -;;;### (autoloads (lm lm-test-run) "landmark" "play/landmark.el" -;;;;;; (19714 43298)) +;;;### (autoloads (landmark landmark-test-run) "landmark" "play/landmark.el" +;;;;;; (19775 2029)) ;;; Generated autoloads from play/landmark.el -(defalias 'landmark-repeat 'lm-test-run) +(defalias 'landmark-repeat 'landmark-test-run) -(autoload 'lm-test-run "landmark" "\ -Run 100 Lm games, each time saving the weights from the previous game. +(autoload 'landmark-test-run "landmark" "\ +Run 100 Landmark games, each time saving the weights from the previous game. \(fn)" t nil) -(defalias 'landmark 'lm) - -(autoload 'lm "landmark" "\ -Start or resume an Lm game. +(autoload 'landmark "landmark" "\ +Start or resume an Landmark game. If a game is in progress, this command allows you to resume it. Here is the relation between prefix args and game options: @@ -15711,7 +15937,7 @@ none / 1 | yes | no 3 | no | yes 4 | no | no -You start by moving to a square and typing \\[lm-start-robot], +You start by moving to a square and typing \\[landmark-start-robot], if you did not use a prefix arg to ask for automatic start. Use \\[describe-mode] for more info. @@ -15721,7 +15947,7 @@ Use \\[describe-mode] for more info. ;;;### (autoloads (lao-compose-region lao-composition-function lao-transcribe-roman-to-lao-string ;;;;;; lao-transcribe-single-roman-syllable-to-lao lao-compose-string) -;;;;;; "lao-util" "language/lao-util.el" (19562 42953)) +;;;;;; "lao-util" "language/lao-util.el" (19780 4513)) ;;; Generated autoloads from language/lao-util.el (autoload 'lao-compose-string "lao-util" "\ @@ -15760,7 +15986,7 @@ Not documented ;;;### (autoloads (latexenc-find-file-coding-system latexenc-coding-system-to-inputenc ;;;;;; latexenc-inputenc-to-coding-system latex-inputenc-coding-alist) -;;;;;; "latexenc" "international/latexenc.el" (19562 42953)) +;;;;;; "latexenc" "international/latexenc.el" (19775 2028)) ;;; Generated autoloads from international/latexenc.el (defvar latex-inputenc-coding-alist (purecopy '(("ansinew" . windows-1252) ("applemac" . mac-roman) ("ascii" . us-ascii) ("cp1250" . windows-1250) ("cp1252" . windows-1252) ("cp1257" . cp1257) ("cp437de" . cp437) ("cp437" . cp437) ("cp850" . cp850) ("cp852" . cp852) ("cp858" . cp858) ("cp865" . cp865) ("latin1" . iso-8859-1) ("latin2" . iso-8859-2) ("latin3" . iso-8859-3) ("latin4" . iso-8859-4) ("latin5" . iso-8859-5) ("latin9" . iso-8859-15) ("next" . next) ("utf8" . utf-8) ("utf8x" . utf-8))) "\ @@ -15792,7 +16018,7 @@ coding system names is determined from `latex-inputenc-coding-alist'. ;;;*** ;;;### (autoloads (latin1-display-ucs-per-lynx latin1-display latin1-display) -;;;;;; "latin1-disp" "international/latin1-disp.el" (19562 42953)) +;;;;;; "latin1-disp" "international/latin1-disp.el" (19780 4513)) ;;; Generated autoloads from international/latin1-disp.el (defvar latin1-display nil "\ @@ -15834,7 +16060,7 @@ use either \\[customize] or the function `latin1-display'.") ;;;*** ;;;### (autoloads (ld-script-mode) "ld-script" "progmodes/ld-script.el" -;;;;;; (19619 52030)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/ld-script.el (autoload 'ld-script-mode "ld-script" "\ @@ -15845,7 +16071,7 @@ A major mode to edit GNU ld script files ;;;*** ;;;### (autoloads (ledit-from-lisp-mode ledit-mode) "ledit" "ledit.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from ledit.el (defconst ledit-save-files t "\ @@ -15880,7 +16106,7 @@ Not documented ;;;*** -;;;### (autoloads (life) "life" "play/life.el" (19714 43298)) +;;;### (autoloads (life) "life" "play/life.el" (19775 2029)) ;;; Generated autoloads from play/life.el (autoload 'life "life" "\ @@ -15894,7 +16120,7 @@ generations (this defaults to 1). ;;;*** ;;;### (autoloads (global-linum-mode linum-mode linum-format) "linum" -;;;;;; "linum.el" (19598 13691)) +;;;;;; "linum.el" (19775 2028)) ;;; Generated autoloads from linum.el (defvar linum-format 'dynamic "\ @@ -15932,8 +16158,8 @@ See `linum-mode' for more information on Linum mode. ;;;*** -;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (19591 -;;;;;; 62571)) +;;;### (autoloads (unload-feature) "loadhist" "loadhist.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from loadhist.el (autoload 'unload-feature "loadhist" "\ @@ -15965,7 +16191,7 @@ something strange, such as redefining an Emacs function. ;;;*** ;;;### (autoloads (locate-with-filter locate locate-ls-subdir-switches) -;;;;;; "locate" "locate.el" (19714 43298)) +;;;;;; "locate" "locate.el" (19775 2028)) ;;; Generated autoloads from locate.el (defvar locate-ls-subdir-switches (purecopy "-al") "\ @@ -16017,7 +16243,7 @@ except that FILTER is not optional. ;;;*** -;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (19714 43298)) +;;;### (autoloads (log-edit) "log-edit" "vc/log-edit.el" (19775 2030)) ;;; Generated autoloads from vc/log-edit.el (autoload 'log-edit "log-edit" "\ @@ -16044,8 +16270,8 @@ uses the current buffer. ;;;*** -;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (19640 -;;;;;; 47194)) +;;;### (autoloads (log-view-mode) "log-view" "vc/log-view.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from vc/log-view.el (autoload 'log-view-mode "log-view" "\ @@ -16055,8 +16281,8 @@ Major mode for browsing CVS log output. ;;;*** -;;;### (autoloads (longlines-mode) "longlines" "longlines.el" (19591 -;;;;;; 62571)) +;;;### (autoloads (longlines-mode) "longlines" "longlines.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from longlines.el (autoload 'longlines-mode "longlines" "\ @@ -16077,8 +16303,8 @@ are indicated with a symbol. ;;;*** ;;;### (autoloads (print-region lpr-region print-buffer lpr-buffer -;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (19714 -;;;;;; 43298)) +;;;;;; lpr-command lpr-switches printer-name) "lpr" "lpr.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from lpr.el (defvar lpr-windows-system (memq system-type '(ms-dos windows-nt))) @@ -16172,7 +16398,7 @@ for further customization of the printer command. ;;;*** ;;;### (autoloads (ls-lisp-support-shell-wildcards) "ls-lisp" "ls-lisp.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from ls-lisp.el (defvar ls-lisp-support-shell-wildcards t "\ @@ -16183,8 +16409,8 @@ Otherwise they are treated as Emacs regexps (for backward compatibility).") ;;;*** -;;;### (autoloads (lunar-phases) "lunar" "calendar/lunar.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (lunar-phases) "lunar" "calendar/lunar.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from calendar/lunar.el (autoload 'lunar-phases "lunar" "\ @@ -16198,8 +16424,8 @@ This function is suitable for execution in a .emacs file. ;;;*** -;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (m4-mode) "m4-mode" "progmodes/m4-mode.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from progmodes/m4-mode.el (autoload 'm4-mode "m4-mode" "\ @@ -16210,7 +16436,7 @@ A major mode to edit m4 macro files. ;;;*** ;;;### (autoloads (macroexpand-all) "macroexp" "emacs-lisp/macroexp.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/macroexp.el (autoload 'macroexpand-all "macroexp" "\ @@ -16224,7 +16450,7 @@ definitions to shadow the loaded ones for use in file byte-compilation. ;;;*** ;;;### (autoloads (apply-macro-to-region-lines kbd-macro-query insert-kbd-macro -;;;;;; name-last-kbd-macro) "macros" "macros.el" (19598 13691)) +;;;;;; name-last-kbd-macro) "macros" "macros.el" (19780 4513)) ;;; Generated autoloads from macros.el (autoload 'name-last-kbd-macro "macros" "\ @@ -16313,7 +16539,7 @@ and then select the region of un-tablified names and use ;;;*** ;;;### (autoloads (what-domain mail-extract-address-components) "mail-extr" -;;;;;; "mail/mail-extr.el" (19714 43298)) +;;;;;; "mail/mail-extr.el" (19780 4513)) ;;; Generated autoloads from mail/mail-extr.el (autoload 'mail-extract-address-components "mail-extr" "\ @@ -16345,7 +16571,7 @@ Convert mail domain DOMAIN to the country it corresponds to. ;;;### (autoloads (mail-hist-put-headers-into-history mail-hist-keep-history ;;;;;; mail-hist-enable mail-hist-define-keys) "mail-hist" "mail/mail-hist.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from mail/mail-hist.el (autoload 'mail-hist-define-keys "mail-hist" "\ @@ -16377,7 +16603,7 @@ This function normally would be called when the message is sent. ;;;### (autoloads (mail-fetch-field mail-unquote-printable-region ;;;;;; mail-unquote-printable mail-quote-printable-region mail-quote-printable ;;;;;; mail-file-babyl-p mail-use-rfc822) "mail-utils" "mail/mail-utils.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2028)) ;;; Generated autoloads from mail/mail-utils.el (defvar mail-use-rfc822 nil "\ @@ -16439,8 +16665,8 @@ matches may be returned from the message body. ;;;*** ;;;### (autoloads (define-mail-abbrev build-mail-abbrevs mail-abbrevs-setup -;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (19591 -;;;;;; 62571)) +;;;;;; mail-abbrevs-mode) "mailabbrev" "mail/mailabbrev.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from mail/mailabbrev.el (defvar mail-abbrevs-mode nil "\ @@ -16482,8 +16708,8 @@ double-quotes. ;;;*** ;;;### (autoloads (mail-complete define-mail-alias expand-mail-aliases -;;;;;; mail-complete-style) "mailalias" "mail/mailalias.el" (19591 -;;;;;; 62571)) +;;;;;; mail-complete-style) "mailalias" "mail/mailalias.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from mail/mailalias.el (defvar mail-complete-style 'angles "\ @@ -16529,7 +16755,7 @@ current header, calls `mail-complete-function' and passes prefix arg if any. ;;;*** ;;;### (autoloads (mailclient-send-it) "mailclient" "mail/mailclient.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from mail/mailclient.el (autoload 'mailclient-send-it "mailclient" "\ @@ -16543,7 +16769,7 @@ The mail client is taken to be the handler of mailto URLs. ;;;### (autoloads (makefile-imake-mode makefile-bsdmake-mode makefile-makepp-mode ;;;;;; makefile-gmake-mode makefile-automake-mode makefile-mode) -;;;;;; "make-mode" "progmodes/make-mode.el" (19598 13691)) +;;;;;; "make-mode" "progmodes/make-mode.el" (19775 2029)) ;;; Generated autoloads from progmodes/make-mode.el (autoload 'makefile-mode "make-mode" "\ @@ -16660,8 +16886,8 @@ An adapted `makefile-mode' that knows about imake. ;;;*** -;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (make-command-summary) "makesum" "makesum.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from makesum.el (autoload 'make-command-summary "makesum" "\ @@ -16673,7 +16899,7 @@ Previous contents of that buffer are killed first. ;;;*** ;;;### (autoloads (Man-bookmark-jump man-follow man) "man" "man.el" -;;;;;; (19619 52030)) +;;;;;; (19780 4513)) ;;; Generated autoloads from man.el (defalias 'manual-entry 'man) @@ -16727,7 +16953,7 @@ Default bookmark handler for Man buffers. ;;;*** -;;;### (autoloads (master-mode) "master" "master.el" (19562 42953)) +;;;### (autoloads (master-mode) "master" "master.el" (19780 4513)) ;;; Generated autoloads from master.el (autoload 'master-mode "master" "\ @@ -16750,7 +16976,7 @@ yourself the value of `master-of' by calling `master-show-slave'. ;;;*** ;;;### (autoloads (minibuffer-depth-indicate-mode) "mb-depth" "mb-depth.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from mb-depth.el (defvar minibuffer-depth-indicate-mode nil "\ @@ -16773,6 +16999,13 @@ Returns non-nil if the new state is enabled. \(fn &optional ARG)" t nil) +;;;*** + +;;;### (autoloads nil "menu-bar" "menu-bar.el" (19775 2029)) +;;; Generated autoloads from menu-bar.el + +(put 'menu-bar-mode 'standard-value '(t)) + ;;;*** ;;;### (autoloads (message-unbold-region message-bold-region message-news-other-frame @@ -16781,7 +17014,7 @@ Returns non-nil if the new state is enabled. ;;;;;; message-forward-make-body message-forward message-recover ;;;;;; message-supersede message-cancel-news message-followup message-wide-reply ;;;;;; message-reply message-news message-mail message-mode) "message" -;;;;;; "gnus/message.el" (19717 39999)) +;;;;;; "gnus/message.el" (19775 2028)) ;;; Generated autoloads from gnus/message.el (define-mail-user-agent 'message-user-agent 'message-mail 'message-send-and-exit 'message-kill-buffer 'message-send-hook) @@ -16833,7 +17066,7 @@ OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether to continue editing a message already being composed. SWITCH-FUNCTION is a function used to switch to and display the mail buffer. -\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS)" t nil) +\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS RETURN-ACTION &rest IGNORED)" t nil) (autoload 'message-news "message" "\ Start editing a news article to be sent. @@ -16947,7 +17180,7 @@ which specify the range to operate on. ;;;*** ;;;### (autoloads (metapost-mode metafont-mode) "meta-mode" "progmodes/meta-mode.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/meta-mode.el (autoload 'metafont-mode "meta-mode" "\ @@ -16964,7 +17197,7 @@ Major mode for editing MetaPost sources. ;;;### (autoloads (metamail-region metamail-buffer metamail-interpret-body ;;;;;; metamail-interpret-header) "metamail" "mail/metamail.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from mail/metamail.el (autoload 'metamail-interpret-header "metamail" "\ @@ -17009,7 +17242,7 @@ redisplayed as output is inserted. ;;;### (autoloads (mh-fully-kill-draft mh-send-letter mh-user-agent-compose ;;;;;; mh-smail-batch mh-smail-other-window mh-smail) "mh-comp" -;;;;;; "mh-e/mh-comp.el" (19562 42953)) +;;;;;; "mh-e/mh-comp.el" (19780 4513)) ;;; Generated autoloads from mh-e/mh-comp.el (autoload 'mh-smail "mh-comp" "\ @@ -17055,10 +17288,10 @@ OTHER-HEADERS is an alist specifying additional header fields. Elements look like (HEADER . VALUE) where both HEADER and VALUE are strings. -CONTINUE, SWITCH-FUNCTION, YANK-ACTION and SEND-ACTIONS are -ignored. +CONTINUE, SWITCH-FUNCTION, YANK-ACTION, SEND-ACTIONS, and +RETURN-ACTION are ignored. -\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS)" nil nil) +\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS RETURN-ACTION &rest IGNORED)" nil nil) (autoload 'mh-send-letter "mh-comp" "\ Save draft and send message. @@ -17099,7 +17332,7 @@ delete the draft message. ;;;*** -;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (19562 42953)) +;;;### (autoloads (mh-version) "mh-e" "mh-e/mh-e.el" (19775 2029)) ;;; Generated autoloads from mh-e/mh-e.el (put 'mh-progs 'risky-local-variable t) @@ -17116,7 +17349,7 @@ Display version information about MH-E and the MH mail handling system. ;;;*** ;;;### (autoloads (mh-folder-mode mh-nmail mh-rmail) "mh-folder" -;;;;;; "mh-e/mh-folder.el" (19562 42953)) +;;;;;; "mh-e/mh-folder.el" (19780 4514)) ;;; Generated autoloads from mh-e/mh-folder.el (autoload 'mh-rmail "mh-folder" "\ @@ -17198,7 +17431,7 @@ perform the operation on all messages in that region. ;;;*** ;;;### (autoloads (midnight-delay-set clean-buffer-list) "midnight" -;;;;;; "midnight.el" (19562 42953)) +;;;;;; "midnight.el" (19780 4514)) ;;; Generated autoloads from midnight.el (autoload 'clean-buffer-list "midnight" "\ @@ -17225,7 +17458,7 @@ to its second argument TM. ;;;*** ;;;### (autoloads (minibuffer-electric-default-mode) "minibuf-eldef" -;;;;;; "minibuf-eldef.el" (19591 62571)) +;;;;;; "minibuf-eldef.el" (19775 2029)) ;;; Generated autoloads from minibuf-eldef.el (defvar minibuffer-electric-default-mode nil "\ @@ -17252,7 +17485,7 @@ Returns non-nil if the new state is enabled. ;;;*** -;;;### (autoloads (butterfly) "misc" "misc.el" (19714 43298)) +;;;### (autoloads (butterfly) "misc" "misc.el" (19775 2029)) ;;; Generated autoloads from misc.el (autoload 'butterfly "misc" "\ @@ -17271,7 +17504,7 @@ variation of `C-x M-c M-butterfly' from url `http://xkcd.com/378/'. ;;;### (autoloads (multi-isearch-files-regexp multi-isearch-files ;;;;;; multi-isearch-buffers-regexp multi-isearch-buffers multi-isearch-setup) -;;;;;; "misearch" "misearch.el" (19562 42953)) +;;;;;; "misearch" "misearch.el" (19775 2029)) ;;; Generated autoloads from misearch.el (add-hook 'isearch-mode-hook 'multi-isearch-setup) @@ -17353,7 +17586,7 @@ whose file names match the specified wildcard. ;;;*** ;;;### (autoloads (mixal-mode) "mixal-mode" "progmodes/mixal-mode.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/mixal-mode.el (autoload 'mixal-mode "mixal-mode" "\ @@ -17364,7 +17597,7 @@ Major mode for the mixal asm language. ;;;*** ;;;### (autoloads (mm-inline-external-body mm-extern-cache-contents) -;;;;;; "mm-extern" "gnus/mm-extern.el" (19714 43298)) +;;;;;; "mm-extern" "gnus/mm-extern.el" (19775 2028)) ;;; Generated autoloads from gnus/mm-extern.el (autoload 'mm-extern-cache-contents "mm-extern" "\ @@ -17383,7 +17616,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** ;;;### (autoloads (mm-inline-partial) "mm-partial" "gnus/mm-partial.el" -;;;;;; (19619 52030)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/mm-partial.el (autoload 'mm-inline-partial "mm-partial" "\ @@ -17397,7 +17630,7 @@ If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing. ;;;*** ;;;### (autoloads (mm-url-insert-file-contents-external mm-url-insert-file-contents) -;;;;;; "mm-url" "gnus/mm-url.el" (19714 43298)) +;;;;;; "mm-url" "gnus/mm-url.el" (19780 4513)) ;;; Generated autoloads from gnus/mm-url.el (autoload 'mm-url-insert-file-contents "mm-url" "\ @@ -17414,7 +17647,7 @@ Insert file contents of URL using `mm-url-program'. ;;;*** ;;;### (autoloads (mm-uu-dissect-text-parts mm-uu-dissect) "mm-uu" -;;;;;; "gnus/mm-uu.el" (19714 43298)) +;;;;;; "gnus/mm-uu.el" (19775 2028)) ;;; Generated autoloads from gnus/mm-uu.el (autoload 'mm-uu-dissect "mm-uu" "\ @@ -17434,7 +17667,7 @@ Assume text has been decoded if DECODED is non-nil. ;;;*** ;;;### (autoloads (mml1991-sign mml1991-encrypt) "mml1991" "gnus/mml1991.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/mml1991.el (autoload 'mml1991-encrypt "mml1991" "\ @@ -17451,7 +17684,7 @@ Not documented ;;;### (autoloads (mml2015-self-encrypt mml2015-sign mml2015-encrypt ;;;;;; mml2015-verify-test mml2015-verify mml2015-decrypt-test mml2015-decrypt) -;;;;;; "mml2015" "gnus/mml2015.el" (19714 43298)) +;;;;;; "mml2015" "gnus/mml2015.el" (19780 4513)) ;;; Generated autoloads from gnus/mml2015.el (autoload 'mml2015-decrypt "mml2015" "\ @@ -17491,8 +17724,8 @@ Not documented ;;;*** -;;;### (autoloads (m2-mode) "modula2" "progmodes/modula2.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (m2-mode) "modula2" "progmodes/modula2.el" (19763 +;;;;;; 27287)) ;;; Generated autoloads from progmodes/modula2.el (defalias 'modula-2-mode 'm2-mode) @@ -17526,7 +17759,7 @@ followed by the first character of the construct. ;;;*** ;;;### (autoloads (unmorse-region morse-region) "morse" "play/morse.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from play/morse.el (autoload 'morse-region "morse" "\ @@ -17542,7 +17775,7 @@ Convert morse coded text in region to ordinary ASCII text. ;;;*** ;;;### (autoloads (mouse-drag-drag mouse-drag-throw) "mouse-drag" -;;;;;; "mouse-drag.el" (19714 43298)) +;;;;;; "mouse-drag.el" (19775 2029)) ;;; Generated autoloads from mouse-drag.el (autoload 'mouse-drag-throw "mouse-drag" "\ @@ -17589,8 +17822,8 @@ To test this function, evaluate: ;;;*** -;;;### (autoloads (mouse-sel-mode) "mouse-sel" "mouse-sel.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (mouse-sel-mode) "mouse-sel" "mouse-sel.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from mouse-sel.el (defvar mouse-sel-mode nil "\ @@ -17642,7 +17875,7 @@ primary selection and region. ;;;*** -;;;### (autoloads (mpc) "mpc" "mpc.el" (19714 43269)) +;;;### (autoloads (mpc) "mpc" "mpc.el" (19775 2029)) ;;; Generated autoloads from mpc.el (autoload 'mpc "mpc" "\ @@ -17652,7 +17885,7 @@ Main entry point for MPC. ;;;*** -;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (19640 47194)) +;;;### (autoloads (mpuz) "mpuz" "play/mpuz.el" (19775 2029)) ;;; Generated autoloads from play/mpuz.el (autoload 'mpuz "mpuz" "\ @@ -17662,7 +17895,7 @@ Multiplication puzzle with GNU Emacs. ;;;*** -;;;### (autoloads (msb-mode) "msb" "msb.el" (19562 42953)) +;;;### (autoloads (msb-mode) "msb" "msb.el" (19780 45051)) ;;; Generated autoloads from msb.el (defvar msb-mode nil "\ @@ -17682,6 +17915,14 @@ different buffer menu using the function `msb'. \(fn &optional ARG)" t nil) +;;;*** + +;;;### (autoloads nil "mule-cmds" "international/mule-cmds.el" (19775 +;;;;;; 2028)) +;;; Generated autoloads from international/mule-cmds.el + +(put 'input-method-alist 'risky-local-variable t) + ;;;*** ;;;### (autoloads (font-show-log mule-diag list-input-methods list-fontsets @@ -17689,7 +17930,7 @@ different buffer menu using the function `msb'. ;;;;;; describe-current-coding-system describe-current-coding-system-briefly ;;;;;; describe-coding-system describe-character-set list-charset-chars ;;;;;; read-charset list-character-sets) "mule-diag" "international/mule-diag.el" -;;;;;; (19619 52030)) +;;;;;; (19775 2028)) ;;; Generated autoloads from international/mule-diag.el (autoload 'list-character-sets "mule-diag" "\ @@ -17826,7 +18067,7 @@ The default is 20. If LIMIT is negative, do not limit the listing. ;;;;;; coding-system-translation-table-for-decode coding-system-pre-write-conversion ;;;;;; coding-system-post-read-conversion lookup-nested-alist set-nested-alist ;;;;;; truncate-string-to-width store-substring string-to-sequence) -;;;;;; "mule-util" "international/mule-util.el" (19562 42953)) +;;;;;; "mule-util" "international/mule-util.el" (19775 2028)) ;;; Generated autoloads from international/mule-util.el (autoload 'string-to-sequence "mule-util" "\ @@ -17966,8 +18207,8 @@ per-character basis, this may not be accurate. ;;;### (autoloads (network-connection network-connection-to-service ;;;;;; whois-reverse-lookup whois finger ftp run-dig dns-lookup-host ;;;;;; nslookup nslookup-host ping traceroute route arp netstat -;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (19714 -;;;;;; 43298)) +;;;;;; iwconfig ifconfig) "net-utils" "net/net-utils.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from net/net-utils.el (autoload 'ifconfig "net-utils" "\ @@ -18061,8 +18302,8 @@ Open a network connection to HOST on PORT. ;;;*** -;;;### (autoloads (netrc-credentials) "netrc" "net/netrc.el" (19640 -;;;;;; 47194)) +;;;### (autoloads (netrc-credentials) "netrc" "net/netrc.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from net/netrc.el (autoload 'netrc-credentials "netrc" "\ @@ -18079,7 +18320,7 @@ listed in the PORTS list. ;;;;;; uncomment-region comment-kill comment-set-column comment-indent ;;;;;; comment-indent-default comment-normalize-vars comment-multi-line ;;;;;; comment-padding comment-style comment-column) "newcomment" -;;;;;; "newcomment.el" (19714 43298)) +;;;;;; "newcomment.el" (19775 2029)) ;;; Generated autoloads from newcomment.el (defalias 'indent-for-comment 'comment-indent) @@ -18279,7 +18520,7 @@ unless optional argument SOFT is non-nil. ;;;*** ;;;### (autoloads (newsticker-start newsticker-running-p) "newst-backend" -;;;;;; "net/newst-backend.el" (19598 13691)) +;;;;;; "net/newst-backend.el" (19780 4514)) ;;; Generated autoloads from net/newst-backend.el (autoload 'newsticker-running-p "newst-backend" "\ @@ -18301,7 +18542,7 @@ Run `newsticker-start-hook' if newsticker was not running already. ;;;*** ;;;### (autoloads (newsticker-plainview) "newst-plainview" "net/newst-plainview.el" -;;;;;; (19598 13691)) +;;;;;; (19780 4514)) ;;; Generated autoloads from net/newst-plainview.el (autoload 'newsticker-plainview "newst-plainview" "\ @@ -18312,7 +18553,7 @@ Start newsticker plainview. ;;;*** ;;;### (autoloads (newsticker-show-news) "newst-reader" "net/newst-reader.el" -;;;;;; (19598 13691)) +;;;;;; (19780 4514)) ;;; Generated autoloads from net/newst-reader.el (autoload 'newsticker-show-news "newst-reader" "\ @@ -18323,7 +18564,7 @@ Start reading news. You may want to bind this to a key. ;;;*** ;;;### (autoloads (newsticker-start-ticker newsticker-ticker-running-p) -;;;;;; "newst-ticker" "net/newst-ticker.el" (19598 13691)) +;;;;;; "newst-ticker" "net/newst-ticker.el" (19780 4514)) ;;; Generated autoloads from net/newst-ticker.el (autoload 'newsticker-ticker-running-p "newst-ticker" "\ @@ -18344,7 +18585,7 @@ running already. ;;;*** ;;;### (autoloads (newsticker-treeview) "newst-treeview" "net/newst-treeview.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2029)) ;;; Generated autoloads from net/newst-treeview.el (autoload 'newsticker-treeview "newst-treeview" "\ @@ -18355,7 +18596,7 @@ Start newsticker treeview. ;;;*** ;;;### (autoloads (nndiary-generate-nov-databases) "nndiary" "gnus/nndiary.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/nndiary.el (autoload 'nndiary-generate-nov-databases "nndiary" "\ @@ -18365,8 +18606,8 @@ Generate NOV databases in all nndiary directories. ;;;*** -;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (nndoc-add-type) "nndoc" "gnus/nndoc.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from gnus/nndoc.el (autoload 'nndoc-add-type "nndoc" "\ @@ -18381,7 +18622,7 @@ symbol in the alist. ;;;*** ;;;### (autoloads (nnfolder-generate-active-file) "nnfolder" "gnus/nnfolder.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/nnfolder.el (autoload 'nnfolder-generate-active-file "nnfolder" "\ @@ -18393,7 +18634,7 @@ This command does not work if you use short group names. ;;;*** ;;;### (autoloads (nnml-generate-nov-databases) "nnml" "gnus/nnml.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/nnml.el (autoload 'nnml-generate-nov-databases "nnml" "\ @@ -18404,7 +18645,7 @@ Generate NOV databases in all nnml directories. ;;;*** ;;;### (autoloads (disable-command enable-command disabled-command-function) -;;;;;; "novice" "novice.el" (19714 43298)) +;;;;;; "novice" "novice.el" (19775 2029)) ;;; Generated autoloads from novice.el (defvar disabled-command-function 'disabled-command-function "\ @@ -18437,7 +18678,7 @@ to future sessions. ;;;*** ;;;### (autoloads (nroff-mode) "nroff-mode" "textmodes/nroff-mode.el" -;;;;;; (19619 52030)) +;;;;;; (19780 4514)) ;;; Generated autoloads from textmodes/nroff-mode.el (autoload 'nroff-mode "nroff-mode" "\ @@ -18452,7 +18693,7 @@ closing requests for requests that are used in matched pairs. ;;;*** ;;;### (autoloads (nxml-glyph-display-string) "nxml-glyph" "nxml/nxml-glyph.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from nxml/nxml-glyph.el (autoload 'nxml-glyph-display-string "nxml-glyph" "\ @@ -18464,8 +18705,8 @@ Return nil if the face cannot display a glyph for N. ;;;*** -;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (nxml-mode) "nxml-mode" "nxml/nxml-mode.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from nxml/nxml-mode.el (autoload 'nxml-mode "nxml-mode" "\ @@ -18527,7 +18768,7 @@ Many aspects this mode can be customized using ;;;*** ;;;### (autoloads (nxml-enable-unicode-char-name-sets) "nxml-uchnm" -;;;;;; "nxml/nxml-uchnm.el" (19562 42953)) +;;;;;; "nxml/nxml-uchnm.el" (19775 2029)) ;;; Generated autoloads from nxml/nxml-uchnm.el (autoload 'nxml-enable-unicode-char-name-sets "nxml-uchnm" "\ @@ -18549,7 +18790,7 @@ the variable `nxml-enabled-unicode-blocks'. ;;;;;; org-babel-execute-src-block org-babel-pop-to-session-maybe ;;;;;; org-babel-load-in-session-maybe org-babel-expand-src-block-maybe ;;;;;; org-babel-execute-maybe org-babel-execute-safely-maybe) "ob" -;;;;;; "org/ob.el" (19717 39999)) +;;;;;; "org/ob.el" (19775 2029)) ;;; Generated autoloads from org/ob.el (autoload 'org-babel-execute-safely-maybe "ob" "\ @@ -18731,7 +18972,7 @@ Mark current src block ;;;*** ;;;### (autoloads (org-babel-describe-bindings) "ob-keys" "org/ob-keys.el" -;;;;;; (19717 39999)) +;;;;;; (19775 2029)) ;;; Generated autoloads from org/ob-keys.el (autoload 'org-babel-describe-bindings "ob-keys" "\ @@ -18742,7 +18983,7 @@ Describe all keybindings behind `org-babel-key-prefix'. ;;;*** ;;;### (autoloads (org-babel-lob-get-info org-babel-lob-execute-maybe -;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (19717 39999)) +;;;;;; org-babel-lob-ingest) "ob-lob" "org/ob-lob.el" (19775 2029)) ;;; Generated autoloads from org/ob-lob.el (autoload 'org-babel-lob-ingest "ob-lob" "\ @@ -18767,7 +19008,7 @@ Return a Library of Babel function call as a string. ;;;### (autoloads (org-babel-tangle org-babel-tangle-file org-babel-load-file ;;;;;; org-babel-tangle-lang-exts) "ob-tangle" "org/ob-tangle.el" -;;;;;; (19717 39999)) +;;;;;; (19775 2029)) ;;; Generated autoloads from org/ob-tangle.el (defvar org-babel-tangle-lang-exts '(("emacs-lisp" . "el")) "\ @@ -18809,7 +19050,7 @@ exported source code blocks by language. ;;;*** ;;;### (autoloads (inferior-octave) "octave-inf" "progmodes/octave-inf.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/octave-inf.el (autoload 'inferior-octave "octave-inf" "\ @@ -18832,7 +19073,7 @@ startup file, `~/.emacs-octave'. ;;;*** ;;;### (autoloads (octave-mode) "octave-mod" "progmodes/octave-mod.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/octave-mod.el (autoload 'octave-mode "octave-mod" "\ @@ -18920,7 +19161,7 @@ including a reproducible test case and send the message. ;;;;;; org-insert-link-global org-store-link org-run-like-in-org-mode ;;;;;; turn-on-orgstruct++ turn-on-orgstruct orgstruct-mode org-global-cycle ;;;;;; org-mode org-babel-do-load-languages) "org" "org/org.el" -;;;;;; (19717 39999)) +;;;;;; (19780 4514)) ;;; Generated autoloads from org/org.el (autoload 'org-babel-do-load-languages "org" "\ @@ -19143,7 +19384,7 @@ Call the customize function with org as argument. ;;;;;; org-diary org-agenda-list-stuck-projects org-tags-view org-todo-list ;;;;;; org-search-view org-agenda-list org-batch-store-agenda-views ;;;;;; org-store-agenda-views org-batch-agenda-csv org-batch-agenda -;;;;;; org-agenda) "org-agenda" "org/org-agenda.el" (19717 39999)) +;;;;;; org-agenda) "org-agenda" "org/org-agenda.el" (19780 4514)) ;;; Generated autoloads from org/org-agenda.el (autoload 'org-agenda "org-agenda" "\ @@ -19393,7 +19634,7 @@ belonging to the \"Work\" category. ;;;### (autoloads (org-archive-subtree-default-with-confirmation ;;;;;; org-archive-subtree-default) "org-archive" "org/org-archive.el" -;;;;;; (19717 39999)) +;;;;;; (19780 4514)) ;;; Generated autoloads from org/org-archive.el (autoload 'org-archive-subtree-default "org-archive" "\ @@ -19413,8 +19654,8 @@ This command is set with the variable `org-archive-default-command'. ;;;### (autoloads (org-export-as-ascii org-export-region-as-ascii ;;;;;; org-replace-region-by-ascii org-export-as-ascii-to-buffer ;;;;;; org-export-as-utf8-to-buffer org-export-as-utf8 org-export-as-latin1-to-buffer -;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (19717 -;;;;;; 39999)) +;;;;;; org-export-as-latin1) "org-ascii" "org/org-ascii.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from org/org-ascii.el (autoload 'org-export-as-latin1 "org-ascii" "\ @@ -19487,8 +19728,8 @@ publishing directory. ;;;*** -;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (19717 -;;;;;; 39999)) +;;;### (autoloads (org-attach) "org-attach" "org/org-attach.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from org/org-attach.el (autoload 'org-attach "org-attach" "\ @@ -19500,7 +19741,7 @@ Shows a list of commands and prompts for another key to execute a command. ;;;*** ;;;### (autoloads (org-bbdb-anniversaries) "org-bbdb" "org/org-bbdb.el" -;;;;;; (19717 39999)) +;;;;;; (19780 4514)) ;;; Generated autoloads from org/org-bbdb.el (autoload 'org-bbdb-anniversaries "org-bbdb" "\ @@ -19511,7 +19752,7 @@ Extract anniversaries from BBDB for display in the agenda. ;;;*** ;;;### (autoloads (org-capture-import-remember-templates org-capture-insert-template-here -;;;;;; org-capture) "org-capture" "org/org-capture.el" (19717 39999)) +;;;;;; org-capture) "org-capture" "org/org-capture.el" (19775 2029)) ;;; Generated autoloads from org/org-capture.el (autoload 'org-capture "org-capture" "\ @@ -19549,7 +19790,7 @@ Set org-capture-templates to be similar to `org-remember-templates'. ;;;*** ;;;### (autoloads (org-clock-persistence-insinuate org-get-clocktable) -;;;;;; "org-clock" "org/org-clock.el" (19717 39999)) +;;;;;; "org-clock" "org/org-clock.el" (19780 4514)) ;;; Generated autoloads from org/org-clock.el (autoload 'org-get-clocktable "org-clock" "\ @@ -19567,7 +19808,7 @@ Set up hooks for clock persistence. ;;;*** ;;;### (autoloads (org-datetree-find-date-create) "org-datetree" -;;;;;; "org/org-datetree.el" (19717 39999)) +;;;;;; "org/org-datetree.el" (19775 2029)) ;;; Generated autoloads from org/org-datetree.el (autoload 'org-datetree-find-date-create "org-datetree" "\ @@ -19583,7 +19824,7 @@ tree can be found. ;;;### (autoloads (org-export-as-docbook org-export-as-docbook-pdf-and-open ;;;;;; org-export-as-docbook-pdf org-export-region-as-docbook org-replace-region-by-docbook ;;;;;; org-export-as-docbook-to-buffer org-export-as-docbook-batch) -;;;;;; "org-docbook" "org/org-docbook.el" (19717 39999)) +;;;;;; "org-docbook" "org/org-docbook.el" (19775 2029)) ;;; Generated autoloads from org/org-docbook.el (autoload 'org-export-as-docbook-batch "org-docbook" "\ @@ -19660,7 +19901,7 @@ publishing directory. ;;;### (autoloads (org-insert-export-options-template org-export-as-org ;;;;;; org-export-visible org-export) "org-exp" "org/org-exp.el" -;;;;;; (19717 39999)) +;;;;;; (19780 4514)) ;;; Generated autoloads from org/org-exp.el (autoload 'org-export "org-exp" "\ @@ -19717,8 +19958,8 @@ Insert into the buffer a template with information for exporting. ;;;*** ;;;### (autoloads (org-feed-show-raw-feed org-feed-goto-inbox org-feed-update -;;;;;; org-feed-update-all) "org-feed" "org/org-feed.el" (19717 -;;;;;; 39999)) +;;;;;; org-feed-update-all) "org-feed" "org/org-feed.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from org/org-feed.el (autoload 'org-feed-update-all "org-feed" "\ @@ -19746,7 +19987,7 @@ Show the raw feed buffer of a feed. ;;;*** ;;;### (autoloads (org-footnote-normalize org-footnote-action) "org-footnote" -;;;;;; "org/org-footnote.el" (19717 39999)) +;;;;;; "org/org-footnote.el" (19775 2029)) ;;; Generated autoloads from org/org-footnote.el (autoload 'org-footnote-action "org-footnote" "\ @@ -19773,7 +20014,7 @@ referenced sequence. ;;;### (autoloads (org-freemind-to-org-mode org-freemind-from-org-sparse-tree ;;;;;; org-freemind-from-org-mode org-freemind-from-org-mode-node ;;;;;; org-freemind-show org-export-as-freemind) "org-freemind" -;;;;;; "org/org-freemind.el" (19717 39999)) +;;;;;; "org/org-freemind.el" (19775 2029)) ;;; Generated autoloads from org/org-freemind.el (autoload 'org-export-as-freemind "org-freemind" "\ @@ -19834,7 +20075,7 @@ Convert FreeMind file MM-FILE to `org-mode' file ORG-FILE. ;;;### (autoloads (org-export-htmlize-generate-css org-export-as-html ;;;;;; org-export-region-as-html org-replace-region-by-html org-export-as-html-to-buffer ;;;;;; org-export-as-html-batch org-export-as-html-and-open) "org-html" -;;;;;; "org/org-html.el" (19717 39999)) +;;;;;; "org/org-html.el" (19780 4514)) ;;; Generated autoloads from org/org-html.el (put 'org-export-html-style-include-default 'safe-local-variable 'booleanp) @@ -19928,7 +20169,7 @@ that uses these same face definitions. ;;;### (autoloads (org-export-icalendar-combine-agenda-files org-export-icalendar-all-agenda-files ;;;;;; org-export-icalendar-this-file) "org-icalendar" "org/org-icalendar.el" -;;;;;; (19717 39999)) +;;;;;; (19780 4514)) ;;; Generated autoloads from org/org-icalendar.el (autoload 'org-export-icalendar-this-file "org-icalendar" "\ @@ -19956,7 +20197,7 @@ The file is stored under the name `org-combined-agenda-icalendar-file'. ;;;### (autoloads (org-id-store-link org-id-find-id-file org-id-find ;;;;;; org-id-goto org-id-get-with-outline-drilling org-id-get-with-outline-path-completion ;;;;;; org-id-get org-id-copy org-id-get-create) "org-id" "org/org-id.el" -;;;;;; (19717 39999)) +;;;;;; (19775 2029)) ;;; Generated autoloads from org/org-id.el (autoload 'org-id-get-create "org-id" "\ @@ -20025,7 +20266,7 @@ Store a link to the current entry, using its ID. ;;;*** ;;;### (autoloads (org-indent-mode) "org-indent" "org/org-indent.el" -;;;;;; (19717 39999)) +;;;;;; (19775 2029)) ;;; Generated autoloads from org/org-indent.el (autoload 'org-indent-mode "org-indent" "\ @@ -20040,7 +20281,7 @@ FIXME: How to update when broken? ;;;*** ;;;### (autoloads (org-irc-store-link) "org-irc" "org/org-irc.el" -;;;;;; (19717 39999)) +;;;;;; (19775 2029)) ;;; Generated autoloads from org/org-irc.el (autoload 'org-irc-store-link "org-irc" "\ @@ -20053,7 +20294,7 @@ Dispatch to the appropriate function to store a link to an IRC session. ;;;### (autoloads (org-export-as-pdf-and-open org-export-as-pdf org-export-as-latex ;;;;;; org-export-region-as-latex org-replace-region-by-latex org-export-as-latex-to-buffer ;;;;;; org-export-as-latex-batch) "org-latex" "org/org-latex.el" -;;;;;; (19717 39999)) +;;;;;; (19775 2029)) ;;; Generated autoloads from org/org-latex.el (autoload 'org-export-as-latex-batch "org-latex" "\ @@ -20133,8 +20374,8 @@ Export as LaTeX, then process through to PDF, and open. ;;;*** ;;;### (autoloads (org-mobile-create-sumo-agenda org-mobile-pull -;;;;;; org-mobile-push) "org-mobile" "org/org-mobile.el" (19717 -;;;;;; 39999)) +;;;;;; org-mobile-push) "org-mobile" "org/org-mobile.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from org/org-mobile.el (autoload 'org-mobile-push "org-mobile" "\ @@ -20159,7 +20400,7 @@ Create a file that contains all custom agenda views. ;;;*** ;;;### (autoloads (org-plot/gnuplot) "org-plot" "org/org-plot.el" -;;;;;; (19717 39999)) +;;;;;; (19775 2029)) ;;; Generated autoloads from org/org-plot.el (autoload 'org-plot/gnuplot "org-plot" "\ @@ -20173,7 +20414,7 @@ line directly before or after the table. ;;;### (autoloads (org-publish-current-project org-publish-current-file ;;;;;; org-publish-all org-publish) "org-publish" "org/org-publish.el" -;;;;;; (19717 39999)) +;;;;;; (19780 4514)) ;;; Generated autoloads from org/org-publish.el (defalias 'org-publish-project 'org-publish) @@ -20207,7 +20448,7 @@ the project. ;;;### (autoloads (org-remember-handler org-remember org-remember-apply-template ;;;;;; org-remember-annotation org-remember-insinuate) "org-remember" -;;;;;; "org/org-remember.el" (19717 39999)) +;;;;;; "org/org-remember.el" (19780 4514)) ;;; Generated autoloads from org/org-remember.el (autoload 'org-remember-insinuate "org-remember" "\ @@ -20283,7 +20524,7 @@ See also the variable `org-reverse-note-order'. ;;;*** ;;;### (autoloads (org-table-to-lisp orgtbl-mode turn-on-orgtbl) -;;;;;; "org-table" "org/org-table.el" (19717 39999)) +;;;;;; "org-table" "org/org-table.el" (19780 4514)) ;;; Generated autoloads from org/org-table.el (autoload 'turn-on-orgtbl "org-table" "\ @@ -20307,7 +20548,7 @@ The table is taken from the parameter TXT, or from the buffer at point. ;;;*** ;;;### (autoloads (org-export-as-taskjuggler-and-open org-export-as-taskjuggler) -;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (19717 39999)) +;;;;;; "org-taskjuggler" "org/org-taskjuggler.el" (19775 2029)) ;;; Generated autoloads from org/org-taskjuggler.el (autoload 'org-export-as-taskjuggler "org-taskjuggler" "\ @@ -20335,7 +20576,7 @@ with the TaskJuggler GUI. ;;;### (autoloads (org-timer-set-timer org-timer-item org-timer-change-times-in-region ;;;;;; org-timer org-timer-start) "org-timer" "org/org-timer.el" -;;;;;; (19717 39999)) +;;;;;; (19775 2029)) ;;; Generated autoloads from org/org-timer.el (autoload 'org-timer-start "org-timer" "\ @@ -20396,7 +20637,7 @@ replace any running timer. ;;;*** ;;;### (autoloads (org-export-as-xoxo) "org-xoxo" "org/org-xoxo.el" -;;;;;; (19717 39999)) +;;;;;; (19780 4514)) ;;; Generated autoloads from org/org-xoxo.el (autoload 'org-export-as-xoxo "org-xoxo" "\ @@ -20408,7 +20649,7 @@ The XOXO buffer is named *xoxo-* ;;;*** ;;;### (autoloads (outline-minor-mode outline-mode) "outline" "outline.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2029)) ;;; Generated autoloads from outline.el (put 'outline-regexp 'safe-local-variable 'string-or-null-p) @@ -20468,7 +20709,7 @@ See the command `outline-mode' for more information on this mode. ;;;### (autoloads (list-packages describe-package package-initialize ;;;;;; package-install-file package-install-from-buffer package-install ;;;;;; package-enable-at-startup) "package" "emacs-lisp/package.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/package.el (defvar package-enable-at-startup t "\ @@ -20530,7 +20771,7 @@ The list is displayed in a buffer named `*Packages*'. ;;;*** -;;;### (autoloads (show-paren-mode) "paren" "paren.el" (19714 43298)) +;;;### (autoloads (show-paren-mode) "paren" "paren.el" (19775 2029)) ;;; Generated autoloads from paren.el (defvar show-paren-mode nil "\ @@ -20555,7 +20796,7 @@ in `show-paren-style' after `show-paren-delay' seconds of Emacs idle time. ;;;*** ;;;### (autoloads (parse-time-string) "parse-time" "calendar/parse-time.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2027)) ;;; Generated autoloads from calendar/parse-time.el (put 'parse-time-rules 'risky-local-variable t) @@ -20568,8 +20809,8 @@ unknown are returned as nil. ;;;*** -;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (pascal-mode) "pascal" "progmodes/pascal.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from progmodes/pascal.el (autoload 'pascal-mode "pascal" "\ @@ -20622,7 +20863,7 @@ no args, if that value is non-nil. ;;;*** ;;;### (autoloads (password-cache-expiry password-cache) "password-cache" -;;;;;; "password-cache.el" (19598 13691)) +;;;;;; "password-cache.el" (19775 2029)) ;;; Generated autoloads from password-cache.el (defvar password-cache t "\ @@ -20639,7 +20880,7 @@ Whether passwords are cached at all is controlled by `password-cache'.") ;;;*** ;;;### (autoloads (pc-bindings-mode) "pc-mode" "emulation/pc-mode.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emulation/pc-mode.el (autoload 'pc-bindings-mode "pc-mode" "\ @@ -20657,7 +20898,7 @@ C-Escape does list-buffers. ;;;*** ;;;### (autoloads (pc-selection-mode) "pc-select" "emulation/pc-select.el" -;;;;;; (19619 52030)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emulation/pc-select.el (defvar pc-selection-mode nil "\ @@ -20724,7 +20965,7 @@ but before calling PC Selection mode): ;;;*** ;;;### (autoloads (pcase-let pcase-let* pcase) "pcase" "emacs-lisp/pcase.el" -;;;;;; (19726 56598)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/pcase.el (autoload 'pcase "pcase" "\ @@ -20738,7 +20979,6 @@ UPatterns can take the following forms: (and UPAT...) matches if all the patterns match. `QPAT matches if the QPattern QPAT matches. (pred PRED) matches if PRED applied to the object returns non-nil. - (let VAR EXP) matches anything and set VAR to the value of EXP. (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. QPatterns can take the following forms: @@ -20781,8 +21021,8 @@ of the form (UPAT EXP). ;;;*** -;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (pcomplete/cvs) "pcmpl-cvs" "pcmpl-cvs.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from pcmpl-cvs.el (autoload 'pcomplete/cvs "pcmpl-cvs" "\ @@ -20793,7 +21033,7 @@ Completion rules for the `cvs' command. ;;;*** ;;;### (autoloads (pcomplete/tar pcomplete/make pcomplete/bzip2 pcomplete/gzip) -;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (19598 13691)) +;;;;;; "pcmpl-gnu" "pcmpl-gnu.el" (19775 2029)) ;;; Generated autoloads from pcmpl-gnu.el (autoload 'pcomplete/gzip "pcmpl-gnu" "\ @@ -20821,7 +21061,7 @@ Completion for the GNU tar utility. ;;;*** ;;;### (autoloads (pcomplete/mount pcomplete/umount pcomplete/kill) -;;;;;; "pcmpl-linux" "pcmpl-linux.el" (19598 13691)) +;;;;;; "pcmpl-linux" "pcmpl-linux.el" (19775 2029)) ;;; Generated autoloads from pcmpl-linux.el (autoload 'pcomplete/kill "pcmpl-linux" "\ @@ -20841,8 +21081,8 @@ Completion for GNU/Linux `mount'. ;;;*** -;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (pcomplete/rpm) "pcmpl-rpm" "pcmpl-rpm.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from pcmpl-rpm.el (autoload 'pcomplete/rpm "pcmpl-rpm" "\ @@ -20854,7 +21094,7 @@ Completion for the `rpm' command. ;;;### (autoloads (pcomplete/scp pcomplete/ssh pcomplete/chgrp pcomplete/chown ;;;;;; pcomplete/which pcomplete/xargs pcomplete/rm pcomplete/rmdir -;;;;;; pcomplete/cd) "pcmpl-unix" "pcmpl-unix.el" (19598 13691)) +;;;;;; pcomplete/cd) "pcmpl-unix" "pcmpl-unix.el" (19775 2029)) ;;; Generated autoloads from pcmpl-unix.el (autoload 'pcomplete/cd "pcmpl-unix" "\ @@ -20911,8 +21151,8 @@ Includes files as well as host names followed by a colon. ;;;### (autoloads (pcomplete-shell-setup pcomplete-comint-setup pcomplete-list ;;;;;; pcomplete-help pcomplete-expand pcomplete-continue pcomplete-expand-and-complete -;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (19591 -;;;;;; 62571)) +;;;;;; pcomplete-reverse pcomplete) "pcomplete" "pcomplete.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from pcomplete.el (autoload 'pcomplete "pcomplete" "\ @@ -20971,7 +21211,7 @@ Setup `shell-mode' to use pcomplete. ;;;### (autoloads (cvs-dired-use-hook cvs-dired-action cvs-status ;;;;;; cvs-update cvs-examine cvs-quickdir cvs-checkout) "pcvs" -;;;;;; "vc/pcvs.el" (19591 62571)) +;;;;;; "vc/pcvs.el" (19775 2030)) ;;; Generated autoloads from vc/pcvs.el (autoload 'cvs-checkout "pcvs" "\ @@ -21046,7 +21286,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d ;;;*** -;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (19598 13691)) +;;;### (autoloads nil "pcvs-defs" "vc/pcvs-defs.el" (19780 4514)) ;;; Generated autoloads from vc/pcvs-defs.el (defvar cvs-global-menu (let ((m (make-sparse-keymap "PCL-CVS"))) (define-key m [status] `(menu-item ,(purecopy "Directory Status") cvs-status :help ,(purecopy "A more verbose status of a workarea"))) (define-key m [checkout] `(menu-item ,(purecopy "Checkout Module") cvs-checkout :help ,(purecopy "Check out a module from the repository"))) (define-key m [update] `(menu-item ,(purecopy "Update Directory") cvs-update :help ,(purecopy "Fetch updates from the repository"))) (define-key m [examine] `(menu-item ,(purecopy "Examine Directory") cvs-examine :help ,(purecopy "Examine the current state of a workarea"))) (fset 'cvs-global-menu m))) @@ -21054,7 +21294,7 @@ The exact behavior is determined also by `cvs-dired-use-hook'." (when (stringp d ;;;*** ;;;### (autoloads (perl-mode) "perl-mode" "progmodes/perl-mode.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/perl-mode.el (put 'perl-indent-level 'safe-local-variable 'integerp) (put 'perl-continued-statement-offset 'safe-local-variable 'integerp) @@ -21113,157 +21353,10 @@ Turning on Perl mode runs the normal hook `perl-mode-hook'. \(fn)" t nil) -;;;*** - -;;;### (autoloads (pgg-snarf-keys pgg-snarf-keys-region pgg-insert-key -;;;;;; pgg-verify pgg-verify-region pgg-sign pgg-sign-region pgg-decrypt -;;;;;; pgg-decrypt-region pgg-encrypt pgg-encrypt-symmetric pgg-encrypt-symmetric-region -;;;;;; pgg-encrypt-region) "pgg" "pgg.el" (19640 47194)) -;;; Generated autoloads from pgg.el - -(autoload 'pgg-encrypt-region "pgg" "\ -Encrypt the current region between START and END for RCPTS. - -If optional argument SIGN is non-nil, do a combined sign and encrypt. - -If optional PASSPHRASE is not specified, it will be obtained from the -passphrase cache or user. - -\(fn START END RCPTS &optional SIGN PASSPHRASE)" t nil) - -(autoload 'pgg-encrypt-symmetric-region "pgg" "\ -Encrypt the current region between START and END symmetric with passphrase. - -If optional PASSPHRASE is not specified, it will be obtained from the -cache or user. - -\(fn START END &optional PASSPHRASE)" t nil) - -(autoload 'pgg-encrypt-symmetric "pgg" "\ -Encrypt the current buffer using a symmetric, rather than key-pair, cipher. - -If optional arguments START and END are specified, only encrypt within -the region. - -If optional PASSPHRASE is not specified, it will be obtained from the -passphrase cache or user. - -\(fn &optional START END PASSPHRASE)" t nil) - -(autoload 'pgg-encrypt "pgg" "\ -Encrypt the current buffer for RCPTS. - -If optional argument SIGN is non-nil, do a combined sign and encrypt. - -If optional arguments START and END are specified, only encrypt within -the region. - -If optional PASSPHRASE is not specified, it will be obtained from the -passphrase cache or user. - -\(fn RCPTS &optional SIGN START END PASSPHRASE)" t nil) - -(autoload 'pgg-decrypt-region "pgg" "\ -Decrypt the current region between START and END. - -If optional PASSPHRASE is not specified, it will be obtained from the -passphrase cache or user. - -\(fn START END &optional PASSPHRASE)" t nil) - -(autoload 'pgg-decrypt "pgg" "\ -Decrypt the current buffer. - -If optional arguments START and END are specified, only decrypt within -the region. - -If optional PASSPHRASE is not specified, it will be obtained from the -passphrase cache or user. - -\(fn &optional START END PASSPHRASE)" t nil) - -(autoload 'pgg-sign-region "pgg" "\ -Make the signature from text between START and END. - -If the optional 3rd argument CLEARTEXT is non-nil, it does not create -a detached signature. - -If this function is called interactively, CLEARTEXT is enabled -and the output is displayed. - -If optional PASSPHRASE is not specified, it will be obtained from the -passphrase cache or user. - -\(fn START END &optional CLEARTEXT PASSPHRASE)" t nil) - -(autoload 'pgg-sign "pgg" "\ -Sign the current buffer. - -If the optional argument CLEARTEXT is non-nil, it does not create a -detached signature. - -If optional arguments START and END are specified, only sign data -within the region. - -If this function is called interactively, CLEARTEXT is enabled -and the output is displayed. - -If optional PASSPHRASE is not specified, it will be obtained from the -passphrase cache or user. - -\(fn &optional CLEARTEXT START END PASSPHRASE)" t nil) - -(autoload 'pgg-verify-region "pgg" "\ -Verify the current region between START and END. -If the optional 3rd argument SIGNATURE is non-nil, it is treated as -the detached signature of the current region. - -If the optional 4th argument FETCH is non-nil, we attempt to fetch the -signer's public key from `pgg-default-keyserver-address'. - -\(fn START END &optional SIGNATURE FETCH)" t nil) - -(autoload 'pgg-verify "pgg" "\ -Verify the current buffer. -If the optional argument SIGNATURE is non-nil, it is treated as -the detached signature of the current region. -If the optional argument FETCH is non-nil, we attempt to fetch the -signer's public key from `pgg-default-keyserver-address'. -If optional arguments START and END are specified, only verify data -within the region. - -\(fn &optional SIGNATURE FETCH START END)" t nil) - -(autoload 'pgg-insert-key "pgg" "\ -Insert the ASCII armored public key. - -\(fn)" t nil) - -(autoload 'pgg-snarf-keys-region "pgg" "\ -Import public keys in the current region between START and END. - -\(fn START END)" t nil) - -(autoload 'pgg-snarf-keys "pgg" "\ -Import public keys in the current buffer. - -\(fn)" t nil) - -;;;*** - -;;;### (autoloads (pgg-gpg-symmetric-key-p) "pgg-gpg" "pgg-gpg.el" -;;;;;; (19598 13691)) -;;; Generated autoloads from pgg-gpg.el - -(autoload 'pgg-gpg-symmetric-key-p "pgg-gpg" "\ -True if decoded armor MESSAGE-KEYS has symmetric encryption indicator. - -\(fn MESSAGE-KEYS)" nil nil) - ;;;*** ;;;### (autoloads (picture-mode) "picture" "textmodes/picture.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2030)) ;;; Generated autoloads from textmodes/picture.el (autoload 'picture-mode "picture" "\ @@ -21344,7 +21437,7 @@ they are not defaultly assigned to keys. ;;;*** ;;;### (autoloads (po-find-file-coding-system) "po" "textmodes/po.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2030)) ;;; Generated autoloads from textmodes/po.el (autoload 'po-find-file-coding-system "po" "\ @@ -21355,7 +21448,7 @@ Called through `file-coding-system-alist', before the file is visited for real. ;;;*** -;;;### (autoloads (pong) "pong" "play/pong.el" (19562 42953)) +;;;### (autoloads (pong) "pong" "play/pong.el" (19775 2029)) ;;; Generated autoloads from play/pong.el (autoload 'pong "pong" "\ @@ -21371,7 +21464,7 @@ pong-mode keybindings:\\ ;;;*** -;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (19714 43298)) +;;;### (autoloads (pop3-movemail) "pop3" "gnus/pop3.el" (19775 2028)) ;;; Generated autoloads from gnus/pop3.el (autoload 'pop3-movemail "pop3" "\ @@ -21384,7 +21477,7 @@ Use streaming commands. ;;;### (autoloads (pp-macroexpand-last-sexp pp-eval-last-sexp pp-macroexpand-expression ;;;;;; pp-eval-expression pp pp-buffer pp-to-string) "pp" "emacs-lisp/pp.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/pp.el (autoload 'pp-to-string "pp" "\ @@ -21452,7 +21545,7 @@ Ignores leading comment characters. ;;;;;; pr-ps-buffer-print pr-ps-buffer-using-ghostscript pr-ps-buffer-preview ;;;;;; pr-ps-directory-ps-print pr-ps-directory-print pr-ps-directory-using-ghostscript ;;;;;; pr-ps-directory-preview pr-interface) "printing" "printing.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from printing.el (autoload 'pr-interface "printing" "\ @@ -22039,7 +22132,7 @@ are both set to t. ;;;*** -;;;### (autoloads (proced) "proced" "proced.el" (19598 13691)) +;;;### (autoloads (proced) "proced" "proced.el" (19775 2029)) ;;; Generated autoloads from proced.el (autoload 'proced "proced" "\ @@ -22054,13 +22147,21 @@ See `proced-mode' for a description of features available in Proced buffers. ;;;*** -;;;### (autoloads (switch-to-prolog prolog-mode) "prolog" "progmodes/prolog.el" -;;;;;; (19714 43298)) +;;;### (autoloads (run-prolog mercury-mode prolog-mode) "prolog" +;;;;;; "progmodes/prolog.el" (19780 4514)) ;;; Generated autoloads from progmodes/prolog.el (autoload 'prolog-mode "prolog" "\ -Major mode for editing Prolog code for Prologs. -Blank lines and `%%...' separate paragraphs. `%'s start comments. +Major mode for editing Prolog code. + +Blank lines and `%%...' separate paragraphs. `%'s starts a comment +line and comments can also be enclosed in /* ... */. + +If an optional argument SYSTEM is non-nil, set up mode for the given system. + +To find out what version of Prolog mode you are running, enter +`\\[prolog-mode-version]'. + Commands: \\{prolog-mode-map} Entry to this mode calls the value of `prolog-mode-hook' @@ -22068,18 +22169,22 @@ if that value is non-nil. \(fn)" t nil) -(defalias 'run-prolog 'switch-to-prolog) +(autoload 'mercury-mode "prolog" "\ +Major mode for editing Mercury programs. +Actually this is just customized `prolog-mode'. -(autoload 'switch-to-prolog "prolog" "\ +\(fn)" t nil) + +(autoload 'run-prolog "prolog" "\ Run an inferior Prolog process, input and output via buffer *prolog*. -With prefix argument \\[universal-prefix], prompt for the program to use. +With prefix argument ARG, restart the Prolog process if running before. -\(fn &optional NAME)" t nil) +\(fn ARG)" t nil) ;;;*** ;;;### (autoloads (open-protocol-stream) "proto-stream" "gnus/proto-stream.el" -;;;;;; (19717 39999)) +;;;;;; (19780 4513)) ;;; Generated autoloads from gnus/proto-stream.el (autoload 'open-protocol-stream "proto-stream" "\ @@ -22118,8 +22223,8 @@ command to switch on STARTTLS otherwise. ;;;*** -;;;### (autoloads (bdf-directory-list) "ps-bdf" "ps-bdf.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (bdf-directory-list) "ps-bdf" "ps-bdf.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from ps-bdf.el (defvar bdf-directory-list (if (memq system-type '(ms-dos windows-nt)) (list (expand-file-name "fonts/bdf" installation-directory)) '("/usr/local/share/emacs/fonts/bdf")) "\ @@ -22130,8 +22235,8 @@ The default value is '(\"/usr/local/share/emacs/fonts/bdf\").") ;;;*** -;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (ps-mode) "ps-mode" "progmodes/ps-mode.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from progmodes/ps-mode.el (autoload 'ps-mode "ps-mode" "\ @@ -22182,8 +22287,8 @@ Typing \\\\[ps-run-goto-error] when the cursor is at the number ;;;;;; ps-spool-region ps-spool-buffer-with-faces ps-spool-buffer ;;;;;; ps-print-region-with-faces ps-print-region ps-print-buffer-with-faces ;;;;;; ps-print-buffer ps-print-customize ps-print-color-p ps-paper-type -;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (19714 -;;;;;; 43298)) +;;;;;; ps-page-dimensions-database) "ps-print" "ps-print.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from ps-print.el (defvar ps-page-dimensions-database (purecopy (list (list 'a4 (/ (* 72 21.0) 2.54) (/ (* 72 29.7) 2.54) "A4") (list 'a3 (/ (* 72 29.7) 2.54) (/ (* 72 42.0) 2.54) "A3") (list 'letter (* 72 8.5) (* 72 11.0) "Letter") (list 'legal (* 72 8.5) (* 72 14.0) "Legal") (list 'letter-small (* 72 7.68) (* 72 10.16) "LetterSmall") (list 'tabloid (* 72 11.0) (* 72 17.0) "Tabloid") (list 'ledger (* 72 17.0) (* 72 11.0) "Ledger") (list 'statement (* 72 5.5) (* 72 8.5) "Statement") (list 'executive (* 72 7.5) (* 72 10.0) "Executive") (list 'a4small (* 72 7.47) (* 72 10.85) "A4Small") (list 'b4 (* 72 10.125) (* 72 14.33) "B4") (list 'b5 (* 72 7.16) (* 72 10.125) "B5") '(addresslarge 236.0 99.0 "AddressLarge") '(addresssmall 236.0 68.0 "AddressSmall") '(cuthanging13 90.0 222.0 "CutHanging13") '(cuthanging15 90.0 114.0 "CutHanging15") '(diskette 181.0 136.0 "Diskette") '(eurofilefolder 139.0 112.0 "EuropeanFilefolder") '(eurofoldernarrow 526.0 107.0 "EuroFolderNarrow") '(eurofolderwide 526.0 136.0 "EuroFolderWide") '(euronamebadge 189.0 108.0 "EuroNameBadge") '(euronamebadgelarge 223.0 136.0 "EuroNameBadgeLarge") '(filefolder 230.0 37.0 "FileFolder") '(jewelry 76.0 136.0 "Jewelry") '(mediabadge 180.0 136.0 "MediaBadge") '(multipurpose 126.0 68.0 "MultiPurpose") '(retaillabel 90.0 104.0 "RetailLabel") '(shipping 271.0 136.0 "Shipping") '(slide35mm 26.0 104.0 "Slide35mm") '(spine8mm 187.0 26.0 "Spine8mm") '(topcoated 425.19685 136.0 "TopCoatedPaper") '(topcoatedpaper 396.0 136.0 "TopcoatedPaper150") '(vhsface 205.0 127.0 "VHSFace") '(vhsspine 400.0 50.0 "VHSSpine") '(zipdisk 156.0 136.0 "ZipDisk"))) "\ @@ -22380,7 +22485,7 @@ If EXTENSION is any other symbol, it is ignored. ;;;*** ;;;### (autoloads (python-shell jython-mode python-mode run-python) -;;;;;; "python" "progmodes/python.el" (19714 43298)) +;;;;;; "python" "progmodes/python.el" (19780 4514)) ;;; Generated autoloads from progmodes/python.el (add-to-list 'interpreter-mode-alist (cons (purecopy "jython") 'jython-mode)) @@ -22500,7 +22605,7 @@ filter. ;;;*** ;;;### (autoloads (quoted-printable-decode-region) "qp" "gnus/qp.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/qp.el (autoload 'quoted-printable-decode-region "qp" "\ @@ -22523,7 +22628,7 @@ them into characters should be done separately. ;;;;;; quail-defrule quail-install-decode-map quail-install-map ;;;;;; quail-define-rules quail-show-keyboard-layout quail-set-keyboard-layout ;;;;;; quail-define-package quail-use-package quail-title) "quail" -;;;;;; "international/quail.el" (19591 62571)) +;;;;;; "international/quail.el" (19780 45051)) ;;; Generated autoloads from international/quail.el (autoload 'quail-title "quail" "\ @@ -22754,8 +22859,8 @@ of each directory. ;;;### (autoloads (quickurl-list quickurl-list-mode quickurl-edit-urls ;;;;;; quickurl-browse-url-ask quickurl-browse-url quickurl-add-url -;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (19714 -;;;;;; 43298)) +;;;;;; quickurl-ask quickurl) "quickurl" "net/quickurl.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from net/quickurl.el (defconst quickurl-reread-hook-postfix "\n;; Local Variables:\n;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))\n;; End:\n" "\ @@ -22827,7 +22932,7 @@ Display `quickurl-list' as a formatted list using `quickurl-list-mode'. ;;;*** ;;;### (autoloads (rcirc-track-minor-mode rcirc-connect rcirc) "rcirc" -;;;;;; "net/rcirc.el" (19598 13691)) +;;;;;; "net/rcirc.el" (19780 4514)) ;;; Generated autoloads from net/rcirc.el (autoload 'rcirc "rcirc" "\ @@ -22862,8 +22967,8 @@ Global minor mode for tracking activity in rcirc buffers. ;;;*** -;;;### (autoloads (remote-compile) "rcompile" "net/rcompile.el" (19619 -;;;;;; 52030)) +;;;### (autoloads (remote-compile) "rcompile" "net/rcompile.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from net/rcompile.el (autoload 'remote-compile "rcompile" "\ @@ -22875,7 +22980,7 @@ See \\[compile]. ;;;*** ;;;### (autoloads (re-builder) "re-builder" "emacs-lisp/re-builder.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/re-builder.el (defalias 'regexp-builder 're-builder) @@ -22887,7 +22992,7 @@ Construct a regexp interactively. ;;;*** -;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (19562 42953)) +;;;### (autoloads (recentf-mode) "recentf" "recentf.el" (19775 2029)) ;;; Generated autoloads from recentf.el (defvar recentf-mode nil "\ @@ -22911,11 +23016,11 @@ that were operated on recently. ;;;*** -;;;### (autoloads (clear-rectangle string-insert-rectangle string-rectangle -;;;;;; delete-whitespace-rectangle open-rectangle insert-rectangle -;;;;;; yank-rectangle kill-rectangle extract-rectangle delete-extract-rectangle -;;;;;; delete-rectangle move-to-column-force) "rect" "rect.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (rectangle-number-lines clear-rectangle string-insert-rectangle +;;;;;; string-rectangle delete-whitespace-rectangle open-rectangle +;;;;;; insert-rectangle yank-rectangle kill-rectangle extract-rectangle +;;;;;; delete-extract-rectangle delete-rectangle) "rect" "rect.el" +;;;;;; (19775 2029)) ;;; Generated autoloads from rect.el (define-key ctl-x-r-map "c" 'clear-rectangle) (define-key ctl-x-r-map "k" 'kill-rectangle) @@ -22923,15 +23028,7 @@ that were operated on recently. (define-key ctl-x-r-map "y" 'yank-rectangle) (define-key ctl-x-r-map "o" 'open-rectangle) (define-key ctl-x-r-map "t" 'string-rectangle) - -(autoload 'move-to-column-force "rect" "\ -If COLUMN is within a multi-column character, replace it by spaces and tab. -As for `move-to-column', passing anything but nil or t in FLAG will move to -the desired column only if the line is long enough. - -\(fn COLUMN &optional FLAG)" nil nil) - -(make-obsolete 'move-to-column-force 'move-to-column "21.2") + (define-key ctl-x-r-map "N" 'rectangle-number-lines) (autoload 'delete-rectangle "rect" "\ Delete (don't save) text in the region-rectangle. @@ -23047,10 +23144,20 @@ rectangle which were empty. \(fn START END &optional FILL)" t nil) +(autoload 'rectangle-number-lines "rect" "\ +Insert numbers in front of the region-rectangle. + +START-AT, if non-nil, should be a number from which to begin +counting. FORMAT, if non-nil, should be a format string to pass +to `format' along with the line count. When called interactively +with a prefix argument, prompt for START-AT and FORMAT. + +\(fn START END START-AT &optional FORMAT)" t nil) + ;;;*** -;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (19591 -;;;;;; 62571)) +;;;### (autoloads (refill-mode) "refill" "textmodes/refill.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from textmodes/refill.el (autoload 'refill-mode "refill" "\ @@ -23066,7 +23173,7 @@ refilling if they would cause auto-filling. ;;;*** ;;;### (autoloads (reftex-reset-scanning-information reftex-mode -;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (19598 13691)) +;;;;;; turn-on-reftex) "reftex" "textmodes/reftex.el" (19775 2030)) ;;; Generated autoloads from textmodes/reftex.el (autoload 'turn-on-reftex "reftex" "\ @@ -23116,7 +23223,7 @@ This enforces rescanning the buffer on next use. ;;;*** ;;;### (autoloads (reftex-citation) "reftex-cite" "textmodes/reftex-cite.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2030)) ;;; Generated autoloads from textmodes/reftex-cite.el (autoload 'reftex-citation "reftex-cite" "\ @@ -23146,7 +23253,7 @@ While entering the regexp, completion on knows citation keys is possible. ;;;*** ;;;### (autoloads (reftex-isearch-minor-mode) "reftex-global" "textmodes/reftex-global.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2030)) ;;; Generated autoloads from textmodes/reftex-global.el (autoload 'reftex-isearch-minor-mode "reftex-global" "\ @@ -23163,7 +23270,7 @@ With no argument, this command toggles ;;;*** ;;;### (autoloads (reftex-index-phrases-mode) "reftex-index" "textmodes/reftex-index.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2030)) ;;; Generated autoloads from textmodes/reftex-index.el (autoload 'reftex-index-phrases-mode "reftex-index" "\ @@ -23189,14 +23296,14 @@ For more information see the RefTeX User Manual. Here are all local bindings. -\\{reftex-index-phrases-map} +\\{reftex-index-phrases-mode-map} \(fn)" t nil) ;;;*** ;;;### (autoloads (reftex-all-document-files) "reftex-parse" "textmodes/reftex-parse.el" -;;;;;; (19619 52030)) +;;;;;; (19775 2030)) ;;; Generated autoloads from textmodes/reftex-parse.el (autoload 'reftex-all-document-files "reftex-parse" "\ @@ -23208,8 +23315,8 @@ of master file. ;;;*** -;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (19598 -;;;;;; 13691)) +;;;### (autoloads nil "reftex-vars" "textmodes/reftex-vars.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from textmodes/reftex-vars.el (put 'reftex-vref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) (put 'reftex-fref-is-default 'safe-local-variable (lambda (x) (or (stringp x) (symbolp x)))) @@ -23219,7 +23326,7 @@ of master file. ;;;*** ;;;### (autoloads (regexp-opt-depth regexp-opt) "regexp-opt" "emacs-lisp/regexp-opt.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/regexp-opt.el (autoload 'regexp-opt "regexp-opt" "\ @@ -23250,7 +23357,7 @@ This means the number of non-shy regexp grouping constructs ;;;### (autoloads (remember-diary-extract-entries remember-clipboard ;;;;;; remember-other-frame remember) "remember" "textmodes/remember.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2030)) ;;; Generated autoloads from textmodes/remember.el (autoload 'remember "remember" "\ @@ -23281,7 +23388,7 @@ Extract diary entries from the region. ;;;*** -;;;### (autoloads (repeat) "repeat" "repeat.el" (19714 43298)) +;;;### (autoloads (repeat) "repeat" "repeat.el" (19775 2029)) ;;; Generated autoloads from repeat.el (autoload 'repeat "repeat" "\ @@ -23304,7 +23411,7 @@ recently executed command not bound to an input event\". ;;;*** ;;;### (autoloads (reporter-submit-bug-report) "reporter" "mail/reporter.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from mail/reporter.el (autoload 'reporter-submit-bug-report "reporter" "\ @@ -23336,7 +23443,7 @@ mail-sending package is used for editing and sending the message. ;;;*** ;;;### (autoloads (reposition-window) "reposition" "reposition.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from reposition.el (autoload 'reposition-window "reposition" "\ @@ -23363,7 +23470,7 @@ first comment line visible (if point is in a comment). ;;;*** ;;;### (autoloads (global-reveal-mode reveal-mode) "reveal" "reveal.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2029)) ;;; Generated autoloads from reveal.el (autoload 'reveal-mode "reveal" "\ @@ -23398,7 +23505,7 @@ With zero or negative ARG turn mode off. ;;;*** ;;;### (autoloads (make-ring ring-p) "ring" "emacs-lisp/ring.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/ring.el (autoload 'ring-p "ring" "\ @@ -23413,7 +23520,7 @@ Make a ring that can contain SIZE elements. ;;;*** -;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (19619 52030)) +;;;### (autoloads (rlogin) "rlogin" "net/rlogin.el" (19775 2029)) ;;; Generated autoloads from net/rlogin.el (add-hook 'same-window-regexps (purecopy "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)")) @@ -23463,8 +23570,8 @@ variable. ;;;;;; rmail-secondary-file-directory rmail-primary-inbox-list rmail-highlighted-headers ;;;;;; rmail-retry-ignored-headers rmail-displayed-headers rmail-ignored-headers ;;;;;; rmail-dont-reply-to-names rmail-user-mail-address-regexp -;;;;;; rmail-movemail-variant-p) "rmail" "mail/rmail.el" (19714 -;;;;;; 43298)) +;;;;;; rmail-movemail-variant-p) "rmail" "mail/rmail.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from mail/rmail.el (autoload 'rmail-movemail-variant-p "rmail" "\ @@ -23658,7 +23765,7 @@ Set PASSWORD to be used for retrieving mail from a POP or IMAP server. ;;;*** ;;;### (autoloads (rmail-output-body-to-file rmail-output-as-seen -;;;;;; rmail-output) "rmailout" "mail/rmailout.el" (19598 13691)) +;;;;;; rmail-output) "rmailout" "mail/rmailout.el" (19780 4513)) ;;; Generated autoloads from mail/rmailout.el (put 'rmail-output-file-alist 'risky-local-variable t) @@ -23723,7 +23830,7 @@ than appending to it. Deletes the message after writing if ;;;*** ;;;### (autoloads (rng-c-load-schema) "rng-cmpct" "nxml/rng-cmpct.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from nxml/rng-cmpct.el (autoload 'rng-c-load-schema "rng-cmpct" "\ @@ -23735,7 +23842,7 @@ Return a pattern. ;;;*** ;;;### (autoloads (rng-nxml-mode-init) "rng-nxml" "nxml/rng-nxml.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from nxml/rng-nxml.el (autoload 'rng-nxml-mode-init "rng-nxml" "\ @@ -23748,7 +23855,7 @@ Validation will be enabled if `rng-nxml-auto-validate-flag' is non-nil. ;;;*** ;;;### (autoloads (rng-validate-mode) "rng-valid" "nxml/rng-valid.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from nxml/rng-valid.el (autoload 'rng-validate-mode "rng-valid" "\ @@ -23778,8 +23885,8 @@ to use for finding the schema. ;;;*** -;;;### (autoloads (rng-xsd-compile) "rng-xsd" "nxml/rng-xsd.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (rng-xsd-compile) "rng-xsd" "nxml/rng-xsd.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from nxml/rng-xsd.el (put 'http://www\.w3\.org/2001/XMLSchema-datatypes 'rng-dt-compile 'rng-xsd-compile) @@ -23807,7 +23914,7 @@ must be equal. ;;;*** ;;;### (autoloads (robin-use-package robin-modify-package robin-define-package) -;;;;;; "robin" "international/robin.el" (19562 42953)) +;;;;;; "robin" "international/robin.el" (19763 27286)) ;;; Generated autoloads from international/robin.el (autoload 'robin-define-package "robin" "\ @@ -23840,7 +23947,7 @@ Start using robin package NAME, which is a string. ;;;*** ;;;### (autoloads (toggle-rot13-mode rot13-other-window rot13-region -;;;;;; rot13-string rot13) "rot13" "rot13.el" (19591 62571)) +;;;;;; rot13-string rot13) "rot13" "rot13.el" (19775 2029)) ;;; Generated autoloads from rot13.el (autoload 'rot13 "rot13" "\ @@ -23878,7 +23985,7 @@ Toggle the use of ROT13 encoding for the current window. ;;;*** ;;;### (autoloads (rst-minor-mode rst-mode) "rst" "textmodes/rst.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from textmodes/rst.el (add-to-list 'auto-mode-alist (purecopy '("\\.re?st\\'" . rst-mode))) @@ -23916,7 +24023,7 @@ for modes derived from Text mode, like Mail mode. ;;;*** ;;;### (autoloads (ruby-mode) "ruby-mode" "progmodes/ruby-mode.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/ruby-mode.el (autoload 'ruby-mode "ruby-mode" "\ @@ -23937,8 +24044,8 @@ The variable `ruby-indent-level' controls the amount of indentation. ;;;*** -;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (ruler-mode) "ruler-mode" "ruler-mode.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from ruler-mode.el (defvar ruler-mode nil "\ @@ -23953,8 +24060,8 @@ In Ruler mode, Emacs displays a ruler in the header line. ;;;*** -;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (rx rx-to-string) "rx" "emacs-lisp/rx.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from emacs-lisp/rx.el (autoload 'rx-to-string "rx" "\ @@ -24260,8 +24367,8 @@ enclosed in `(and ...)'. ;;;*** -;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (19591 -;;;;;; 62571)) +;;;### (autoloads (savehist-mode) "savehist" "savehist.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from savehist.el (defvar savehist-mode nil "\ @@ -24289,7 +24396,7 @@ which is probably undesirable. ;;;*** ;;;### (autoloads (dsssl-mode scheme-mode) "scheme" "progmodes/scheme.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/scheme.el (autoload 'scheme-mode "scheme" "\ @@ -24331,7 +24438,7 @@ that variable's value is a string. ;;;*** ;;;### (autoloads (gnus-score-mode) "score-mode" "gnus/score-mode.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/score-mode.el (autoload 'gnus-score-mode "score-mode" "\ @@ -24345,7 +24452,7 @@ This mode is an extended emacs-lisp mode. ;;;*** ;;;### (autoloads (scroll-all-mode) "scroll-all" "scroll-all.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from scroll-all.el (defvar scroll-all-mode nil "\ @@ -24368,7 +24475,7 @@ apply to all visible windows in the same frame. ;;;*** ;;;### (autoloads (scroll-lock-mode) "scroll-lock" "scroll-lock.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2029)) ;;; Generated autoloads from scroll-lock.el (autoload 'scroll-lock-mode "scroll-lock" "\ @@ -24382,7 +24489,7 @@ during scrolling. ;;;*** -;;;### (autoloads nil "secrets" "net/secrets.el" (19562 42953)) +;;;### (autoloads nil "secrets" "net/secrets.el" (19775 2029)) ;;; Generated autoloads from net/secrets.el (when (featurep 'dbusbind) (autoload 'secrets-show-secrets "secrets" nil t)) @@ -24390,7 +24497,7 @@ during scrolling. ;;;*** ;;;### (autoloads (semantic-mode semantic-default-submodes) "semantic" -;;;;;; "cedet/semantic.el" (19619 52030)) +;;;;;; "cedet/semantic.el" (19775 2027)) ;;; Generated autoloads from cedet/semantic.el (defvar semantic-default-submodes '(global-semantic-idle-scheduler-mode global-semanticdb-minor-mode) "\ @@ -24435,14 +24542,13 @@ Semantic mode. ;;;*** ;;;### (autoloads (mail-other-frame mail-other-window mail mail-mailing-lists -;;;;;; mail-mode mail-send-nonascii mail-bury-selects-summary mail-default-headers +;;;;;; mail-mode sendmail-user-agent-compose mail-default-headers ;;;;;; mail-default-directory mail-signature-file mail-signature ;;;;;; mail-citation-prefix-regexp mail-citation-hook mail-indentation-spaces ;;;;;; mail-yank-prefix mail-setup-hook mail-personal-alias-file -;;;;;; mail-alias-file mail-default-reply-to mail-archive-file-name -;;;;;; mail-header-separator send-mail-function mail-interactive -;;;;;; mail-self-blind mail-specify-envelope-from mail-from-style) -;;;;;; "sendmail" "mail/sendmail.el" (19714 43298)) +;;;;;; mail-default-reply-to mail-archive-file-name mail-header-separator +;;;;;; send-mail-function mail-interactive mail-self-blind mail-specify-envelope-from +;;;;;; mail-from-style) "sendmail" "mail/sendmail.el" (19775 2029)) ;;; Generated autoloads from mail/sendmail.el (defvar mail-from-style 'default "\ @@ -24517,14 +24623,6 @@ when you first send mail.") (custom-autoload 'mail-default-reply-to "sendmail" t) -(defvar mail-alias-file nil "\ -If non-nil, the name of a file to use instead of `/usr/lib/aliases'. -This file defines aliases to be expanded by the mailer; this is a different -feature from that of defining aliases in `.mailrc' to be expanded in Emacs. -This variable has no effect unless your system uses sendmail as its mailer.") - -(custom-autoload 'mail-alias-file "sendmail" t) - (defvar mail-personal-alias-file (purecopy "~/.mailrc") "\ If non-nil, the name of the user's personal mail alias file. This file typically should be in same format as the `.mailrc' file used by @@ -24611,24 +24709,12 @@ before you edit the message, so you can edit or delete the lines.") (custom-autoload 'mail-default-headers "sendmail" t) -(defvar mail-bury-selects-summary t "\ -If non-nil, try to show Rmail summary buffer after returning from mail. -The functions \\[mail-send-on-exit] or \\[mail-dont-send] select -the Rmail summary buffer before returning, if it exists and this variable -is non-nil.") +(define-mail-user-agent 'sendmail-user-agent 'sendmail-user-agent-compose 'mail-send-and-exit) -(custom-autoload 'mail-bury-selects-summary "sendmail" t) +(autoload 'sendmail-user-agent-compose "sendmail" "\ +Not documented -(defvar mail-send-nonascii 'mime "\ -Specify whether to allow sending non-ASCII characters in mail. -If t, that means do allow it. nil means don't allow it. -`query' means ask the user each time. -`mime' means add an appropriate MIME header if none already present. -The default is `mime'. -Including non-ASCII characters in a mail message can be problematical -for the recipient, who may not know how to decode them properly.") - -(custom-autoload 'mail-send-nonascii "sendmail" t) +\(fn &optional TO SUBJECT OTHER-HEADERS CONTINUE SWITCH-FUNCTION YANK-ACTION SEND-ACTIONS RETURN-ACTION &rest IGNORED)" nil nil) (autoload 'mail-mode "sendmail" "\ Major mode for editing mail to be sent. @@ -24727,7 +24813,7 @@ The seventh argument ACTIONS is a list of actions to take when the message is sent, we apply FUNCTION to ARGS. This is how Rmail arranges to mark messages `answered'. -\(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER ACTIONS)" t nil) +\(fn &optional NOERASE TO SUBJECT IN-REPLY-TO CC REPLYBUFFER ACTIONS RETURN-ACTION)" t nil) (autoload 'mail-other-window "sendmail" "\ Like `mail' command, but display mail buffer in another window. @@ -24742,8 +24828,8 @@ Like `mail' command, but display mail buffer in another frame. ;;;*** ;;;### (autoloads (server-save-buffers-kill-terminal server-mode -;;;;;; server-force-delete server-start) "server" "server.el" (19714 -;;;;;; 43298)) +;;;;;; server-force-delete server-start) "server" "server.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from server.el (put 'server-host 'risky-local-variable t) @@ -24806,7 +24892,7 @@ only these files will be asked to be saved. ;;;*** -;;;### (autoloads (ses-mode) "ses" "ses.el" (19591 62571)) +;;;### (autoloads (ses-mode) "ses" "ses.el" (19780 4514)) ;;; Generated autoloads from ses.el (autoload 'ses-mode "ses" "\ @@ -24825,7 +24911,7 @@ These are active only in the minibuffer, when entering or editing a formula: ;;;*** ;;;### (autoloads (html-mode sgml-mode) "sgml-mode" "textmodes/sgml-mode.el" -;;;;;; (19717 39999)) +;;;;;; (19780 4514)) ;;; Generated autoloads from textmodes/sgml-mode.el (autoload 'sgml-mode "sgml-mode" "\ @@ -24891,7 +24977,7 @@ To work around that, do: ;;;*** ;;;### (autoloads (sh-mode) "sh-script" "progmodes/sh-script.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/sh-script.el (put 'sh-shell 'safe-local-variable 'symbolp) @@ -24955,7 +25041,7 @@ with your script for an edit-interpret-debug cycle. ;;;*** -;;;### (autoloads (sha1) "sha1" "sha1.el" (19598 13691)) +;;;### (autoloads (sha1) "sha1" "sha1.el" (19775 2029)) ;;; Generated autoloads from sha1.el (autoload 'sha1 "sha1" "\ @@ -24970,7 +25056,7 @@ If BINARY is non-nil, return a string in binary form. ;;;*** ;;;### (autoloads (list-load-path-shadows) "shadow" "emacs-lisp/shadow.el" -;;;;;; (19640 47194)) +;;;;;; (19781 20658)) ;;; Generated autoloads from emacs-lisp/shadow.el (autoload 'list-load-path-shadows "shadow" "\ @@ -25020,8 +25106,8 @@ function, `load-path-shadows-find'. ;;;*** ;;;### (autoloads (shadow-initialize shadow-define-regexp-group shadow-define-literal-group -;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (19562 -;;;;;; 42953)) +;;;;;; shadow-define-cluster) "shadowfile" "shadowfile.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from shadowfile.el (autoload 'shadow-define-cluster "shadowfile" "\ @@ -25060,7 +25146,7 @@ Set up file shadowing. ;;;*** ;;;### (autoloads (shell shell-dumb-shell-regexp) "shell" "shell.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from shell.el (defvar shell-dumb-shell-regexp (purecopy "cmd\\(proxy\\)?\\.exe") "\ @@ -25109,8 +25195,8 @@ Otherwise, one argument `-i' is passed to the shell. ;;;*** -;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (shr-insert-document) "shr" "gnus/shr.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from gnus/shr.el (autoload 'shr-insert-document "shr" "\ @@ -25121,7 +25207,7 @@ Not documented ;;;*** ;;;### (autoloads (sieve-upload-and-bury sieve-upload sieve-manage) -;;;;;; "sieve" "gnus/sieve.el" (19640 47194)) +;;;;;; "sieve" "gnus/sieve.el" (19775 2028)) ;;; Generated autoloads from gnus/sieve.el (autoload 'sieve-manage "sieve" "\ @@ -25142,7 +25228,7 @@ Not documented ;;;*** ;;;### (autoloads (sieve-mode) "sieve-mode" "gnus/sieve-mode.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/sieve-mode.el (autoload 'sieve-mode "sieve-mode" "\ @@ -25157,8 +25243,8 @@ Turning on Sieve mode runs `sieve-mode-hook'. ;;;*** -;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (simula-mode) "simula" "progmodes/simula.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from progmodes/simula.el (autoload 'simula-mode "simula" "\ @@ -25207,7 +25293,7 @@ with no arguments, if that value is non-nil. ;;;*** ;;;### (autoloads (skeleton-pair-insert-maybe skeleton-insert skeleton-proxy-new -;;;;;; define-skeleton) "skeleton" "skeleton.el" (19714 43298)) +;;;;;; define-skeleton) "skeleton" "skeleton.el" (19775 2030)) ;;; Generated autoloads from skeleton.el (defvar skeleton-filter-function 'identity "\ @@ -25317,7 +25403,7 @@ symmetrical ones, and the same character twice for the others. ;;;*** ;;;### (autoloads (smerge-start-session smerge-mode smerge-ediff) -;;;;;; "smerge-mode" "vc/smerge-mode.el" (19714 43298)) +;;;;;; "smerge-mode" "vc/smerge-mode.el" (19775 2030)) ;;; Generated autoloads from vc/smerge-mode.el (autoload 'smerge-ediff "smerge-mode" "\ @@ -25342,7 +25428,7 @@ If no conflict maker is found, turn off `smerge-mode'. ;;;*** ;;;### (autoloads (smiley-buffer smiley-region) "smiley" "gnus/smiley.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/smiley.el (autoload 'smiley-region "smiley" "\ @@ -25360,7 +25446,7 @@ interactively. If there's no argument, do it at the current buffer. ;;;*** ;;;### (autoloads (smtpmail-send-queued-mail smtpmail-send-it) "smtpmail" -;;;;;; "mail/smtpmail.el" (19562 42953)) +;;;;;; "mail/smtpmail.el" (19775 2029)) ;;; Generated autoloads from mail/smtpmail.el (autoload 'smtpmail-send-it "smtpmail" "\ @@ -25375,7 +25461,7 @@ Send mail that was queued as a result of setting `smtpmail-queue-mail'. ;;;*** -;;;### (autoloads (snake) "snake" "play/snake.el" (19562 42953)) +;;;### (autoloads (snake) "snake" "play/snake.el" (19775 2029)) ;;; Generated autoloads from play/snake.el (autoload 'snake "snake" "\ @@ -25399,7 +25485,7 @@ Snake mode keybindings: ;;;*** ;;;### (autoloads (snmpv2-mode snmp-mode) "snmp-mode" "net/snmp-mode.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from net/snmp-mode.el (autoload 'snmp-mode "snmp-mode" "\ @@ -25428,8 +25514,8 @@ then `snmpv2-mode-hook'. ;;;*** -;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (19619 -;;;;;; 52030)) +;;;### (autoloads (sunrise-sunset) "solar" "calendar/solar.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from calendar/solar.el (autoload 'sunrise-sunset "solar" "\ @@ -25444,8 +25530,8 @@ This function is suitable for execution in a .emacs file. ;;;*** -;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (solitaire) "solitaire" "play/solitaire.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from play/solitaire.el (autoload 'solitaire "solitaire" "\ @@ -25522,7 +25608,7 @@ Pick your favourite shortcuts: ;;;### (autoloads (reverse-region sort-columns sort-regexp-fields ;;;;;; sort-fields sort-numeric-fields sort-pages sort-paragraphs -;;;;;; sort-lines sort-subr) "sort" "sort.el" (19714 43298)) +;;;;;; sort-lines sort-subr) "sort" "sort.el" (19780 4514)) ;;; Generated autoloads from sort.el (put 'sort-fold-case 'safe-local-variable 'booleanp) @@ -25666,8 +25752,8 @@ From a program takes two point or marker arguments, BEG and END. ;;;*** -;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (spam-initialize) "spam" "gnus/spam.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from gnus/spam.el (autoload 'spam-initialize "spam" "\ @@ -25683,7 +25769,7 @@ installed through `spam-necessary-extra-headers'. ;;;### (autoloads (spam-report-deagentize spam-report-agentize spam-report-url-to-file ;;;;;; spam-report-url-ping-mm-url spam-report-process-queue) "spam-report" -;;;;;; "gnus/spam-report.el" (19640 47194)) +;;;;;; "gnus/spam-report.el" (19780 4513)) ;;; Generated autoloads from gnus/spam-report.el (autoload 'spam-report-process-queue "spam-report" "\ @@ -25726,7 +25812,7 @@ Spam reports will be queued with the method used when ;;;*** ;;;### (autoloads (speedbar-get-focus speedbar-frame-mode) "speedbar" -;;;;;; "speedbar.el" (19714 43298)) +;;;;;; "speedbar.el" (19780 4514)) ;;; Generated autoloads from speedbar.el (defalias 'speedbar 'speedbar-frame-mode) @@ -25750,53 +25836,8 @@ selected. If the speedbar frame is active, then select the attached frame. ;;;*** -;;;### (autoloads (spell-string spell-region spell-word spell-buffer) -;;;;;; "spell" "textmodes/spell.el" (19619 52030)) -;;; Generated autoloads from textmodes/spell.el - -(put 'spell-filter 'risky-local-variable t) - -(autoload 'spell-buffer "spell" "\ -Check spelling of every word in the buffer. -For each incorrect word, you are asked for the correct spelling -and then put into a query-replace to fix some or all occurrences. -If you do not want to change a word, just give the same word -as its \"correct\" spelling; then the query replace is skipped. - -\(fn)" t nil) - -(make-obsolete 'spell-buffer 'ispell-buffer "23.1") - -(autoload 'spell-word "spell" "\ -Check spelling of word at or before point. -If it is not correct, ask user for the correct spelling -and `query-replace' the entire buffer to substitute it. - -\(fn)" t nil) - -(make-obsolete 'spell-word 'ispell-word "23.1") - -(autoload 'spell-region "spell" "\ -Like `spell-buffer' but applies only to region. -Used in a program, applies from START to END. -DESCRIPTION is an optional string naming the unit being checked: -for example, \"word\". - -\(fn START END &optional DESCRIPTION)" t nil) - -(make-obsolete 'spell-region 'ispell-region "23.1") - -(autoload 'spell-string "spell" "\ -Check spelling of string supplied as argument. - -\(fn STRING)" t nil) - -(make-obsolete 'spell-string "The `spell' package is obsolete - use `ispell'." "23.1") - -;;;*** - -;;;### (autoloads (snarf-spooks spook) "spook" "play/spook.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (snarf-spooks spook) "spook" "play/spook.el" (19775 +;;;;;; 2029)) ;;; Generated autoloads from play/spook.el (autoload 'spook "spook" "\ @@ -25815,7 +25856,7 @@ Return a vector containing the lines from `spook-phrases-file'. ;;;;;; sql-ms sql-ingres sql-solid sql-mysql sql-sqlite sql-informix ;;;;;; sql-sybase sql-oracle sql-product-interactive sql-connect ;;;;;; sql-mode sql-help sql-add-product-keywords) "sql" "progmodes/sql.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/sql.el (autoload 'sql-add-product-keywords "sql" "\ @@ -26311,7 +26352,7 @@ buffer. ;;;*** ;;;### (autoloads (srecode-template-mode) "srecode/srt-mode" "cedet/srecode/srt-mode.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2027)) ;;; Generated autoloads from cedet/srecode/srt-mode.el (autoload 'srecode-template-mode "srecode/srt-mode" "\ @@ -26324,7 +26365,7 @@ Major-mode for writing SRecode macros. ;;;*** ;;;### (autoloads (starttls-open-stream) "starttls" "gnus/starttls.el" -;;;;;; (19619 52030)) +;;;;;; (19775 2028)) ;;; Generated autoloads from gnus/starttls.el (autoload 'starttls-open-stream "starttls" "\ @@ -26351,8 +26392,8 @@ GNUTLS requires a port number. ;;;;;; strokes-mode strokes-list-strokes strokes-load-user-strokes ;;;;;; strokes-help strokes-describe-stroke strokes-do-complex-stroke ;;;;;; strokes-do-stroke strokes-read-complex-stroke strokes-read-stroke -;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (19562 -;;;;;; 42953)) +;;;;;; strokes-global-set-stroke) "strokes" "strokes.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from strokes.el (autoload 'strokes-global-set-stroke "strokes" "\ @@ -26462,7 +26503,7 @@ Read a complex stroke and insert its glyph into the current buffer. ;;;*** ;;;### (autoloads (studlify-buffer studlify-word studlify-region) -;;;;;; "studly" "play/studly.el" (19562 42953)) +;;;;;; "studly" "play/studly.el" (19763 27287)) ;;; Generated autoloads from play/studly.el (autoload 'studlify-region "studly" "\ @@ -26483,7 +26524,7 @@ Studlify-case the current buffer. ;;;*** ;;;### (autoloads (global-subword-mode subword-mode) "subword" "progmodes/subword.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/subword.el (autoload 'subword-mode "subword" "\ @@ -26531,7 +26572,7 @@ See `subword-mode' for more information on Subword mode. ;;;*** ;;;### (autoloads (sc-cite-original) "supercite" "mail/supercite.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from mail/supercite.el (autoload 'sc-cite-original "supercite" "\ @@ -26563,8 +26604,8 @@ and `sc-post-hook' is run after the guts of this function. ;;;*** -;;;### (autoloads (gpm-mouse-mode) "t-mouse" "t-mouse.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (gpm-mouse-mode) "t-mouse" "t-mouse.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from t-mouse.el (define-obsolete-function-alias 't-mouse-mode 'gpm-mouse-mode "23.1") @@ -26591,7 +26632,7 @@ It relies on the `gpm' daemon being activated. ;;;*** -;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (19598 13691)) +;;;### (autoloads (tabify untabify) "tabify" "tabify.el" (19775 2030)) ;;; Generated autoloads from tabify.el (autoload 'untabify "tabify" "\ @@ -26626,7 +26667,7 @@ The variable `tab-width' controls the spacing of tab stops. ;;;;;; table-recognize table-insert-row-column table-insert-column ;;;;;; table-insert-row table-insert table-point-left-cell-hook ;;;;;; table-point-entered-cell-hook table-load-hook table-cell-map-hook) -;;;;;; "table" "textmodes/table.el" (19714 43298)) +;;;;;; "table" "textmodes/table.el" (19775 2030)) ;;; Generated autoloads from textmodes/table.el (defvar table-cell-map-hook nil "\ @@ -27214,7 +27255,7 @@ converts a table into plain text without frames. It is a companion to ;;;*** -;;;### (autoloads (talk talk-connect) "talk" "talk.el" (19562 42953)) +;;;### (autoloads (talk talk-connect) "talk" "talk.el" (19775 2030)) ;;; Generated autoloads from talk.el (autoload 'talk-connect "talk" "\ @@ -27229,7 +27270,7 @@ Connect to the Emacs talk group from the current X display or tty frame. ;;;*** -;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (19619 52030)) +;;;### (autoloads (tar-mode) "tar-mode" "tar-mode.el" (19780 4514)) ;;; Generated autoloads from tar-mode.el (autoload 'tar-mode "tar-mode" "\ @@ -27253,7 +27294,7 @@ See also: variables `tar-update-datestamp' and `tar-anal-blocksize'. ;;;*** ;;;### (autoloads (tcl-help-on-word inferior-tcl tcl-mode) "tcl" -;;;;;; "progmodes/tcl.el" (19714 43298)) +;;;;;; "progmodes/tcl.el" (19775 2029)) ;;; Generated autoloads from progmodes/tcl.el (autoload 'tcl-mode "tcl" "\ @@ -27301,7 +27342,7 @@ Prefix argument means invert sense of `tcl-use-smart-word-finder'. ;;;*** -;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (19640 47194)) +;;;### (autoloads (rsh telnet) "telnet" "net/telnet.el" (19780 4514)) ;;; Generated autoloads from net/telnet.el (add-hook 'same-window-regexps (purecopy "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")) @@ -27329,7 +27370,7 @@ Normally input is edited in Emacs and sent a line at a time. ;;;*** ;;;### (autoloads (serial-term ansi-term term make-term) "term" "term.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2030)) ;;; Generated autoloads from term.el (autoload 'make-term "term" "\ @@ -27371,8 +27412,8 @@ use in that buffer. ;;;*** -;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (19591 -;;;;;; 62571)) +;;;### (autoloads (terminal-emulator) "terminal" "terminal.el" (19780 +;;;;;; 4514)) ;;; Generated autoloads from terminal.el (autoload 'terminal-emulator "terminal" "\ @@ -27409,7 +27450,7 @@ subprocess started. ;;;*** ;;;### (autoloads (testcover-this-defun) "testcover" "emacs-lisp/testcover.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/testcover.el (autoload 'testcover-this-defun "testcover" "\ @@ -27419,7 +27460,7 @@ Start coverage on function under point. ;;;*** -;;;### (autoloads (tetris) "tetris" "play/tetris.el" (19562 42953)) +;;;### (autoloads (tetris) "tetris" "play/tetris.el" (19775 2029)) ;;; Generated autoloads from play/tetris.el (autoload 'tetris "tetris" "\ @@ -27450,7 +27491,7 @@ tetris-mode keybindings: ;;;;;; tex-start-commands tex-start-options slitex-run-command latex-run-command ;;;;;; tex-run-command tex-offer-save tex-main-file tex-first-line-header-regexp ;;;;;; tex-directory tex-shell-file-name) "tex-mode" "textmodes/tex-mode.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from textmodes/tex-mode.el (defvar tex-shell-file-name nil "\ @@ -27752,7 +27793,7 @@ Major mode to edit DocTeX files. ;;;*** ;;;### (autoloads (texi2info texinfo-format-region texinfo-format-buffer) -;;;;;; "texinfmt" "textmodes/texinfmt.el" (19714 43298)) +;;;;;; "texinfmt" "textmodes/texinfmt.el" (19780 4514)) ;;; Generated autoloads from textmodes/texinfmt.el (autoload 'texinfo-format-buffer "texinfmt" "\ @@ -27792,7 +27833,7 @@ if large. You can use `Info-split' to do this manually. ;;;*** ;;;### (autoloads (texinfo-mode texinfo-close-quote texinfo-open-quote) -;;;;;; "texinfo" "textmodes/texinfo.el" (19714 43298)) +;;;;;; "texinfo" "textmodes/texinfo.el" (19775 2030)) ;;; Generated autoloads from textmodes/texinfo.el (defvar texinfo-open-quote (purecopy "``") "\ @@ -27878,7 +27919,7 @@ value of `texinfo-mode-hook'. ;;;### (autoloads (thai-composition-function thai-compose-buffer ;;;;;; thai-compose-string thai-compose-region) "thai-util" "language/thai-util.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2028)) ;;; Generated autoloads from language/thai-util.el (autoload 'thai-compose-region "thai-util" "\ @@ -27907,7 +27948,7 @@ Not documented ;;;### (autoloads (list-at-point number-at-point symbol-at-point ;;;;;; sexp-at-point thing-at-point bounds-of-thing-at-point forward-thing) -;;;;;; "thingatpt" "thingatpt.el" (19562 42953)) +;;;;;; "thingatpt" "thingatpt.el" (19780 4514)) ;;; Generated autoloads from thingatpt.el (autoload 'forward-thing "thingatpt" "\ @@ -27964,7 +28005,7 @@ Return the Lisp list at point, or nil if none is found. ;;;### (autoloads (thumbs-dired-setroot thumbs-dired-show thumbs-dired-show-marked ;;;;;; thumbs-show-from-dir thumbs-find-thumb) "thumbs" "thumbs.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2030)) ;;; Generated autoloads from thumbs.el (autoload 'thumbs-find-thumb "thumbs" "\ @@ -28002,8 +28043,8 @@ In dired, call the setroot program on the image at point. ;;;;;; tibetan-post-read-conversion tibetan-compose-buffer tibetan-decompose-buffer ;;;;;; tibetan-decompose-string tibetan-decompose-region tibetan-compose-region ;;;;;; tibetan-compose-string tibetan-transcription-to-tibetan tibetan-tibetan-to-transcription -;;;;;; tibetan-char-p) "tibet-util" "language/tibet-util.el" (19562 -;;;;;; 42953)) +;;;;;; tibetan-char-p) "tibet-util" "language/tibet-util.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from language/tibet-util.el (autoload 'tibetan-char-p "tibet-util" "\ @@ -28077,7 +28118,7 @@ Not documented ;;;*** ;;;### (autoloads (tildify-buffer tildify-region) "tildify" "textmodes/tildify.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2030)) ;;; Generated autoloads from textmodes/tildify.el (autoload 'tildify-region "tildify" "\ @@ -28102,7 +28143,7 @@ This function performs no refilling of the changed text. ;;;### (autoloads (emacs-init-time emacs-uptime display-time-world ;;;;;; display-time-mode display-time display-time-day-and-date) -;;;;;; "time" "time.el" (19640 47194)) +;;;;;; "time" "time.el" (19780 4514)) ;;; Generated autoloads from time.el (defvar display-time-day-and-date nil "\ @@ -28133,7 +28174,9 @@ or call the function `display-time-mode'.") Toggle display of time, load level, and mail flag in mode lines. With a numeric arg, enable this display if arg is positive. -When this display is enabled, it updates automatically every minute. +When this display is enabled, it updates automatically every minute +\(you can control the number of seconds between updates by +customizing `display-time-interval'). If `display-time-day-and-date' is non-nil, the current day and date are displayed as well. This runs the normal hook `display-time-hook' after each update. @@ -28165,7 +28208,7 @@ Return a string giving the duration of the Emacs initialization. ;;;;;; time-to-day-in-year date-leap-year-p days-between date-to-day ;;;;;; time-add time-subtract time-since days-to-time time-less-p ;;;;;; seconds-to-time date-to-time) "time-date" "calendar/time-date.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2027)) ;;; Generated autoloads from calendar/time-date.el (autoload 'date-to-time "time-date" "\ @@ -28279,7 +28322,7 @@ This function does not work for SECONDS greater than `most-positive-fixnum'. ;;;*** ;;;### (autoloads (time-stamp-toggle-active time-stamp) "time-stamp" -;;;;;; "time-stamp.el" (19562 42953)) +;;;;;; "time-stamp.el" (19780 4514)) ;;; Generated autoloads from time-stamp.el (put 'time-stamp-format 'safe-local-variable 'stringp) (put 'time-stamp-time-zone 'safe-local-variable 'string-or-null-p) @@ -28323,7 +28366,7 @@ With ARG, turn time stamping on if and only if arg is positive. ;;;;;; timeclock-workday-remaining-string timeclock-reread-log timeclock-query-out ;;;;;; timeclock-change timeclock-status-string timeclock-out timeclock-in ;;;;;; timeclock-modeline-display) "timeclock" "calendar/timeclock.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2027)) ;;; Generated autoloads from calendar/timeclock.el (autoload 'timeclock-modeline-display "timeclock" "\ @@ -28423,7 +28466,7 @@ relative only to the time worked today, and not to past time. ;;;*** ;;;### (autoloads (batch-titdic-convert titdic-convert) "titdic-cnv" -;;;;;; "international/titdic-cnv.el" (19640 47194)) +;;;;;; "international/titdic-cnv.el" (19775 2028)) ;;; Generated autoloads from international/titdic-cnv.el (autoload 'titdic-convert "titdic-cnv" "\ @@ -28446,7 +28489,7 @@ To get complete usage, invoke \"emacs -batch -f batch-titdic-convert -h\". ;;;*** ;;;### (autoloads (tmm-prompt tmm-menubar-mouse tmm-menubar) "tmm" -;;;;;; "tmm.el" (19562 42953)) +;;;;;; "tmm.el" (19775 2030)) ;;; Generated autoloads from tmm.el (define-key global-map "\M-`" 'tmm-menubar) (define-key global-map [menu-bar mouse-1] 'tmm-menubar-mouse) @@ -28486,7 +28529,7 @@ Its value should be an event that has a binding in MENU. ;;;### (autoloads (todo-show todo-cp todo-mode todo-print todo-top-priorities ;;;;;; todo-insert-item todo-add-item-non-interactively todo-add-category) -;;;;;; "todo-mode" "calendar/todo-mode.el" (19562 42953)) +;;;;;; "todo-mode" "calendar/todo-mode.el" (19775 2027)) ;;; Generated autoloads from calendar/todo-mode.el (autoload 'todo-add-category "todo-mode" "\ @@ -28546,7 +28589,7 @@ Show TODO list. ;;;### (autoloads (tool-bar-local-item-from-menu tool-bar-add-item-from-menu ;;;;;; tool-bar-local-item tool-bar-add-item toggle-tool-bar-mode-from-frame) -;;;;;; "tool-bar" "tool-bar.el" (19714 43298)) +;;;;;; "tool-bar" "tool-bar.el" (19775 2030)) ;;; Generated autoloads from tool-bar.el (autoload 'toggle-tool-bar-mode-from-frame "tool-bar" "\ @@ -28617,7 +28660,7 @@ holds a keymap. ;;;*** ;;;### (autoloads (tpu-edt-on tpu-edt-mode) "tpu-edt" "emulation/tpu-edt.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4513)) ;;; Generated autoloads from emulation/tpu-edt.el (defvar tpu-edt-mode nil "\ @@ -28644,7 +28687,7 @@ Turn on TPU/edt emulation. ;;;*** ;;;### (autoloads (tpu-mapper) "tpu-mapper" "emulation/tpu-mapper.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emulation/tpu-mapper.el (autoload 'tpu-mapper "tpu-mapper" "\ @@ -28678,7 +28721,7 @@ your local X guru can try to figure out why the key is being ignored. ;;;*** -;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (19562 42953)) +;;;### (autoloads (tq-create) "tq" "emacs-lisp/tq.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/tq.el (autoload 'tq-create "tq" "\ @@ -28692,7 +28735,7 @@ to a tcp server on another machine. ;;;*** ;;;### (autoloads (trace-function-background trace-function trace-buffer) -;;;;;; "trace" "emacs-lisp/trace.el" (19591 62571)) +;;;;;; "trace" "emacs-lisp/trace.el" (19775 2028)) ;;; Generated autoloads from emacs-lisp/trace.el (defvar trace-buffer (purecopy "*trace-output*") "\ @@ -28729,7 +28772,7 @@ BUFFER defaults to `trace-buffer'. ;;;### (autoloads (tramp-unload-tramp tramp-completion-handle-file-name-completion ;;;;;; tramp-completion-handle-file-name-all-completions tramp-unload-file-name-handlers ;;;;;; tramp-file-name-handler tramp-syntax tramp-mode) "tramp" -;;;;;; "net/tramp.el" (19714 43298)) +;;;;;; "net/tramp.el" (19775 2029)) ;;; Generated autoloads from net/tramp.el (defvar tramp-mode t "\ @@ -28867,7 +28910,7 @@ Discard Tramp from loading remote files. ;;;*** ;;;### (autoloads (tramp-ftp-enable-ange-ftp) "tramp-ftp" "net/tramp-ftp.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from net/tramp-ftp.el (autoload 'tramp-ftp-enable-ange-ftp "tramp-ftp" "\ @@ -28877,8 +28920,8 @@ Not documented ;;;*** -;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (19598 -;;;;;; 13691)) +;;;### (autoloads (help-with-tutorial) "tutorial" "tutorial.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from tutorial.el (autoload 'help-with-tutorial "tutorial" "\ @@ -28903,7 +28946,7 @@ resumed later. ;;;*** ;;;### (autoloads (tai-viet-composition-function) "tv-util" "language/tv-util.el" -;;;;;; (19562 42953)) +;;;;;; (19763 27286)) ;;; Generated autoloads from language/tv-util.el (autoload 'tai-viet-composition-function "tv-util" "\ @@ -28914,7 +28957,7 @@ Not documented ;;;*** ;;;### (autoloads (2C-split 2C-associate-buffer 2C-two-columns) "two-column" -;;;;;; "textmodes/two-column.el" (19619 52030)) +;;;;;; "textmodes/two-column.el" (19775 2030)) ;;; Generated autoloads from textmodes/two-column.el (autoload '2C-command "two-column" () t 'keymap) (global-set-key "\C-x6" '2C-command) @@ -28965,7 +29008,7 @@ First column's text sSs Second column's text ;;;;;; type-break type-break-mode type-break-keystroke-threshold ;;;;;; type-break-good-break-interval type-break-good-rest-interval ;;;;;; type-break-interval type-break-mode) "type-break" "type-break.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2030)) ;;; Generated autoloads from type-break.el (defvar type-break-mode nil "\ @@ -29147,7 +29190,7 @@ FRAC should be the inverse of the fractional value; for example, a value of ;;;*** -;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (19562 42953)) +;;;### (autoloads (uce-reply-to-uce) "uce" "mail/uce.el" (19775 2029)) ;;; Generated autoloads from mail/uce.el (autoload 'uce-reply-to-uce "uce" "\ @@ -29165,7 +29208,7 @@ You might need to set `uce-mail-reader' before using this. ;;;;;; ucs-normalize-NFKC-string ucs-normalize-NFKC-region ucs-normalize-NFKD-string ;;;;;; ucs-normalize-NFKD-region ucs-normalize-NFC-string ucs-normalize-NFC-region ;;;;;; ucs-normalize-NFD-string ucs-normalize-NFD-region) "ucs-normalize" -;;;;;; "international/ucs-normalize.el" (19619 52030)) +;;;;;; "international/ucs-normalize.el" (19780 4513)) ;;; Generated autoloads from international/ucs-normalize.el (autoload 'ucs-normalize-NFD-region "ucs-normalize" "\ @@ -29231,7 +29274,7 @@ Normalize the string STR by the Unicode NFC and Mac OS's HFS Plus. ;;;*** ;;;### (autoloads (ununderline-region underline-region) "underline" -;;;;;; "textmodes/underline.el" (19562 42953)) +;;;;;; "textmodes/underline.el" (19775 2030)) ;;; Generated autoloads from textmodes/underline.el (autoload 'underline-region "underline" "\ @@ -29252,7 +29295,7 @@ which specify the range to operate on. ;;;*** ;;;### (autoloads (unrmail batch-unrmail) "unrmail" "mail/unrmail.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2029)) ;;; Generated autoloads from mail/unrmail.el (autoload 'batch-unrmail "unrmail" "\ @@ -29271,8 +29314,8 @@ Convert old-style Rmail Babyl file FILE to system inbox format file TO-FILE. ;;;*** -;;;### (autoloads (unsafep) "unsafep" "emacs-lisp/unsafep.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (unsafep) "unsafep" "emacs-lisp/unsafep.el" (19775 +;;;;;; 2028)) ;;; Generated autoloads from emacs-lisp/unsafep.el (autoload 'unsafep "unsafep" "\ @@ -29285,7 +29328,7 @@ UNSAFEP-VARS is a list of symbols with local bindings. ;;;*** ;;;### (autoloads (url-retrieve-synchronously url-retrieve) "url" -;;;;;; "url/url.el" (19640 47194)) +;;;;;; "url/url.el" (19775 2030)) ;;; Generated autoloads from url/url.el (autoload 'url-retrieve "url" "\ @@ -29327,7 +29370,7 @@ no further processing). URL is either a string or a parsed URL. ;;;*** ;;;### (autoloads (url-register-auth-scheme url-get-authentication) -;;;;;; "url-auth" "url/url-auth.el" (19562 42953)) +;;;;;; "url-auth" "url/url-auth.el" (19775 2030)) ;;; Generated autoloads from url/url-auth.el (autoload 'url-get-authentication "url-auth" "\ @@ -29369,7 +29412,7 @@ RATING a rating between 1 and 10 of the strength of the authentication. ;;;*** ;;;### (autoloads (url-cache-extract url-is-cached url-store-in-cache) -;;;;;; "url-cache" "url/url-cache.el" (19640 47194)) +;;;;;; "url-cache" "url/url-cache.el" (19775 2030)) ;;; Generated autoloads from url/url-cache.el (autoload 'url-store-in-cache "url-cache" "\ @@ -29390,7 +29433,7 @@ Extract FNAM from the local disk cache. ;;;*** -;;;### (autoloads (url-cid) "url-cid" "url/url-cid.el" (19562 42953)) +;;;### (autoloads (url-cid) "url-cid" "url/url-cid.el" (19780 4514)) ;;; Generated autoloads from url/url-cid.el (autoload 'url-cid "url-cid" "\ @@ -29401,7 +29444,7 @@ Not documented ;;;*** ;;;### (autoloads (url-dav-vc-registered url-dav-supported-p) "url-dav" -;;;;;; "url/url-dav.el" (19591 62571)) +;;;;;; "url/url-dav.el" (19780 4514)) ;;; Generated autoloads from url/url-dav.el (autoload 'url-dav-supported-p "url-dav" "\ @@ -29416,8 +29459,8 @@ Not documented ;;;*** -;;;### (autoloads (url-file) "url-file" "url/url-file.el" (19714 -;;;;;; 43298)) +;;;### (autoloads (url-file) "url-file" "url/url-file.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from url/url-file.el (autoload 'url-file "url-file" "\ @@ -29428,7 +29471,7 @@ Handle file: and ftp: URLs. ;;;*** ;;;### (autoloads (url-open-stream url-gateway-nslookup-host) "url-gw" -;;;;;; "url/url-gw.el" (19640 47194)) +;;;;;; "url/url-gw.el" (19780 4514)) ;;; Generated autoloads from url/url-gw.el (autoload 'url-gateway-nslookup-host "url-gw" "\ @@ -29448,7 +29491,7 @@ Might do a non-blocking connection; use `process-status' to check. ;;;### (autoloads (url-insert-file-contents url-file-local-copy url-copy-file ;;;;;; url-file-handler url-handler-mode) "url-handlers" "url/url-handlers.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2030)) ;;; Generated autoloads from url/url-handlers.el (defvar url-handler-mode nil "\ @@ -29500,7 +29543,7 @@ Not documented ;;;*** ;;;### (autoloads (url-http-options url-http-file-attributes url-http-file-exists-p -;;;;;; url-http) "url-http" "url/url-http.el" (19640 47194)) +;;;;;; url-http) "url-http" "url/url-http.el" (19775 2030)) ;;; Generated autoloads from url/url-http.el (autoload 'url-http "url-http" "\ @@ -29566,7 +29609,7 @@ HTTPS retrievals are asynchronous.") ;;;*** -;;;### (autoloads (url-irc) "url-irc" "url/url-irc.el" (19598 13691)) +;;;### (autoloads (url-irc) "url-irc" "url/url-irc.el" (19775 2030)) ;;; Generated autoloads from url/url-irc.el (autoload 'url-irc "url-irc" "\ @@ -29576,8 +29619,8 @@ Not documented ;;;*** -;;;### (autoloads (url-ldap) "url-ldap" "url/url-ldap.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (url-ldap) "url-ldap" "url/url-ldap.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from url/url-ldap.el (autoload 'url-ldap "url-ldap" "\ @@ -29591,7 +29634,7 @@ URL can be a URL string, or a URL vector of the type returned by ;;;*** ;;;### (autoloads (url-mailto url-mail) "url-mailto" "url/url-mailto.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2030)) ;;; Generated autoloads from url/url-mailto.el (autoload 'url-mail "url-mailto" "\ @@ -29607,7 +29650,7 @@ Handle the mailto: URL syntax. ;;;*** ;;;### (autoloads (url-data url-generic-emulator-loader url-info -;;;;;; url-man) "url-misc" "url/url-misc.el" (19562 42953)) +;;;;;; url-man) "url-misc" "url/url-misc.el" (19775 2030)) ;;; Generated autoloads from url/url-misc.el (autoload 'url-man "url-misc" "\ @@ -29639,7 +29682,7 @@ Fetch a data URL (RFC 2397). ;;;*** ;;;### (autoloads (url-snews url-news) "url-news" "url/url-news.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2030)) ;;; Generated autoloads from url/url-news.el (autoload 'url-news "url-news" "\ @@ -29656,7 +29699,7 @@ Not documented ;;;### (autoloads (url-ns-user-pref url-ns-prefs isInNet isResolvable ;;;;;; dnsResolve dnsDomainIs isPlainHostName) "url-ns" "url/url-ns.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2030)) ;;; Generated autoloads from url/url-ns.el (autoload 'isPlainHostName "url-ns" "\ @@ -29697,7 +29740,7 @@ Not documented ;;;*** ;;;### (autoloads (url-generic-parse-url url-recreate-url) "url-parse" -;;;;;; "url/url-parse.el" (19640 47194)) +;;;;;; "url/url-parse.el" (19775 2030)) ;;; Generated autoloads from url/url-parse.el (autoload 'url-recreate-url "url-parse" "\ @@ -29715,7 +29758,7 @@ TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS. ;;;*** ;;;### (autoloads (url-setup-privacy-info) "url-privacy" "url/url-privacy.el" -;;;;;; (19562 42953)) +;;;;;; (19775 2030)) ;;; Generated autoloads from url/url-privacy.el (autoload 'url-setup-privacy-info "url-privacy" "\ @@ -29731,7 +29774,7 @@ Setup variables that expose info about you and your system. ;;;;;; url-pretty-length url-strip-leading-spaces url-eat-trailing-space ;;;;;; url-get-normalized-date url-lazy-message url-normalize-url ;;;;;; url-insert-entities-in-string url-parse-args url-debug url-debug) -;;;;;; "url-util" "url/url-util.el" (19640 47194)) +;;;;;; "url-util" "url/url-util.el" (19775 2030)) ;;; Generated autoloads from url/url-util.el (defvar url-debug nil "\ @@ -29867,7 +29910,7 @@ This uses `url-current-object', set locally to the buffer. ;;;*** ;;;### (autoloads (ask-user-about-supersession-threat ask-user-about-lock) -;;;;;; "userlock" "userlock.el" (19562 42953)) +;;;;;; "userlock" "userlock.el" (19775 2030)) ;;; Generated autoloads from userlock.el (autoload 'ask-user-about-lock "userlock" "\ @@ -29897,7 +29940,7 @@ The buffer in question is current when this function is called. ;;;### (autoloads (utf-7-imap-pre-write-conversion utf-7-pre-write-conversion ;;;;;; utf-7-imap-post-read-conversion utf-7-post-read-conversion) -;;;;;; "utf-7" "international/utf-7.el" (19562 42953)) +;;;;;; "utf-7" "international/utf-7.el" (19780 4513)) ;;; Generated autoloads from international/utf-7.el (autoload 'utf-7-post-read-conversion "utf-7" "\ @@ -29922,7 +29965,7 @@ Not documented ;;;*** -;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (19619 52030)) +;;;### (autoloads (utf7-encode) "utf7" "gnus/utf7.el" (19775 2028)) ;;; Generated autoloads from gnus/utf7.el (autoload 'utf7-encode "utf7" "\ @@ -29934,7 +29977,7 @@ Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil. ;;;### (autoloads (uudecode-decode-region uudecode-decode-region-internal ;;;;;; uudecode-decode-region-external) "uudecode" "mail/uudecode.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2029)) ;;; Generated autoloads from mail/uudecode.el (autoload 'uudecode-decode-region-external "uudecode" "\ @@ -29959,12 +30002,12 @@ If FILE-NAME is non-nil, save the result to FILE-NAME. ;;;*** ;;;### (autoloads (vc-branch-part vc-update-change-log vc-rename-file -;;;;;; vc-delete-file vc-transfer-file vc-switch-backend vc-update +;;;;;; vc-delete-file vc-transfer-file vc-switch-backend vc-pull ;;;;;; vc-rollback vc-revert vc-log-outgoing vc-log-incoming vc-print-root-log ;;;;;; vc-print-log vc-retrieve-tag vc-create-tag vc-merge vc-insert-headers ;;;;;; vc-revision-other-window vc-root-diff vc-diff vc-version-diff ;;;;;; vc-register vc-next-action vc-before-checkin-hook vc-checkin-hook -;;;;;; vc-checkout-hook) "vc" "vc/vc.el" (19714 43298)) +;;;;;; vc-checkout-hook) "vc" "vc/vc.el" (19780 4515)) ;;; Generated autoloads from vc/vc.el (defvar vc-checkout-hook nil "\ @@ -30158,7 +30201,7 @@ depending on the underlying version-control system. (define-obsolete-function-alias 'vc-revert-buffer 'vc-revert "23.1") -(autoload 'vc-update "vc" "\ +(autoload 'vc-pull "vc" "\ Update the current fileset or branch. On a distributed version control system, this runs a \"pull\" operation to update the current branch, prompting for an argument @@ -30172,7 +30215,7 @@ tip revision are merged into the working file. \(fn &optional ARG)" t nil) -(defalias 'vc-pull 'vc-update) +(defalias 'vc-update 'vc-pull) (autoload 'vc-switch-backend "vc" "\ Make BACKEND the current version control system for FILE. @@ -30230,7 +30273,7 @@ Return the branch part of a revision number REV. ;;;*** ;;;### (autoloads (vc-annotate) "vc-annotate" "vc/vc-annotate.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2030)) ;;; Generated autoloads from vc/vc-annotate.el (autoload 'vc-annotate "vc-annotate" "\ @@ -30267,7 +30310,7 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (19714 43298)) +;;;### (autoloads nil "vc-arch" "vc/vc-arch.el" (19780 4514)) ;;; Generated autoloads from vc/vc-arch.el (defun vc-arch-registered (file) (if (vc-find-root file "{arch}/=tagging-method") @@ -30277,7 +30320,7 @@ mode-specific menu. `vc-annotate-color-map' and ;;;*** -;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (19717 39999)) +;;;### (autoloads nil "vc-bzr" "vc/vc-bzr.el" (19780 36416)) ;;; Generated autoloads from vc/vc-bzr.el (defconst vc-bzr-admin-dirname ".bzr" "\ @@ -30292,7 +30335,7 @@ Name of the directory containing Bzr repository status files.") ;;;*** -;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (19714 43298)) +;;;### (autoloads nil "vc-cvs" "vc/vc-cvs.el" (19775 2030)) ;;; Generated autoloads from vc/vc-cvs.el (defun vc-cvs-registered (f) (when (file-readable-p (expand-file-name @@ -30302,7 +30345,7 @@ Name of the directory containing Bzr repository status files.") ;;;*** -;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (19714 43298)) +;;;### (autoloads (vc-dir) "vc-dir" "vc/vc-dir.el" (19780 4514)) ;;; Generated autoloads from vc/vc-dir.el (autoload 'vc-dir "vc-dir" "\ @@ -30327,7 +30370,7 @@ These are the commands available for use in the file status buffer: ;;;*** ;;;### (autoloads (vc-do-command) "vc-dispatcher" "vc/vc-dispatcher.el" -;;;;;; (19598 13691)) +;;;;;; (19780 36416)) ;;; Generated autoloads from vc/vc-dispatcher.el (autoload 'vc-do-command "vc-dispatcher" "\ @@ -30350,7 +30393,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-git" "vc/vc-git.el" (19598 13691)) +;;;### (autoloads nil "vc-git" "vc/vc-git.el" (19780 36416)) ;;; Generated autoloads from vc/vc-git.el (defun vc-git-registered (file) "Return non-nil if FILE is registered with git." @@ -30361,7 +30404,7 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (19714 43298)) +;;;### (autoloads nil "vc-hg" "vc/vc-hg.el" (19780 36416)) ;;; Generated autoloads from vc/vc-hg.el (defun vc-hg-registered (file) "Return non-nil if FILE is registered with hg." @@ -30372,7 +30415,14 @@ case, and the process object in the asynchronous case. ;;;*** -;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (19714 43298)) +;;;### (autoloads nil "vc-hooks" "vc/vc-hooks.el" (19780 4514)) +;;; Generated autoloads from vc/vc-hooks.el + +(put 'vc-mode 'risky-local-variable t) + +;;;*** + +;;;### (autoloads nil "vc-mtn" "vc/vc-mtn.el" (19775 2030)) ;;; Generated autoloads from vc/vc-mtn.el (defconst vc-mtn-admin-dir "_MTN") @@ -30387,7 +30437,7 @@ case, and the process object in the asynchronous case. ;;;*** ;;;### (autoloads (vc-rcs-master-templates) "vc-rcs" "vc/vc-rcs.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4515)) ;;; Generated autoloads from vc/vc-rcs.el (defvar vc-rcs-master-templates (purecopy '("%sRCS/%s,v" "%s%s,v" "%sRCS/%s")) "\ @@ -30401,7 +30451,7 @@ For a description of possible values, see `vc-check-master-templates'.") ;;;*** ;;;### (autoloads (vc-sccs-master-templates) "vc-sccs" "vc/vc-sccs.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4515)) ;;; Generated autoloads from vc/vc-sccs.el (defvar vc-sccs-master-templates (purecopy '("%sSCCS/s.%s" "%ss.%s" vc-sccs-search-project-dir)) "\ @@ -30418,7 +30468,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** -;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (19640 47194)) +;;;### (autoloads nil "vc-svn" "vc/vc-svn.el" (19780 4515)) ;;; Generated autoloads from vc/vc-svn.el (defun vc-svn-registered (f) (let ((admin-dir (cond ((and (eq system-type 'windows-nt) @@ -30434,7 +30484,7 @@ find any project directory." (let ((project-dir (getenv "PROJECTDIR")) dirs dir) ;;;*** ;;;### (autoloads (vera-mode) "vera-mode" "progmodes/vera-mode.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/vera-mode.el (add-to-list 'auto-mode-alist (cons (purecopy "\\.vr[hi]?\\'") 'vera-mode)) @@ -30492,7 +30542,7 @@ Key bindings: ;;;*** ;;;### (autoloads (verilog-mode) "verilog-mode" "progmodes/verilog-mode.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/verilog-mode.el (autoload 'verilog-mode "verilog-mode" "\ @@ -30629,7 +30679,7 @@ Key bindings specific to `verilog-mode-map' are: ;;;*** ;;;### (autoloads (vhdl-mode) "vhdl-mode" "progmodes/vhdl-mode.el" -;;;;;; (19714 43298)) +;;;;;; (19780 4514)) ;;; Generated autoloads from progmodes/vhdl-mode.el (autoload 'vhdl-mode "vhdl-mode" "\ @@ -31170,7 +31220,7 @@ Key bindings: ;;;*** -;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (19562 42953)) +;;;### (autoloads (vi-mode) "vi" "emulation/vi.el" (19763 27286)) ;;; Generated autoloads from emulation/vi.el (autoload 'vi-mode "vi" "\ @@ -31225,7 +31275,7 @@ Syntax table and abbrevs while in vi mode remain as they were in Emacs. ;;;### (autoloads (viqr-pre-write-conversion viqr-post-read-conversion ;;;;;; viet-encode-viqr-buffer viet-encode-viqr-region viet-decode-viqr-buffer ;;;;;; viet-decode-viqr-region viet-encode-viscii-char) "viet-util" -;;;;;; "language/viet-util.el" (19562 42953)) +;;;;;; "language/viet-util.el" (19780 4513)) ;;; Generated autoloads from language/viet-util.el (autoload 'viet-encode-viscii-char "viet-util" "\ @@ -31273,7 +31323,7 @@ Not documented ;;;;;; view-mode view-buffer-other-frame view-buffer-other-window ;;;;;; view-buffer view-file-other-frame view-file-other-window ;;;;;; view-file kill-buffer-if-not-modified view-remove-frame-by-deleting) -;;;;;; "view" "view.el" (19562 42953)) +;;;;;; "view" "view.el" (19780 4515)) ;;; Generated autoloads from view.el (defvar view-remove-frame-by-deleting t "\ @@ -31519,8 +31569,8 @@ Exit View mode and make the current buffer editable. ;;;*** -;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (19619 -;;;;;; 52030)) +;;;### (autoloads (vip-mode vip-setup) "vip" "emulation/vip.el" (19780 +;;;;;; 4513)) ;;; Generated autoloads from emulation/vip.el (autoload 'vip-setup "vip" "\ @@ -31536,7 +31586,7 @@ Turn on VIP emulation of VI. ;;;*** ;;;### (autoloads (viper-mode toggle-viper-mode) "viper" "emulation/viper.el" -;;;;;; (19598 13691)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emulation/viper.el (autoload 'toggle-viper-mode "viper" "\ @@ -31553,7 +31603,7 @@ Turn on Viper emulation of Vi in Emacs. See Info node `(viper)Top'. ;;;*** ;;;### (autoloads (warn lwarn display-warning) "warnings" "emacs-lisp/warnings.el" -;;;;;; (19619 52030)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emacs-lisp/warnings.el (defvar warning-prefix-function nil "\ @@ -31643,7 +31693,7 @@ this is equivalent to `display-warning', using ;;;*** ;;;### (autoloads (wdired-change-to-wdired-mode) "wdired" "wdired.el" -;;;;;; (19562 42953)) +;;;;;; (19780 4515)) ;;; Generated autoloads from wdired.el (autoload 'wdired-change-to-wdired-mode "wdired" "\ @@ -31659,7 +31709,7 @@ See `wdired-mode'. ;;;*** -;;;### (autoloads (webjump) "webjump" "net/webjump.el" (19562 42953)) +;;;### (autoloads (webjump) "webjump" "net/webjump.el" (19775 2029)) ;;; Generated autoloads from net/webjump.el (autoload 'webjump "webjump" "\ @@ -31676,7 +31726,7 @@ Please submit bug reports and other feedback to the author, Neil W. Van Dyke ;;;*** ;;;### (autoloads (which-function-mode) "which-func" "progmodes/which-func.el" -;;;;;; (19714 43298)) +;;;;;; (19775 2029)) ;;; Generated autoloads from progmodes/which-func.el (put 'which-func-format 'risky-local-variable t) (put 'which-func-current 'risky-local-variable t) @@ -31707,7 +31757,7 @@ and off otherwise. ;;;### (autoloads (whitespace-report-region whitespace-report whitespace-cleanup-region ;;;;;; whitespace-cleanup global-whitespace-toggle-options whitespace-toggle-options ;;;;;; global-whitespace-newline-mode global-whitespace-mode whitespace-newline-mode -;;;;;; whitespace-mode) "whitespace" "whitespace.el" (19714 43298)) +;;;;;; whitespace-mode) "whitespace" "whitespace.el" (19780 4515)) ;;; Generated autoloads from whitespace.el (autoload 'whitespace-mode "whitespace" "\ @@ -32110,7 +32160,7 @@ cleaning up these problems. ;;;*** ;;;### (autoloads (widget-minor-mode widget-browse-other-window widget-browse -;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (19598 13691)) +;;;;;; widget-browse-at) "wid-browse" "wid-browse.el" (19775 2030)) ;;; Generated autoloads from wid-browse.el (autoload 'widget-browse-at "wid-browse" "\ @@ -32137,8 +32187,8 @@ With arg, turn widget mode on if and only if arg is positive. ;;;*** ;;;### (autoloads (widget-setup widget-insert widget-delete widget-create -;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (19714 -;;;;;; 43298)) +;;;;;; widget-prompt-value widgetp) "wid-edit" "wid-edit.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from wid-edit.el (autoload 'widgetp "wid-edit" "\ @@ -32181,8 +32231,8 @@ Setup current buffer so editing string widgets works. ;;;*** ;;;### (autoloads (windmove-default-keybindings windmove-down windmove-right -;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (19562 -;;;;;; 42953)) +;;;;;; windmove-up windmove-left) "windmove" "windmove.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from windmove.el (autoload 'windmove-left "windmove" "\ @@ -32232,10 +32282,17 @@ Default MODIFIER is 'shift. \(fn &optional MODIFIER)" t nil) +;;;*** + +;;;### (autoloads nil "window" "window.el" (19775 2030)) +;;; Generated autoloads from window.el + +(put 'special-display-buffer-names 'risky-local-variable t) + ;;;*** ;;;### (autoloads (winner-mode winner-mode) "winner" "winner.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2030)) ;;; Generated autoloads from winner.el (defvar winner-mode nil "\ @@ -32254,7 +32311,7 @@ With arg, turn Winner mode on if and only if arg is positive. ;;;*** ;;;### (autoloads (woman-bookmark-jump woman-find-file woman-dired-find-file -;;;;;; woman woman-locale) "woman" "woman.el" (19714 43298)) +;;;;;; woman woman-locale) "woman" "woman.el" (19780 4515)) ;;; Generated autoloads from woman.el (defvar woman-locale nil "\ @@ -32303,7 +32360,7 @@ Default bookmark handler for Woman buffers. ;;;*** ;;;### (autoloads (wordstar-mode) "ws-mode" "emulation/ws-mode.el" -;;;;;; (19640 47194)) +;;;;;; (19775 2028)) ;;; Generated autoloads from emulation/ws-mode.el (autoload 'wordstar-mode "ws-mode" "\ @@ -32415,7 +32472,7 @@ The key bindings are: ;;;*** -;;;### (autoloads (xesam-search) "xesam" "net/xesam.el" (19562 42953)) +;;;### (autoloads (xesam-search) "xesam" "net/xesam.el" (19775 2029)) ;;; Generated autoloads from net/xesam.el (autoload 'xesam-search "xesam" "\ @@ -32435,7 +32492,7 @@ Example: ;;;*** ;;;### (autoloads (xml-parse-region xml-parse-file) "xml" "xml.el" -;;;;;; (19591 62571)) +;;;;;; (19775 2030)) ;;; Generated autoloads from xml.el (autoload 'xml-parse-file "xml" "\ @@ -32461,7 +32518,7 @@ If PARSE-NS is non-nil, then QNAMES are expanded. ;;;*** ;;;### (autoloads (xmltok-get-declared-encoding-position) "xmltok" -;;;;;; "nxml/xmltok.el" (19562 42953)) +;;;;;; "nxml/xmltok.el" (19775 2029)) ;;; Generated autoloads from nxml/xmltok.el (autoload 'xmltok-get-declared-encoding-position "xmltok" "\ @@ -32479,8 +32536,8 @@ If LIMIT is non-nil, then do not consider characters beyond LIMIT. ;;;*** -;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (19562 -;;;;;; 42953)) +;;;### (autoloads (xterm-mouse-mode) "xt-mouse" "xt-mouse.el" (19775 +;;;;;; 2030)) ;;; Generated autoloads from xt-mouse.el (defvar xterm-mouse-mode nil "\ @@ -32509,7 +32566,7 @@ down the SHIFT key while pressing the mouse button. ;;;*** ;;;### (autoloads (yenc-extract-filename yenc-decode-region) "yenc" -;;;;;; "gnus/yenc.el" (19598 13691)) +;;;;;; "gnus/yenc.el" (19775 2028)) ;;; Generated autoloads from gnus/yenc.el (autoload 'yenc-decode-region "yenc" "\ @@ -32525,7 +32582,7 @@ Extract file name from an yenc header. ;;;*** ;;;### (autoloads (psychoanalyze-pinhead apropos-zippy insert-zippyism -;;;;;; yow) "yow" "play/yow.el" (19562 42953)) +;;;;;; yow) "yow" "play/yow.el" (19775 2029)) ;;; Generated autoloads from play/yow.el (autoload 'yow "yow" "\ @@ -32551,7 +32608,7 @@ Zippy goes to the analyst. ;;;*** -;;;### (autoloads (zone) "zone" "play/zone.el" (19562 42953)) +;;;### (autoloads (zone) "zone" "play/zone.el" (19775 2029)) ;;; Generated autoloads from play/zone.el (autoload 'zone "zone" "\ @@ -32561,41 +32618,42 @@ Zone out, completely. ;;;*** -;;;### (autoloads nil nil ("calc/calc-aent.el" "calc/calc-alg.el" -;;;;;; "calc/calc-arith.el" "calc/calc-bin.el" "calc/calc-comb.el" -;;;;;; "calc/calc-cplx.el" "calc/calc-embed.el" "calc/calc-ext.el" -;;;;;; "calc/calc-fin.el" "calc/calc-forms.el" "calc/calc-frac.el" -;;;;;; "calc/calc-funcs.el" "calc/calc-graph.el" "calc/calc-help.el" -;;;;;; "calc/calc-incom.el" "calc/calc-keypd.el" "calc/calc-lang.el" -;;;;;; "calc/calc-loaddefs.el" "calc/calc-macs.el" "calc/calc-map.el" -;;;;;; "calc/calc-math.el" "calc/calc-menu.el" "calc/calc-misc.el" -;;;;;; "calc/calc-mode.el" "calc/calc-mtx.el" "calc/calc-nlfit.el" -;;;;;; "calc/calc-poly.el" "calc/calc-prog.el" "calc/calc-rewr.el" -;;;;;; "calc/calc-rules.el" "calc/calc-sel.el" "calc/calc-stat.el" -;;;;;; "calc/calc-store.el" "calc/calc-stuff.el" "calc/calc-trail.el" -;;;;;; "calc/calc-undo.el" "calc/calc-units.el" "calc/calc-vec.el" -;;;;;; "calc/calc-yank.el" "calc/calcalg2.el" "calc/calcalg3.el" -;;;;;; "calc/calccomp.el" "calc/calcsel2.el" "calendar/cal-bahai.el" -;;;;;; "calendar/cal-coptic.el" "calendar/cal-french.el" "calendar/cal-html.el" -;;;;;; "calendar/cal-islam.el" "calendar/cal-iso.el" "calendar/cal-julian.el" -;;;;;; "calendar/cal-loaddefs.el" "calendar/cal-mayan.el" "calendar/cal-menu.el" -;;;;;; "calendar/cal-move.el" "calendar/cal-persia.el" "calendar/cal-tex.el" -;;;;;; "calendar/cal-x.el" "calendar/diary-loaddefs.el" "calendar/hol-loaddefs.el" -;;;;;; "cdl.el" "cedet/cedet-cscope.el" "cedet/cedet-files.el" "cedet/cedet-global.el" -;;;;;; "cedet/cedet-idutils.el" "cedet/cedet.el" "cedet/ede/auto.el" -;;;;;; "cedet/ede/autoconf-edit.el" "cedet/ede/base.el" "cedet/ede/cpp-root.el" -;;;;;; "cedet/ede/custom.el" "cedet/ede/dired.el" "cedet/ede/emacs.el" -;;;;;; "cedet/ede/files.el" "cedet/ede/generic.el" "cedet/ede/linux.el" -;;;;;; "cedet/ede/loaddefs.el" "cedet/ede/locate.el" "cedet/ede/make.el" -;;;;;; "cedet/ede/makefile-edit.el" "cedet/ede/pconf.el" "cedet/ede/pmake.el" -;;;;;; "cedet/ede/proj-archive.el" "cedet/ede/proj-aux.el" "cedet/ede/proj-comp.el" -;;;;;; "cedet/ede/proj-elisp.el" "cedet/ede/proj-info.el" "cedet/ede/proj-misc.el" -;;;;;; "cedet/ede/proj-obj.el" "cedet/ede/proj-prog.el" "cedet/ede/proj-scheme.el" -;;;;;; "cedet/ede/proj-shared.el" "cedet/ede/proj.el" "cedet/ede/project-am.el" -;;;;;; "cedet/ede/shell.el" "cedet/ede/simple.el" "cedet/ede/source.el" -;;;;;; "cedet/ede/speedbar.el" "cedet/ede/srecode.el" "cedet/ede/system.el" -;;;;;; "cedet/ede/util.el" "cedet/inversion.el" "cedet/mode-local.el" -;;;;;; "cedet/pulse.el" "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el" +;;;### (autoloads nil nil ("abbrev.el" "bindings.el" "button.el" +;;;;;; "calc/calc-aent.el" "calc/calc-alg.el" "calc/calc-arith.el" +;;;;;; "calc/calc-bin.el" "calc/calc-comb.el" "calc/calc-cplx.el" +;;;;;; "calc/calc-embed.el" "calc/calc-ext.el" "calc/calc-fin.el" +;;;;;; "calc/calc-forms.el" "calc/calc-frac.el" "calc/calc-funcs.el" +;;;;;; "calc/calc-graph.el" "calc/calc-help.el" "calc/calc-incom.el" +;;;;;; "calc/calc-keypd.el" "calc/calc-lang.el" "calc/calc-loaddefs.el" +;;;;;; "calc/calc-macs.el" "calc/calc-map.el" "calc/calc-math.el" +;;;;;; "calc/calc-menu.el" "calc/calc-misc.el" "calc/calc-mode.el" +;;;;;; "calc/calc-mtx.el" "calc/calc-nlfit.el" "calc/calc-poly.el" +;;;;;; "calc/calc-prog.el" "calc/calc-rewr.el" "calc/calc-rules.el" +;;;;;; "calc/calc-sel.el" "calc/calc-stat.el" "calc/calc-store.el" +;;;;;; "calc/calc-stuff.el" "calc/calc-trail.el" "calc/calc-units.el" +;;;;;; "calc/calc-vec.el" "calc/calc-yank.el" "calc/calcalg2.el" +;;;;;; "calc/calcalg3.el" "calc/calccomp.el" "calc/calcsel2.el" +;;;;;; "calendar/cal-bahai.el" "calendar/cal-coptic.el" "calendar/cal-french.el" +;;;;;; "calendar/cal-html.el" "calendar/cal-islam.el" "calendar/cal-iso.el" +;;;;;; "calendar/cal-julian.el" "calendar/cal-loaddefs.el" "calendar/cal-mayan.el" +;;;;;; "calendar/cal-menu.el" "calendar/cal-move.el" "calendar/cal-persia.el" +;;;;;; "calendar/cal-tex.el" "calendar/cal-x.el" "calendar/diary-loaddefs.el" +;;;;;; "calendar/hol-loaddefs.el" "case-table.el" "cdl.el" "cedet/cedet-cscope.el" +;;;;;; "cedet/cedet-files.el" "cedet/cedet-global.el" "cedet/cedet-idutils.el" +;;;;;; "cedet/cedet.el" "cedet/ede/auto.el" "cedet/ede/autoconf-edit.el" +;;;;;; "cedet/ede/base.el" "cedet/ede/cpp-root.el" "cedet/ede/custom.el" +;;;;;; "cedet/ede/dired.el" "cedet/ede/emacs.el" "cedet/ede/files.el" +;;;;;; "cedet/ede/generic.el" "cedet/ede/linux.el" "cedet/ede/loaddefs.el" +;;;;;; "cedet/ede/locate.el" "cedet/ede/make.el" "cedet/ede/makefile-edit.el" +;;;;;; "cedet/ede/pconf.el" "cedet/ede/pmake.el" "cedet/ede/proj-archive.el" +;;;;;; "cedet/ede/proj-aux.el" "cedet/ede/proj-comp.el" "cedet/ede/proj-elisp.el" +;;;;;; "cedet/ede/proj-info.el" "cedet/ede/proj-misc.el" "cedet/ede/proj-obj.el" +;;;;;; "cedet/ede/proj-prog.el" "cedet/ede/proj-scheme.el" "cedet/ede/proj-shared.el" +;;;;;; "cedet/ede/proj.el" "cedet/ede/project-am.el" "cedet/ede/shell.el" +;;;;;; "cedet/ede/simple.el" "cedet/ede/source.el" "cedet/ede/speedbar.el" +;;;;;; "cedet/ede/srecode.el" "cedet/ede/system.el" "cedet/ede/util.el" +;;;;;; "cedet/inversion.el" "cedet/mode-local.el" "cedet/pulse.el" +;;;;;; "cedet/semantic/analyze.el" "cedet/semantic/analyze/complete.el" ;;;;;; "cedet/semantic/analyze/debug.el" "cedet/semantic/analyze/fcn.el" ;;;;;; "cedet/semantic/analyze/refs.el" "cedet/semantic/bovine.el" ;;;;;; "cedet/semantic/bovine/c-by.el" "cedet/semantic/bovine/c.el" @@ -32636,42 +32694,47 @@ Zone out, completely. ;;;;;; "cedet/srecode/loaddefs.el" "cedet/srecode/map.el" "cedet/srecode/mode.el" ;;;;;; "cedet/srecode/semantic.el" "cedet/srecode/srt-wy.el" "cedet/srecode/srt.el" ;;;;;; "cedet/srecode/table.el" "cedet/srecode/template.el" "cedet/srecode/texi.el" -;;;;;; "cus-dep.el" "dframe.el" "dired-aux.el" "dired-x.el" "dos-fns.el" +;;;;;; "color.el" "cus-dep.el" "cus-face.el" "cus-load.el" "cus-start.el" +;;;;;; "custom.el" "dframe.el" "dired-aux.el" "dired-x.el" "dos-fns.el" ;;;;;; "dos-vars.el" "dos-w32.el" "dynamic-setting.el" "emacs-lisp/assoc.el" -;;;;;; "emacs-lisp/authors.el" "emacs-lisp/avl-tree.el" "emacs-lisp/bindat.el" -;;;;;; "emacs-lisp/byte-lexbind.el" "emacs-lisp/byte-opt.el" "emacs-lisp/chart.el" -;;;;;; "emacs-lisp/cl-extra.el" "emacs-lisp/cl-loaddefs.el" "emacs-lisp/cl-macs.el" -;;;;;; "emacs-lisp/cl-seq.el" "emacs-lisp/cl-specs.el" "emacs-lisp/cust-print.el" -;;;;;; "emacs-lisp/eieio-base.el" "emacs-lisp/eieio-comp.el" "emacs-lisp/eieio-custom.el" -;;;;;; "emacs-lisp/eieio-datadebug.el" "emacs-lisp/eieio-opt.el" -;;;;;; "emacs-lisp/eieio-speedbar.el" "emacs-lisp/eieio.el" "emacs-lisp/find-gc.el" -;;;;;; "emacs-lisp/gulp.el" "emacs-lisp/lisp-mnt.el" "emacs-lisp/package-x.el" -;;;;;; "emacs-lisp/regi.el" "emacs-lisp/smie.el" "emacs-lisp/sregex.el" +;;;;;; "emacs-lisp/authors.el" "emacs-lisp/avl-tree.el" "emacs-lisp/backquote.el" +;;;;;; "emacs-lisp/bindat.el" "emacs-lisp/byte-opt.el" "emacs-lisp/byte-run.el" +;;;;;; "emacs-lisp/chart.el" "emacs-lisp/cl-extra.el" "emacs-lisp/cl-loaddefs.el" +;;;;;; "emacs-lisp/cl-macs.el" "emacs-lisp/cl-seq.el" "emacs-lisp/cl-specs.el" +;;;;;; "emacs-lisp/cust-print.el" "emacs-lisp/eieio-base.el" "emacs-lisp/eieio-comp.el" +;;;;;; "emacs-lisp/eieio-custom.el" "emacs-lisp/eieio-datadebug.el" +;;;;;; "emacs-lisp/eieio-opt.el" "emacs-lisp/eieio-speedbar.el" +;;;;;; "emacs-lisp/eieio.el" "emacs-lisp/find-gc.el" "emacs-lisp/float-sup.el" +;;;;;; "emacs-lisp/gulp.el" "emacs-lisp/lisp-mnt.el" "emacs-lisp/lisp-mode.el" +;;;;;; "emacs-lisp/lisp.el" "emacs-lisp/map-ynp.el" "emacs-lisp/package-x.el" +;;;;;; "emacs-lisp/regi.el" "emacs-lisp/smie.el" "emacs-lisp/syntax.el" ;;;;;; "emacs-lisp/tcover-ses.el" "emacs-lisp/tcover-unsafep.el" -;;;;;; "emacs-lock.el" "emulation/cua-gmrk.el" "emulation/cua-rect.el" -;;;;;; "emulation/edt-lk201.el" "emulation/edt-mapper.el" "emulation/edt-pc.el" -;;;;;; "emulation/edt-vt100.el" "emulation/tpu-extras.el" "emulation/viper-cmd.el" -;;;;;; "emulation/viper-ex.el" "emulation/viper-init.el" "emulation/viper-keym.el" -;;;;;; "emulation/viper-macs.el" "emulation/viper-mous.el" "emulation/viper-util.el" -;;;;;; "erc/erc-backend.el" "erc/erc-goodies.el" "erc/erc-ibuffer.el" -;;;;;; "erc/erc-lang.el" "eshell/em-alias.el" "eshell/em-banner.el" -;;;;;; "eshell/em-basic.el" "eshell/em-cmpl.el" "eshell/em-dirs.el" -;;;;;; "eshell/em-glob.el" "eshell/em-hist.el" "eshell/em-ls.el" -;;;;;; "eshell/em-pred.el" "eshell/em-prompt.el" "eshell/em-rebind.el" -;;;;;; "eshell/em-script.el" "eshell/em-smart.el" "eshell/em-term.el" -;;;;;; "eshell/em-unix.el" "eshell/em-xtra.el" "eshell/esh-arg.el" -;;;;;; "eshell/esh-cmd.el" "eshell/esh-ext.el" "eshell/esh-groups.el" -;;;;;; "eshell/esh-io.el" "eshell/esh-module.el" "eshell/esh-opt.el" -;;;;;; "eshell/esh-proc.el" "eshell/esh-util.el" "eshell/esh-var.el" -;;;;;; "ezimage.el" "foldout.el" "format-spec.el" "forms-d2.el" -;;;;;; "forms-pass.el" "fringe.el" "generic-x.el" "gnus/auth-source.el" -;;;;;; "gnus/color.el" "gnus/compface.el" "gnus/gnus-async.el" "gnus/gnus-bcklg.el" -;;;;;; "gnus/gnus-cite.el" "gnus/gnus-cus.el" "gnus/gnus-demon.el" -;;;;;; "gnus/gnus-dup.el" "gnus/gnus-eform.el" "gnus/gnus-ems.el" -;;;;;; "gnus/gnus-int.el" "gnus/gnus-logic.el" "gnus/gnus-mh.el" -;;;;;; "gnus/gnus-salt.el" "gnus/gnus-score.el" "gnus/gnus-setup.el" -;;;;;; "gnus/gnus-srvr.el" "gnus/gnus-topic.el" "gnus/gnus-undo.el" -;;;;;; "gnus/gnus-util.el" "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/ietf-drums.el" +;;;;;; "emacs-lisp/timer.el" "emacs-lock.el" "emulation/cua-gmrk.el" +;;;;;; "emulation/cua-rect.el" "emulation/edt-lk201.el" "emulation/edt-mapper.el" +;;;;;; "emulation/edt-pc.el" "emulation/edt-vt100.el" "emulation/tpu-extras.el" +;;;;;; "emulation/viper-cmd.el" "emulation/viper-ex.el" "emulation/viper-init.el" +;;;;;; "emulation/viper-keym.el" "emulation/viper-macs.el" "emulation/viper-mous.el" +;;;;;; "emulation/viper-util.el" "env.el" "epa-hook.el" "erc/erc-backend.el" +;;;;;; "erc/erc-goodies.el" "erc/erc-ibuffer.el" "erc/erc-lang.el" +;;;;;; "eshell/em-alias.el" "eshell/em-banner.el" "eshell/em-basic.el" +;;;;;; "eshell/em-cmpl.el" "eshell/em-dirs.el" "eshell/em-glob.el" +;;;;;; "eshell/em-hist.el" "eshell/em-ls.el" "eshell/em-pred.el" +;;;;;; "eshell/em-prompt.el" "eshell/em-rebind.el" "eshell/em-script.el" +;;;;;; "eshell/em-smart.el" "eshell/em-term.el" "eshell/em-unix.el" +;;;;;; "eshell/em-xtra.el" "eshell/esh-arg.el" "eshell/esh-cmd.el" +;;;;;; "eshell/esh-ext.el" "eshell/esh-groups.el" "eshell/esh-io.el" +;;;;;; "eshell/esh-module.el" "eshell/esh-opt.el" "eshell/esh-proc.el" +;;;;;; "eshell/esh-util.el" "eshell/esh-var.el" "ezimage.el" "facemenu.el" +;;;;;; "faces.el" "files.el" "finder-inf.el" "foldout.el" "font-lock.el" +;;;;;; "format-spec.el" "forms-d2.el" "forms-pass.el" "frame.el" +;;;;;; "fringe.el" "generic-x.el" "gnus/auth-source.el" "gnus/compface.el" +;;;;;; "gnus/gnus-async.el" "gnus/gnus-bcklg.el" "gnus/gnus-cite.el" +;;;;;; "gnus/gnus-cus.el" "gnus/gnus-demon.el" "gnus/gnus-dup.el" +;;;;;; "gnus/gnus-eform.el" "gnus/gnus-ems.el" "gnus/gnus-int.el" +;;;;;; "gnus/gnus-logic.el" "gnus/gnus-mh.el" "gnus/gnus-salt.el" +;;;;;; "gnus/gnus-score.el" "gnus/gnus-setup.el" "gnus/gnus-srvr.el" +;;;;;; "gnus/gnus-topic.el" "gnus/gnus-undo.el" "gnus/gnus-util.el" +;;;;;; "gnus/gnus-uu.el" "gnus/gnus-vm.el" "gnus/ietf-drums.el" ;;;;;; "gnus/legacy-gnus-agent.el" "gnus/mail-parse.el" "gnus/mail-prsvr.el" ;;;;;; "gnus/mail-source.el" "gnus/mailcap.el" "gnus/messcompat.el" ;;;;;; "gnus/mm-bodies.el" "gnus/mm-decode.el" "gnus/mm-encode.el" @@ -32684,31 +32747,42 @@ Zone out, completely. ;;;;;; "gnus/nnspool.el" "gnus/nntp.el" "gnus/nnvirtual.el" "gnus/nnweb.el" ;;;;;; "gnus/rfc1843.el" "gnus/rfc2045.el" "gnus/rfc2047.el" "gnus/rfc2104.el" ;;;;;; "gnus/rfc2231.el" "gnus/rtree.el" "gnus/shr-color.el" "gnus/sieve-manage.el" -;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" "hex-util.el" -;;;;;; "hfy-cmap.el" "ibuf-ext.el" "international/charprop.el" "international/cp51932.el" -;;;;;; "international/eucjp-ms.el" "international/fontset.el" "international/iso-ascii.el" -;;;;;; "international/ja-dic-cnv.el" "international/ja-dic-utl.el" -;;;;;; "international/ogonek.el" "international/uni-bidi.el" "international/uni-category.el" -;;;;;; "international/uni-combining.el" "international/uni-comment.el" -;;;;;; "international/uni-decimal.el" "international/uni-decomposition.el" -;;;;;; "international/uni-digit.el" "international/uni-lowercase.el" -;;;;;; "international/uni-mirrored.el" "international/uni-name.el" -;;;;;; "international/uni-numeric.el" "international/uni-old-name.el" -;;;;;; "international/uni-titlecase.el" "international/uni-uppercase.el" -;;;;;; "json.el" "kermit.el" "language/hanja-util.el" "language/thai-word.el" -;;;;;; "ldefs-boot.el" "mail/blessmail.el" "mail/mailheader.el" -;;;;;; "mail/mailpost.el" "mail/mspools.el" "mail/rfc2368.el" "mail/rfc822.el" -;;;;;; "mail/rmail-spam-filter.el" "mail/rmailedit.el" "mail/rmailkwd.el" -;;;;;; "mail/rmailmm.el" "mail/rmailmsc.el" "mail/rmailsort.el" -;;;;;; "mail/rmailsum.el" "mail/undigest.el" "md4.el" "mh-e/mh-acros.el" -;;;;;; "mh-e/mh-alias.el" "mh-e/mh-buffers.el" "mh-e/mh-compat.el" -;;;;;; "mh-e/mh-funcs.el" "mh-e/mh-gnus.el" "mh-e/mh-identity.el" -;;;;;; "mh-e/mh-inc.el" "mh-e/mh-junk.el" "mh-e/mh-letter.el" "mh-e/mh-limit.el" +;;;;;; "gnus/smime.el" "gnus/spam-stat.el" "gnus/spam-wash.el" "help.el" +;;;;;; "hex-util.el" "hfy-cmap.el" "ibuf-ext.el" "indent.el" "international/characters.el" +;;;;;; "international/charprop.el" "international/cp51932.el" "international/eucjp-ms.el" +;;;;;; "international/fontset.el" "international/iso-ascii.el" "international/ja-dic-cnv.el" +;;;;;; "international/ja-dic-utl.el" "international/mule-conf.el" +;;;;;; "international/mule.el" "international/ogonek.el" "international/uni-bidi.el" +;;;;;; "international/uni-category.el" "international/uni-combining.el" +;;;;;; "international/uni-comment.el" "international/uni-decimal.el" +;;;;;; "international/uni-decomposition.el" "international/uni-digit.el" +;;;;;; "international/uni-lowercase.el" "international/uni-mirrored.el" +;;;;;; "international/uni-name.el" "international/uni-numeric.el" +;;;;;; "international/uni-old-name.el" "international/uni-titlecase.el" +;;;;;; "international/uni-uppercase.el" "isearch.el" "jit-lock.el" +;;;;;; "jka-cmpr-hook.el" "json.el" "kermit.el" "language/burmese.el" +;;;;;; "language/cham.el" "language/chinese.el" "language/cyrillic.el" +;;;;;; "language/czech.el" "language/english.el" "language/ethiopic.el" +;;;;;; "language/european.el" "language/georgian.el" "language/greek.el" +;;;;;; "language/hanja-util.el" "language/hebrew.el" "language/indian.el" +;;;;;; "language/japanese.el" "language/khmer.el" "language/korean.el" +;;;;;; "language/lao.el" "language/misc-lang.el" "language/romanian.el" +;;;;;; "language/sinhala.el" "language/slovak.el" "language/tai-viet.el" +;;;;;; "language/thai-word.el" "language/thai.el" "language/tibetan.el" +;;;;;; "language/utf-8-lang.el" "language/vietnamese.el" "ldefs-boot.el" +;;;;;; "loadup.el" "mail/blessmail.el" "mail/mailheader.el" "mail/mailpost.el" +;;;;;; "mail/mspools.el" "mail/rfc2368.el" "mail/rfc822.el" "mail/rmail-spam-filter.el" +;;;;;; "mail/rmailedit.el" "mail/rmailkwd.el" "mail/rmailmm.el" +;;;;;; "mail/rmailmsc.el" "mail/rmailsort.el" "mail/rmailsum.el" +;;;;;; "mail/undigest.el" "md4.el" "mh-e/mh-acros.el" "mh-e/mh-alias.el" +;;;;;; "mh-e/mh-buffers.el" "mh-e/mh-compat.el" "mh-e/mh-funcs.el" +;;;;;; "mh-e/mh-gnus.el" "mh-e/mh-identity.el" "mh-e/mh-inc.el" +;;;;;; "mh-e/mh-junk.el" "mh-e/mh-letter.el" "mh-e/mh-limit.el" ;;;;;; "mh-e/mh-loaddefs.el" "mh-e/mh-mime.el" "mh-e/mh-print.el" ;;;;;; "mh-e/mh-scan.el" "mh-e/mh-search.el" "mh-e/mh-seq.el" "mh-e/mh-show.el" ;;;;;; "mh-e/mh-speed.el" "mh-e/mh-thread.el" "mh-e/mh-tool-bar.el" -;;;;;; "mh-e/mh-utils.el" "mh-e/mh-xface.el" "mouse-copy.el" "mouse.el" -;;;;;; "mwheel.el" "net/dns.el" "net/eudc-vars.el" "net/eudcb-bbdb.el" +;;;;;; "mh-e/mh-utils.el" "mh-e/mh-xface.el" "minibuffer.el" "mouse-copy.el" +;;;;;; "mouse.el" "mwheel.el" "net/dns.el" "net/eudc-vars.el" "net/eudcb-bbdb.el" ;;;;;; "net/eudcb-ldap.el" "net/eudcb-mab.el" "net/eudcb-ph.el" ;;;;;; "net/gnutls.el" "net/hmac-def.el" "net/hmac-md5.el" "net/imap-hash.el" ;;;;;; "net/imap.el" "net/ldap.el" "net/mairix.el" "net/newsticker.el" @@ -32740,30 +32814,33 @@ Zone out, completely. ;;;;;; "org/org-mac-message.el" "org/org-macs.el" "org/org-mew.el" ;;;;;; "org/org-mhe.el" "org/org-mks.el" "org/org-mouse.el" "org/org-protocol.el" ;;;;;; "org/org-rmail.el" "org/org-src.el" "org/org-vm.el" "org/org-w3m.el" -;;;;;; "org/org-wl.el" "patcomp.el" "pgg-def.el" "pgg-parse.el" -;;;;;; "pgg-pgp.el" "pgg-pgp5.el" "play/gamegrid.el" "play/gametree.el" -;;;;;; "play/meese.el" "progmodes/ada-prj.el" "progmodes/cc-align.el" -;;;;;; "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el" "progmodes/cc-cmds.el" -;;;;;; "progmodes/cc-defs.el" "progmodes/cc-fonts.el" "progmodes/cc-langs.el" -;;;;;; "progmodes/cc-menus.el" "progmodes/ebnf-abn.el" "progmodes/ebnf-bnf.el" -;;;;;; "progmodes/ebnf-dtd.el" "progmodes/ebnf-ebx.el" "progmodes/ebnf-iso.el" -;;;;;; "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el" "progmodes/idlw-complete-structtag.el" -;;;;;; "progmodes/idlw-help.el" "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" -;;;;;; "progmodes/xscheme.el" "ps-def.el" "ps-mule.el" "ps-samp.el" -;;;;;; "saveplace.el" "sb-image.el" "scroll-bar.el" "select.el" -;;;;;; "soundex.el" "subdirs.el" "tempo.el" "textmodes/bib-mode.el" -;;;;;; "textmodes/makeinfo.el" "textmodes/page-ext.el" "textmodes/refbib.el" -;;;;;; "textmodes/refer.el" "textmodes/reftex-auc.el" "textmodes/reftex-dcr.el" -;;;;;; "textmodes/reftex-ref.el" "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" -;;;;;; "textmodes/texnfo-upd.el" "timezone.el" "tooltip.el" "tree-widget.el" +;;;;;; "org/org-wl.el" "patcomp.el" "paths.el" "play/gamegrid.el" +;;;;;; "play/gametree.el" "play/meese.el" "progmodes/ada-prj.el" +;;;;;; "progmodes/cc-align.el" "progmodes/cc-awk.el" "progmodes/cc-bytecomp.el" +;;;;;; "progmodes/cc-cmds.el" "progmodes/cc-defs.el" "progmodes/cc-fonts.el" +;;;;;; "progmodes/cc-langs.el" "progmodes/cc-menus.el" "progmodes/ebnf-abn.el" +;;;;;; "progmodes/ebnf-bnf.el" "progmodes/ebnf-dtd.el" "progmodes/ebnf-ebx.el" +;;;;;; "progmodes/ebnf-iso.el" "progmodes/ebnf-otz.el" "progmodes/ebnf-yac.el" +;;;;;; "progmodes/idlw-complete-structtag.el" "progmodes/idlw-help.el" +;;;;;; "progmodes/idlw-toolbar.el" "progmodes/mantemp.el" "progmodes/xscheme.el" +;;;;;; "ps-def.el" "ps-mule.el" "ps-samp.el" "register.el" "replace.el" +;;;;;; "rfn-eshadow.el" "saveplace.el" "sb-image.el" "scroll-bar.el" +;;;;;; "select.el" "simple.el" "soundex.el" "startup.el" "subdirs.el" +;;;;;; "subr.el" "tempo.el" "textmodes/bib-mode.el" "textmodes/fill.el" +;;;;;; "textmodes/makeinfo.el" "textmodes/page-ext.el" "textmodes/page.el" +;;;;;; "textmodes/paragraphs.el" "textmodes/refbib.el" "textmodes/refer.el" +;;;;;; "textmodes/reftex-auc.el" "textmodes/reftex-dcr.el" "textmodes/reftex-ref.el" +;;;;;; "textmodes/reftex-sel.el" "textmodes/reftex-toc.el" "textmodes/texnfo-upd.el" +;;;;;; "textmodes/text-mode.el" "timezone.el" "tooltip.el" "tree-widget.el" ;;;;;; "uniquify.el" "url/url-about.el" "url/url-cookie.el" "url/url-dired.el" ;;;;;; "url/url-expand.el" "url/url-ftp.el" "url/url-history.el" ;;;;;; "url/url-imap.el" "url/url-methods.el" "url/url-nfs.el" "url/url-proxy.el" ;;;;;; "url/url-vars.el" "vc/ediff-diff.el" "vc/ediff-init.el" "vc/ediff-merg.el" ;;;;;; "vc/ediff-ptch.el" "vc/ediff-vers.el" "vc/ediff-wind.el" ;;;;;; "vc/pcvs-info.el" "vc/pcvs-parse.el" "vc/pcvs-util.el" "vc/vc-dav.el" -;;;;;; "vcursor.el" "vt-control.el" "vt100-led.el" "w32-fns.el" -;;;;;; "w32-vars.el" "x-dnd.el") (19737 18184 637096)) +;;;;;; "vcursor.el" "version.el" "vt-control.el" "vt100-led.el" +;;;;;; "w32-fns.el" "w32-vars.el" "widget.el" "x-dnd.el") (19781 +;;;;;; 20793 754803)) ;;;*** diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 088410172e6..9ea61498ffa 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -84,9 +84,9 @@ BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) COMPILE_FIRST = \ $(lisp)/emacs-lisp/byte-opt.el \ $(lisp)/emacs-lisp/bytecomp.el \ - $(lisp)/emacs-lisp/pcase.elc \ - $(lisp)/emacs-lisp/macroexp.elc \ - $(lisp)/emacs-lisp/cconv.elc \ + $(lisp)/emacs-lisp/pcase.el \ + $(lisp)/emacs-lisp/macroexp.el \ + $(lisp)/emacs-lisp/cconv.el \ $(lisp)/subr.el \ $(lisp)/progmodes/cc-mode.el \ $(lisp)/progmodes/cc-vars.el From ca1055060d5793e368c1a165c412944d6800c3a6 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 16 Mar 2011 16:08:39 -0400 Subject: [PATCH 34/45] Remove bytecomp- prefix, plus misc changes. * lisp/emacs-lisp/byte-opt.el (byte-compile-inline-expand): Make it work to inline lexbind interpreted functions into lexbind code. (bytedecomp-bytes): Not a dynamic var any more. (disassemble-offset): Get the bytes via an argument instead. (byte-decompile-bytecode-1): Use push. * lisp/emacs-lisp/bytecomp.el: Remove the bytecomp- prefix now that we use lexical-binding. (byte-compile-outbuffer): Rename from bytecomp-outbuffer. * lisp/emacs-lisp/cl-macs.el (load-time-value): * lisp/emacs-lisp/cl.el (cl-compiling-file): Adjust to new name. * lisp/emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates): Add byte-code-function-p. (pcase--u1): Remove left-over code from early development. Fix case of variable shadowing in guards and predicates. (pcase--u1): Add a new `let' pattern. * src/image.c (parse_image_spec): Use Ffunctionp. * src/lisp.h: Declare Ffunctionp. --- lisp/ChangeLog | 20 ++ lisp/emacs-lisp/byte-opt.el | 164 +++++----- lisp/emacs-lisp/bytecomp.el | 527 ++++++++++++++++----------------- lisp/emacs-lisp/cconv.el | 31 +- lisp/emacs-lisp/cl-loaddefs.el | 2 +- lisp/emacs-lisp/cl-macs.el | 2 +- lisp/emacs-lisp/cl.el | 6 +- lisp/emacs-lisp/pcase.el | 63 +++- lisp/startup.el | 1 + lisp/subr.el | 3 + src/ChangeLog | 5 + src/bytecode.c | 12 +- src/image.c | 5 +- src/lisp.h | 1 + 14 files changed, 453 insertions(+), 389 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 34951ff37bb..8d5e2418341 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,23 @@ +2011-03-16 Stefan Monnier + + * emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates): + Add byte-code-function-p. + (pcase--u1): Remove left-over code from early development. + Fix case of variable shadowing in guards and predicates. + (pcase--u1): Add a new `let' pattern. + + * emacs-lisp/bytecomp.el: Remove the bytecomp- prefix now that we use + lexical-binding. + (byte-compile-outbuffer): Rename from bytecomp-outbuffer. + * emacs-lisp/cl-macs.el (load-time-value): + * emacs-lisp/cl.el (cl-compiling-file): Adjust to new name. + + * emacs-lisp/byte-opt.el (byte-compile-inline-expand): Make it work to + inline lexbind interpreted functions into lexbind code. + (bytedecomp-bytes): Not a dynamic var any more. + (disassemble-offset): Get the bytes via an argument instead. + (byte-decompile-bytecode-1): Use push. + 2011-03-15 Stefan Monnier * makefile.w32-in (COMPILE_FIRST): Fix up last change. diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index b07d61ae0d1..6a04dfb2507 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -265,45 +265,72 @@ (defun byte-compile-inline-expand (form) (let* ((name (car form)) - (fn (or (cdr (assq name byte-compile-function-environment)) - (and (fboundp name) (symbol-function name))))) - (if (null fn) - (progn - (byte-compile-warn "attempt to inline `%s' before it was defined" - name) - form) - ;; else - (when (and (consp fn) (eq (car fn) 'autoload)) - (load (nth 1 fn)) - (setq fn (or (and (fboundp name) (symbol-function name)) - (cdr (assq name byte-compile-function-environment))))) - (if (and (consp fn) (eq (car fn) 'autoload)) - (error "File `%s' didn't define `%s'" (nth 1 fn) name)) - (cond - ((and (symbolp fn) (not (eq fn t))) ;A function alias. - (byte-compile-inline-expand (cons fn (cdr form)))) - ((and (byte-code-function-p fn) - ;; FIXME: This works to inline old-style-byte-codes into - ;; old-style-byte-codes, but not mixed cases (not sure - ;; about new-style into new-style). - (not lexical-binding) - (not (integerp (aref fn 0)))) ;New lexical byte-code. - ;; (message "Inlining %S byte-code" name) - (fetch-bytecode fn) - (let ((string (aref fn 1))) - ;; Isn't it an error for `string' not to be unibyte?? --stef - (if (fboundp 'string-as-unibyte) - (setq string (string-as-unibyte string))) - ;; `byte-compile-splice-in-already-compiled-code' - ;; takes care of inlining the body. - (cons `(lambda ,(aref fn 0) - (byte-code ,string ,(aref fn 2) ,(aref fn 3))) - (cdr form)))) - ((eq (car-safe fn) 'lambda) - (macroexpand-all (cons fn (cdr form)) - byte-compile-macro-environment)) - (t ;; Give up on inlining. - form))))) + (localfn (cdr (assq name byte-compile-function-environment))) + (fn (or localfn (and (fboundp name) (symbol-function name))))) + (when (and (consp fn) (eq (car fn) 'autoload)) + (load (nth 1 fn)) + (setq fn (or (and (fboundp name) (symbol-function name)) + (cdr (assq name byte-compile-function-environment))))) + (pcase fn + (`nil + (byte-compile-warn "attempt to inline `%s' before it was defined" + name) + form) + (`(autoload . ,_) + (error "File `%s' didn't define `%s'" (nth 1 fn) name)) + ((and (pred symbolp) (guard (not (eq fn t)))) ;A function alias. + (byte-compile-inline-expand (cons fn (cdr form)))) + ((and (pred byte-code-function-p) + ;; FIXME: This only works to inline old-style-byte-codes into + ;; old-style-byte-codes. + (guard (not (or lexical-binding + (integerp (aref fn 0)))))) + ;; (message "Inlining %S byte-code" name) + (fetch-bytecode fn) + (let ((string (aref fn 1))) + (assert (not (multibyte-string-p string))) + ;; `byte-compile-splice-in-already-compiled-code' + ;; takes care of inlining the body. + (cons `(lambda ,(aref fn 0) + (byte-code ,string ,(aref fn 2) ,(aref fn 3))) + (cdr form)))) + ((and `(lambda . ,_) + ;; With lexical-binding we have several problems: + ;; - if `fn' comes from byte-compile-function-environment, we + ;; need to preprocess `fn', so we handle it below. + ;; - else, it means that `fn' is dyn-bound (otherwise it would + ;; start with `closure') so copying the code here would cause + ;; it to be mis-interpreted. + (guard (not lexical-binding))) + (macroexpand-all (cons fn (cdr form)) + byte-compile-macro-environment)) + ((and (or (and `(lambda ,args . ,body) + (let env nil) + (guard (eq fn localfn))) + `(closure ,env ,args . ,body)) + (guard lexical-binding)) + (let ((renv ())) + (dolist (binding env) + (cond + ((consp binding) + ;; We check shadowing by the args, so that the `let' can be + ;; moved within the lambda, which can then be unfolded. + ;; FIXME: Some of those bindings might be unused in `body'. + (unless (memq (car binding) args) ;Shadowed. + (push `(,(car binding) ',(cdr binding)) renv))) + ((eq binding t)) + (t (push `(defvar ,binding) body)))) + ;; (message "Inlining closure %S" (car form)) + (let ((newfn (byte-compile-preprocess + `(lambda ,args (let ,(nreverse renv) ,@body))))) + (if (eq (car-safe newfn) 'function) + (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) + (byte-compile-log-warning + (format "Inlining closure %S failed" name)) + form)))) + + (t ;; Give up on inlining. + form)))) ;; ((lambda ...) ...) (defun byte-compile-unfold-lambda (form &optional name) @@ -1095,7 +1122,7 @@ (let ((fn (nth 1 form))) (if (memq (car-safe fn) '(quote function)) (cons (nth 1 fn) (cdr (cdr form))) - form))) + form))) (defun byte-optimize-apply (form) ;; If the last arg is a literal constant, turn this into a funcall. @@ -1318,43 +1345,42 @@ ;; Used and set dynamically in byte-decompile-bytecode-1. (defvar bytedecomp-op) (defvar bytedecomp-ptr) -(defvar bytedecomp-bytes) ;; This function extracts the bitfields from variable-length opcodes. ;; Originally defined in disass.el (which no longer uses it.) -(defun disassemble-offset () +(defun disassemble-offset (bytes) "Don't call this!" - ;; fetch and return the offset for the current opcode. - ;; return nil if this opcode has no offset + ;; Fetch and return the offset for the current opcode. + ;; Return nil if this opcode has no offset. (cond ((< bytedecomp-op byte-nth) (let ((tem (logand bytedecomp-op 7))) (setq bytedecomp-op (logand bytedecomp-op 248)) (cond ((eq tem 6) ;; Offset in next byte. (setq bytedecomp-ptr (1+ bytedecomp-ptr)) - (aref bytedecomp-bytes bytedecomp-ptr)) + (aref bytes bytedecomp-ptr)) ((eq tem 7) ;; Offset in next 2 bytes. (setq bytedecomp-ptr (1+ bytedecomp-ptr)) - (+ (aref bytedecomp-bytes bytedecomp-ptr) + (+ (aref bytes bytedecomp-ptr) (progn (setq bytedecomp-ptr (1+ bytedecomp-ptr)) - (lsh (aref bytedecomp-bytes bytedecomp-ptr) 8)))) - (t tem)))) ;offset was in opcode + (lsh (aref bytes bytedecomp-ptr) 8)))) + (t tem)))) ;Offset was in opcode. ((>= bytedecomp-op byte-constant) - (prog1 (- bytedecomp-op byte-constant) ;offset in opcode + (prog1 (- bytedecomp-op byte-constant) ;Offset in opcode. (setq bytedecomp-op byte-constant))) ((or (and (>= bytedecomp-op byte-constant2) (<= bytedecomp-op byte-goto-if-not-nil-else-pop)) (= bytedecomp-op byte-stack-set2)) ;; Offset in next 2 bytes. (setq bytedecomp-ptr (1+ bytedecomp-ptr)) - (+ (aref bytedecomp-bytes bytedecomp-ptr) + (+ (aref bytes bytedecomp-ptr) (progn (setq bytedecomp-ptr (1+ bytedecomp-ptr)) - (lsh (aref bytedecomp-bytes bytedecomp-ptr) 8)))) + (lsh (aref bytes bytedecomp-ptr) 8)))) ((and (>= bytedecomp-op byte-listN) (<= bytedecomp-op byte-discardN)) - (setq bytedecomp-ptr (1+ bytedecomp-ptr)) ;offset in next byte - (aref bytedecomp-bytes bytedecomp-ptr)))) + (setq bytedecomp-ptr (1+ bytedecomp-ptr)) ;Offset in next byte. + (aref bytes bytedecomp-ptr)))) (defvar byte-compile-tag-number) @@ -1381,24 +1407,24 @@ (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable) (let ((bytedecomp-bytes bytes) (length (length bytes)) - (bytedecomp-ptr 0) optr tags bytedecomp-op offset + (bytedecomp-ptr 0) optr tags bytedecomp-op offset lap tmp endtag) (while (not (= bytedecomp-ptr length)) (or make-spliceable - (setq lap (cons bytedecomp-ptr lap))) + (push bytedecomp-ptr lap)) (setq bytedecomp-op (aref bytedecomp-bytes bytedecomp-ptr) optr bytedecomp-ptr - offset (disassemble-offset)) ; this does dynamic-scope magic + ;; This uses dynamic-scope magic. + offset (disassemble-offset bytedecomp-bytes)) (setq bytedecomp-op (aref byte-code-vector bytedecomp-op)) (cond ((memq bytedecomp-op byte-goto-ops) - ;; it's a pc + ;; It's a pc. (setq offset (cdr (or (assq offset tags) - (car (setq tags - (cons (cons offset - (byte-compile-make-tag)) - tags))))))) + (let ((new (cons offset (byte-compile-make-tag)))) + (push new tags) + new))))) ((cond ((eq bytedecomp-op 'byte-constant2) (setq bytedecomp-op 'byte-constant) t) ((memq bytedecomp-op byte-constref-ops))) @@ -1408,9 +1434,9 @@ offset (if (eq bytedecomp-op 'byte-constant) (byte-compile-get-constant tmp) (or (assq tmp byte-compile-variables) - (car (setq byte-compile-variables - (cons (list tmp) - byte-compile-variables))))))) + (let ((new (list tmp))) + (push new byte-compile-variables) + new))))) ((and make-spliceable (eq bytedecomp-op 'byte-return)) (if (= bytedecomp-ptr (1- length)) @@ -1427,26 +1453,26 @@ (setq bytedecomp-op 'byte-discardN-preserve-tos) (setq offset (- offset #x80)))) ;; lap = ( [ (pc . (op . arg)) ]* ) - (setq lap (cons (cons optr (cons bytedecomp-op (or offset 0))) - lap)) + (push (cons optr (cons bytedecomp-op (or offset 0))) + lap) (setq bytedecomp-ptr (1+ bytedecomp-ptr))) - ;; take off the dummy nil op that we replaced a trailing "return" with. (let ((rest lap)) (while rest (cond ((numberp (car rest))) ((setq tmp (assq (car (car rest)) tags)) - ;; this addr is jumped to + ;; This addr is jumped to. (setcdr rest (cons (cons nil (cdr tmp)) (cdr rest))) (setq tags (delq tmp tags)) (setq rest (cdr rest)))) (setq rest (cdr rest)))) (if tags (error "optimizer error: missed tags %s" tags)) + ;; Take off the dummy nil op that we replaced a trailing "return" with. (if (null (car (cdr (car lap)))) (setq lap (cdr lap))) (if endtag (setq lap (cons (cons nil endtag) lap))) - ;; remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* ) + ;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* ) (mapcar (function (lambda (elt) (if (numberp elt) elt diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 69733ed2e8e..c9a85edfca4 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -33,8 +33,6 @@ ;;; Code: -;; FIXME: get rid of the atrocious "bytecomp-" variable prefix. - ;; ======================================================================== ;; Entry points: ;; byte-recompile-directory, byte-compile-file, @@ -1563,41 +1561,33 @@ Files in subdirectories of DIRECTORY are processed also." (interactive "DByte force recompile (directory): ") (byte-recompile-directory directory nil t)) -;; The `bytecomp-' prefix is applied to all local variables with -;; otherwise common names in this and similar functions for the sake -;; of the boundp test in byte-compile-variable-ref. -;; http://lists.gnu.org/archive/html/emacs-devel/2008-01/msg00237.html -;; http://lists.gnu.org/archive/html/bug-gnu-emacs/2008-02/msg00134.html -;; Note that similar considerations apply to command-line-1 in startup.el. ;;;###autoload -(defun byte-recompile-directory (bytecomp-directory &optional bytecomp-arg - bytecomp-force) - "Recompile every `.el' file in BYTECOMP-DIRECTORY that needs recompilation. +(defun byte-recompile-directory (directory &optional arg force) + "Recompile every `.el' file in DIRECTORY that needs recompilation. This happens when a `.elc' file exists but is older than the `.el' file. -Files in subdirectories of BYTECOMP-DIRECTORY are processed also. +Files in subdirectories of DIRECTORY are processed also. If the `.elc' file does not exist, normally this function *does not* compile the corresponding `.el' file. However, if the prefix argument -BYTECOMP-ARG is 0, that means do compile all those files. A nonzero -BYTECOMP-ARG means ask the user, for each such `.el' file, whether to -compile it. A nonzero BYTECOMP-ARG also means ask about each subdirectory +ARG is 0, that means do compile all those files. A nonzero +ARG means ask the user, for each such `.el' file, whether to +compile it. A nonzero ARG also means ask about each subdirectory before scanning it. -If the third argument BYTECOMP-FORCE is non-nil, recompile every `.el' file +If the third argument FORCE is non-nil, recompile every `.el' file that already has a `.elc' file." (interactive "DByte recompile directory: \nP") - (if bytecomp-arg - (setq bytecomp-arg (prefix-numeric-value bytecomp-arg))) + (if arg (setq arg (prefix-numeric-value arg))) (if noninteractive nil (save-some-buffers) (force-mode-line-update)) (with-current-buffer (get-buffer-create byte-compile-log-buffer) - (setq default-directory (expand-file-name bytecomp-directory)) + (setq default-directory (expand-file-name directory)) ;; compilation-mode copies value of default-directory. (unless (eq major-mode 'compilation-mode) (compilation-mode)) - (let ((bytecomp-directories (list default-directory)) + (let ((directories (list default-directory)) (default-directory default-directory) (skip-count 0) (fail-count 0) @@ -1605,47 +1595,36 @@ that already has a `.elc' file." (dir-count 0) last-dir) (displaying-byte-compile-warnings - (while bytecomp-directories - (setq bytecomp-directory (car bytecomp-directories)) - (message "Checking %s..." bytecomp-directory) - (let ((bytecomp-files (directory-files bytecomp-directory)) - bytecomp-source) - (dolist (bytecomp-file bytecomp-files) - (setq bytecomp-source - (expand-file-name bytecomp-file bytecomp-directory)) - (if (and (not (member bytecomp-file '("RCS" "CVS"))) - (not (eq ?\. (aref bytecomp-file 0))) - (file-directory-p bytecomp-source) - (not (file-symlink-p bytecomp-source))) - ;; This file is a subdirectory. Handle them differently. - (when (or (null bytecomp-arg) - (eq 0 bytecomp-arg) - (y-or-n-p (concat "Check " bytecomp-source "? "))) - (setq bytecomp-directories - (nconc bytecomp-directories (list bytecomp-source)))) - ;; It is an ordinary file. Decide whether to compile it. - (if (and (string-match emacs-lisp-file-regexp bytecomp-source) - (file-readable-p bytecomp-source) - (not (auto-save-file-name-p bytecomp-source)) - (not (string-equal dir-locals-file - (file-name-nondirectory - bytecomp-source)))) - (progn (let ((bytecomp-res (byte-recompile-file - bytecomp-source - bytecomp-force bytecomp-arg))) - (cond ((eq bytecomp-res 'no-byte-compile) - (setq skip-count (1+ skip-count))) - ((eq bytecomp-res t) - (setq file-count (1+ file-count))) - ((eq bytecomp-res nil) - (setq fail-count (1+ fail-count))))) - (or noninteractive - (message "Checking %s..." bytecomp-directory)) - (if (not (eq last-dir bytecomp-directory)) - (setq last-dir bytecomp-directory - dir-count (1+ dir-count))) - ))))) - (setq bytecomp-directories (cdr bytecomp-directories)))) + (while directories + (setq directory (car directories)) + (message "Checking %s..." directory) + (dolist (file (directory-files directory)) + (let ((source (expand-file-name file directory))) + (if (and (not (member file '("RCS" "CVS"))) + (not (eq ?\. (aref file 0))) + (file-directory-p source) + (not (file-symlink-p source))) + ;; This file is a subdirectory. Handle them differently. + (when (or (null arg) (eq 0 arg) + (y-or-n-p (concat "Check " source "? "))) + (setq directories (nconc directories (list source)))) + ;; It is an ordinary file. Decide whether to compile it. + (if (and (string-match emacs-lisp-file-regexp source) + (file-readable-p source) + (not (auto-save-file-name-p source)) + (not (string-equal dir-locals-file + (file-name-nondirectory source)))) + (progn (case (byte-recompile-file source force arg) + (no-byte-compile (setq skip-count (1+ skip-count))) + ((t) (setq file-count (1+ file-count))) + ((nil) (setq fail-count (1+ fail-count)))) + (or noninteractive + (message "Checking %s..." directory)) + (if (not (eq last-dir directory)) + (setq last-dir directory + dir-count (1+ dir-count))) + ))))) + (setq directories (cdr directories)))) (message "Done (Total of %d file%s compiled%s%s%s)" file-count (if (= file-count 1) "" "s") (if (> fail-count 0) (format ", %d failed" fail-count) "") @@ -1660,100 +1639,97 @@ This is normally set in local file variables at the end of the elisp file: \;; Local Variables:\n;; no-byte-compile: t\n;; End: ") ;Backslash for compile-main. ;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp) -(defun byte-recompile-file (bytecomp-filename &optional bytecomp-force bytecomp-arg load) - "Recompile BYTECOMP-FILENAME file if it needs recompilation. +(defun byte-recompile-file (filename &optional force arg load) + "Recompile FILENAME file if it needs recompilation. This happens when its `.elc' file is older than itself. If the `.elc' file exists and is up-to-date, normally this -function *does not* compile BYTECOMP-FILENAME. However, if the -prefix argument BYTECOMP-FORCE is set, that means do compile -BYTECOMP-FILENAME even if the destination already exists and is +function *does not* compile FILENAME. However, if the +prefix argument FORCE is set, that means do compile +FILENAME even if the destination already exists and is up-to-date. If the `.elc' file does not exist, normally this function *does -not* compile BYTECOMP-FILENAME. If BYTECOMP-ARG is 0, that means +not* compile FILENAME. If ARG is 0, that means compile the file even if it has never been compiled before. -A nonzero BYTECOMP-ARG means ask the user. +A nonzero ARG means ask the user. If LOAD is set, `load' the file after compiling. The value returned is the value returned by `byte-compile-file', or 'no-byte-compile if the file did not need recompilation." (interactive - (let ((bytecomp-file buffer-file-name) - (bytecomp-file-name nil) - (bytecomp-file-dir nil)) - (and bytecomp-file - (eq (cdr (assq 'major-mode (buffer-local-variables))) - 'emacs-lisp-mode) - (setq bytecomp-file-name (file-name-nondirectory bytecomp-file) - bytecomp-file-dir (file-name-directory bytecomp-file))) + (let ((file buffer-file-name) + (file-name nil) + (file-dir nil)) + (and file + (derived-mode-p 'emacs-lisp-mode) + (setq file-name (file-name-nondirectory file) + file-dir (file-name-directory file))) (list (read-file-name (if current-prefix-arg "Byte compile file: " "Byte recompile file: ") - bytecomp-file-dir bytecomp-file-name nil) + file-dir file-name nil) current-prefix-arg))) - (let ((bytecomp-dest - (byte-compile-dest-file bytecomp-filename)) + (let ((dest (byte-compile-dest-file filename)) ;; Expand now so we get the current buffer's defaults - (bytecomp-filename (expand-file-name bytecomp-filename))) - (if (if (file-exists-p bytecomp-dest) + (filename (expand-file-name filename))) + (if (if (file-exists-p dest) ;; File was already compiled ;; Compile if forced to, or filename newer - (or bytecomp-force - (file-newer-than-file-p bytecomp-filename - bytecomp-dest)) - (and bytecomp-arg - (or (eq 0 bytecomp-arg) + (or force + (file-newer-than-file-p filename dest)) + (and arg + (or (eq 0 arg) (y-or-n-p (concat "Compile " - bytecomp-filename "? "))))) + filename "? "))))) (progn (if (and noninteractive (not byte-compile-verbose)) - (message "Compiling %s..." bytecomp-filename)) - (byte-compile-file bytecomp-filename load)) - (when load (load bytecomp-filename)) + (message "Compiling %s..." filename)) + (byte-compile-file filename load)) + (when load (load filename)) 'no-byte-compile))) ;;;###autoload -(defun byte-compile-file (bytecomp-filename &optional load) - "Compile a file of Lisp code named BYTECOMP-FILENAME into a file of byte code. -The output file's name is generated by passing BYTECOMP-FILENAME to the +(defun byte-compile-file (filename &optional load) + "Compile a file of Lisp code named FILENAME into a file of byte code. +The output file's name is generated by passing FILENAME to the function `byte-compile-dest-file' (which see). With prefix arg (noninteractively: 2nd arg), LOAD the file after compiling. The value is non-nil if there were no errors, nil if errors." ;; (interactive "fByte compile file: \nP") (interactive - (let ((bytecomp-file buffer-file-name) - (bytecomp-file-name nil) - (bytecomp-file-dir nil)) - (and bytecomp-file + (let ((file buffer-file-name) + (file-name nil) + (file-dir nil)) + (and file (derived-mode-p 'emacs-lisp-mode) - (setq bytecomp-file-name (file-name-nondirectory bytecomp-file) - bytecomp-file-dir (file-name-directory bytecomp-file))) + (setq file-name (file-name-nondirectory file) + file-dir (file-name-directory file))) (list (read-file-name (if current-prefix-arg "Byte compile and load file: " "Byte compile file: ") - bytecomp-file-dir bytecomp-file-name nil) + file-dir file-name nil) current-prefix-arg))) ;; Expand now so we get the current buffer's defaults - (setq bytecomp-filename (expand-file-name bytecomp-filename)) + (setq filename (expand-file-name filename)) ;; If we're compiling a file that's in a buffer and is modified, offer ;; to save it first. (or noninteractive - (let ((b (get-file-buffer (expand-file-name bytecomp-filename)))) + (let ((b (get-file-buffer (expand-file-name filename)))) (if (and b (buffer-modified-p b) (y-or-n-p (format "Save buffer %s first? " (buffer-name b)))) (with-current-buffer b (save-buffer))))) ;; Force logging of the file name for each file compiled. (setq byte-compile-last-logged-file nil) - (let ((byte-compile-current-file bytecomp-filename) + (let ((byte-compile-current-file filename) (byte-compile-current-group nil) (set-auto-coding-for-load t) target-file input-buffer output-buffer byte-compile-dest-file) - (setq target-file (byte-compile-dest-file bytecomp-filename)) + (setq target-file (byte-compile-dest-file filename)) (setq byte-compile-dest-file target-file) (with-current-buffer (setq input-buffer (get-buffer-create " *Compiler Input*")) @@ -1762,7 +1738,7 @@ The value is non-nil if there were no errors, nil if errors." ;; Always compile an Emacs Lisp file as multibyte ;; unless the file itself forces unibyte with -*-coding: raw-text;-*- (set-buffer-multibyte t) - (insert-file-contents bytecomp-filename) + (insert-file-contents filename) ;; Mimic the way after-insert-file-set-coding can make the ;; buffer unibyte when visiting this file. (when (or (eq last-coding-system-used 'no-conversion) @@ -1772,7 +1748,7 @@ The value is non-nil if there were no errors, nil if errors." (set-buffer-multibyte nil)) ;; Run hooks including the uncompression hook. ;; If they change the file name, then change it for the output also. - (letf ((buffer-file-name bytecomp-filename) + (letf ((buffer-file-name filename) ((default-value 'major-mode) 'emacs-lisp-mode) ;; Ignore unsafe local variables. ;; We only care about a few of them for our purposes. @@ -1780,15 +1756,15 @@ The value is non-nil if there were no errors, nil if errors." (enable-local-eval nil)) ;; Arg of t means don't alter enable-local-variables. (normal-mode t) - (setq bytecomp-filename buffer-file-name)) + (setq filename buffer-file-name)) ;; Set the default directory, in case an eval-when-compile uses it. - (setq default-directory (file-name-directory bytecomp-filename))) + (setq default-directory (file-name-directory filename))) ;; Check if the file's local variables explicitly specify not to ;; compile this file. (if (with-current-buffer input-buffer no-byte-compile) (progn ;; (message "%s not compiled because of `no-byte-compile: %s'" - ;; (file-relative-name bytecomp-filename) + ;; (file-relative-name filename) ;; (with-current-buffer input-buffer no-byte-compile)) (when (file-exists-p target-file) (message "%s deleted because of `no-byte-compile: %s'" @@ -1798,7 +1774,7 @@ The value is non-nil if there were no errors, nil if errors." ;; We successfully didn't compile this file. 'no-byte-compile) (when byte-compile-verbose - (message "Compiling %s..." bytecomp-filename)) + (message "Compiling %s..." filename)) (setq byte-compiler-error-flag nil) ;; It is important that input-buffer not be current at this call, ;; so that the value of point set in input-buffer @@ -1809,7 +1785,7 @@ The value is non-nil if there were no errors, nil if errors." (if byte-compiler-error-flag nil (when byte-compile-verbose - (message "Compiling %s...done" bytecomp-filename)) + (message "Compiling %s...done" filename)) (kill-buffer input-buffer) (with-current-buffer output-buffer (goto-char (point-max)) @@ -1849,9 +1825,9 @@ The value is non-nil if there were no errors, nil if errors." (if (and byte-compile-generate-call-tree (or (eq t byte-compile-generate-call-tree) (y-or-n-p (format "Report call tree for %s? " - bytecomp-filename)))) + filename)))) (save-excursion - (display-call-tree bytecomp-filename))) + (display-call-tree filename))) (if load (load target-file)) t)))) @@ -1885,11 +1861,11 @@ With argument ARG, insert value in current buffer after the form." ;; Dynamically bound in byte-compile-from-buffer. ;; NB also used in cl.el and cl-macs.el. -(defvar bytecomp-outbuffer) +(defvar byte-compile-outbuffer) -(defun byte-compile-from-buffer (bytecomp-inbuffer) - (let (bytecomp-outbuffer - (byte-compile-current-buffer bytecomp-inbuffer) +(defun byte-compile-from-buffer (inbuffer) + (let (byte-compile-outbuffer + (byte-compile-current-buffer inbuffer) (byte-compile-read-position nil) (byte-compile-last-position nil) ;; Prevent truncation of flonums and lists as we read and print them @@ -1910,23 +1886,23 @@ With argument ARG, insert value in current buffer after the form." (byte-compile-output nil) ;; This allows us to get the positions of symbols read; it's ;; new in Emacs 22.1. - (read-with-symbol-positions bytecomp-inbuffer) + (read-with-symbol-positions inbuffer) (read-symbol-positions-list nil) ;; #### This is bound in b-c-close-variables. ;; (byte-compile-warnings byte-compile-warnings) ) (byte-compile-close-variables (with-current-buffer - (setq bytecomp-outbuffer (get-buffer-create " *Compiler Output*")) + (setq byte-compile-outbuffer (get-buffer-create " *Compiler Output*")) (set-buffer-multibyte t) (erase-buffer) ;; (emacs-lisp-mode) (setq case-fold-search nil)) (displaying-byte-compile-warnings - (with-current-buffer bytecomp-inbuffer + (with-current-buffer inbuffer (and byte-compile-current-file (byte-compile-insert-header byte-compile-current-file - bytecomp-outbuffer)) + byte-compile-outbuffer)) (goto-char (point-min)) ;; Should we always do this? When calling multiple files, it ;; would be useful to delay this warning until all have been @@ -1943,7 +1919,7 @@ With argument ARG, insert value in current buffer after the form." (setq byte-compile-read-position (point) byte-compile-last-position byte-compile-read-position) (let* ((old-style-backquotes nil) - (form (read bytecomp-inbuffer))) + (form (read inbuffer))) ;; Warn about the use of old-style backquotes. (when old-style-backquotes (byte-compile-warn "!! The file uses old-style backquotes !! @@ -1959,9 +1935,9 @@ and will be removed soon. See (elisp)Backquote in the manual.")) ;; Fix up the header at the front of the output ;; if the buffer contains multibyte characters. (and byte-compile-current-file - (with-current-buffer bytecomp-outbuffer + (with-current-buffer byte-compile-outbuffer (byte-compile-fix-header byte-compile-current-file))))) - bytecomp-outbuffer)) + byte-compile-outbuffer)) (defun byte-compile-fix-header (filename) "If the current buffer has any multibyte characters, insert a version test." @@ -2070,8 +2046,8 @@ Call from the source buffer." (print-gensym t) (print-circle ; handle circular data structures (not byte-compile-disable-print-circle))) - (princ "\n" bytecomp-outbuffer) - (prin1 form bytecomp-outbuffer) + (princ "\n" byte-compile-outbuffer) + (prin1 form byte-compile-outbuffer) nil))) (defvar print-gensym-alist) ;Used before print-circle existed. @@ -2091,7 +2067,7 @@ list that represents a doc string reference. ;; We need to examine byte-compile-dynamic-docstrings ;; in the input buffer (now current), not in the output buffer. (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) - (with-current-buffer bytecomp-outbuffer + (with-current-buffer byte-compile-outbuffer (let (position) ;; Insert the doc string, and make it a comment with #@LENGTH. @@ -2115,7 +2091,7 @@ list that represents a doc string reference. (if preface (progn (insert preface) - (prin1 name bytecomp-outbuffer))) + (prin1 name byte-compile-outbuffer))) (insert (car info)) (let ((print-escape-newlines t) (print-quoted t) @@ -2130,7 +2106,7 @@ list that represents a doc string reference. (print-continuous-numbering t) print-number-table (index 0)) - (prin1 (car form) bytecomp-outbuffer) + (prin1 (car form) byte-compile-outbuffer) (while (setq form (cdr form)) (setq index (1+ index)) (insert " ") @@ -2153,35 +2129,35 @@ list that represents a doc string reference. (setq position (- (position-bytes position) (point-min) -1)) (princ (format "(#$ . %d) nil" position) - bytecomp-outbuffer) + byte-compile-outbuffer) (setq form (cdr form)) (setq index (1+ index)))) ((= index (nth 1 info)) (if position (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") position) - bytecomp-outbuffer) + byte-compile-outbuffer) (let ((print-escape-newlines nil)) (goto-char (prog1 (1+ (point)) - (prin1 (car form) bytecomp-outbuffer))) + (prin1 (car form) byte-compile-outbuffer))) (insert "\\\n") (goto-char (point-max))))) (t - (prin1 (car form) bytecomp-outbuffer))))) + (prin1 (car form) byte-compile-outbuffer))))) (insert (nth 2 info))))) nil) -(defun byte-compile-keep-pending (form &optional bytecomp-handler) +(defun byte-compile-keep-pending (form &optional handler) (if (memq byte-optimize '(t source)) (setq form (byte-optimize-form form t))) - (if bytecomp-handler + (if handler (let ((byte-compile--for-effect t)) ;; To avoid consing up monstrously large forms at load time, we split ;; the output regularly. (and (memq (car-safe form) '(fset defalias)) (nthcdr 300 byte-compile-output) (byte-compile-flush-pending)) - (funcall bytecomp-handler form) + (funcall handler form) (if byte-compile--for-effect (byte-compile-discard))) (byte-compile-form form t)) @@ -2219,11 +2195,11 @@ list that represents a doc string reference. ;; byte-hunk-handlers can call this. (defun byte-compile-file-form (form) - (let (bytecomp-handler) + (let (handler) (cond ((and (consp form) (symbolp (car form)) - (setq bytecomp-handler (get (car form) 'byte-hunk-handler))) - (cond ((setq form (funcall bytecomp-handler form)) + (setq handler (get (car form) 'byte-hunk-handler))) + (cond ((setq form (funcall handler form)) (byte-compile-flush-pending) (byte-compile-output-file-form form)))) (t @@ -2385,32 +2361,30 @@ by side-effects." res)) (defun byte-compile-file-form-defmumble (form macrop) - (let* ((bytecomp-name (car (cdr form))) - (bytecomp-this-kind (if macrop 'byte-compile-macro-environment + (let* ((name (car (cdr form))) + (this-kind (if macrop 'byte-compile-macro-environment 'byte-compile-function-environment)) - (bytecomp-that-kind (if macrop 'byte-compile-function-environment + (that-kind (if macrop 'byte-compile-function-environment 'byte-compile-macro-environment)) - (bytecomp-this-one (assq bytecomp-name - (symbol-value bytecomp-this-kind))) - (bytecomp-that-one (assq bytecomp-name - (symbol-value bytecomp-that-kind))) + (this-one (assq name (symbol-value this-kind))) + (that-one (assq name (symbol-value that-kind))) (byte-compile-free-references nil) (byte-compile-free-assignments nil)) - (byte-compile-set-symbol-position bytecomp-name) + (byte-compile-set-symbol-position name) ;; When a function or macro is defined, add it to the call tree so that ;; we can tell when functions are not used. (if byte-compile-generate-call-tree - (or (assq bytecomp-name byte-compile-call-tree) + (or (assq name byte-compile-call-tree) (setq byte-compile-call-tree - (cons (list bytecomp-name nil nil) byte-compile-call-tree)))) + (cons (list name nil nil) byte-compile-call-tree)))) - (setq byte-compile-current-form bytecomp-name) ; for warnings + (setq byte-compile-current-form name) ; for warnings (if (byte-compile-warning-enabled-p 'redefine) (byte-compile-arglist-warn form macrop)) (if byte-compile-verbose (message "Compiling %s... (%s)" (or byte-compile-current-file "") (nth 1 form))) - (cond (bytecomp-that-one + (cond (that-one (if (and (byte-compile-warning-enabled-p 'redefine) ;; don't warn when compiling the stubs in byte-run... (not (assq (nth 1 form) @@ -2418,8 +2392,8 @@ by side-effects." (byte-compile-warn "`%s' defined multiple times, as both function and macro" (nth 1 form))) - (setcdr bytecomp-that-one nil)) - (bytecomp-this-one + (setcdr that-one nil)) + (this-one (when (and (byte-compile-warning-enabled-p 'redefine) ;; hack: don't warn when compiling the magic internal ;; byte-compiler macros in byte-run.el... @@ -2428,8 +2402,8 @@ by side-effects." (byte-compile-warn "%s `%s' defined multiple times in this file" (if macrop "macro" "function") (nth 1 form)))) - ((and (fboundp bytecomp-name) - (eq (car-safe (symbol-function bytecomp-name)) + ((and (fboundp name) + (eq (car-safe (symbol-function name)) (if macrop 'lambda 'macro))) (when (byte-compile-warning-enabled-p 'redefine) (byte-compile-warn "%s `%s' being redefined as a %s" @@ -2437,9 +2411,9 @@ by side-effects." (nth 1 form) (if macrop "macro" "function"))) ;; shadow existing definition - (set bytecomp-this-kind - (cons (cons bytecomp-name nil) - (symbol-value bytecomp-this-kind)))) + (set this-kind + (cons (cons name nil) + (symbol-value this-kind)))) ) (let ((body (nthcdr 3 form))) (when (and (stringp (car body)) @@ -2454,27 +2428,27 @@ by side-effects." ;; Remove declarations from the body of the macro definition. (when macrop (dolist (decl (byte-compile-defmacro-declaration form)) - (prin1 decl bytecomp-outbuffer))) + (prin1 decl byte-compile-outbuffer))) (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t)) (code (byte-compile-byte-code-maker new-one))) - (if bytecomp-this-one - (setcdr bytecomp-this-one new-one) - (set bytecomp-this-kind - (cons (cons bytecomp-name new-one) - (symbol-value bytecomp-this-kind)))) + (if this-one + (setcdr this-one new-one) + (set this-kind + (cons (cons name new-one) + (symbol-value this-kind)))) (if (and (stringp (nth 3 form)) (eq 'quote (car-safe code)) (eq 'lambda (car-safe (nth 1 code)))) (cons (car form) - (cons bytecomp-name (cdr (nth 1 code)))) + (cons name (cdr (nth 1 code)))) (byte-compile-flush-pending) (if (not (stringp (nth 3 form))) ;; No doc string. Provide -1 as the "doc string index" ;; so that no element will be treated as a doc string. (byte-compile-output-docform "\n(defalias '" - bytecomp-name + name (cond ((atom code) (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))) ((eq (car code) 'quote) @@ -2489,7 +2463,7 @@ by side-effects." ;; b-c-output-file-form analyze the defalias. (byte-compile-output-docform "\n(defalias '" - bytecomp-name + name (cond ((atom code) (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))) ((eq (car code) 'quote) @@ -2500,7 +2474,7 @@ by side-effects." (and (atom code) byte-compile-dynamic 1) nil)) - (princ ")" bytecomp-outbuffer) + (princ ")" byte-compile-outbuffer) nil)))) ;; Print Lisp object EXP in the output file, inside a comment, @@ -2508,13 +2482,13 @@ by side-effects." ;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. (defun byte-compile-output-as-comment (exp quoted) (let ((position (point))) - (with-current-buffer bytecomp-outbuffer + (with-current-buffer byte-compile-outbuffer ;; Insert EXP, and make it a comment with #@LENGTH. (insert " ") (if quoted - (prin1 exp bytecomp-outbuffer) - (princ exp bytecomp-outbuffer)) + (prin1 exp byte-compile-outbuffer) + (princ exp byte-compile-outbuffer)) (goto-char position) ;; Quote certain special characters as needed. ;; get_doc_string in doc.c does the unquoting. @@ -2693,41 +2667,41 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; of the list FUN and `byte-compile-set-symbol-position' is not called. ;; Use this feature to avoid calling `byte-compile-set-symbol-position' ;; for symbols generated by the byte compiler itself. -(defun byte-compile-lambda (bytecomp-fun &optional add-lambda reserved-csts) +(defun byte-compile-lambda (fun &optional add-lambda reserved-csts) (if add-lambda - (setq bytecomp-fun (cons 'lambda bytecomp-fun)) - (unless (eq 'lambda (car-safe bytecomp-fun)) - (error "Not a lambda list: %S" bytecomp-fun)) + (setq fun (cons 'lambda fun)) + (unless (eq 'lambda (car-safe fun)) + (error "Not a lambda list: %S" fun)) (byte-compile-set-symbol-position 'lambda)) - (byte-compile-check-lambda-list (nth 1 bytecomp-fun)) - (let* ((bytecomp-arglist (nth 1 bytecomp-fun)) + (byte-compile-check-lambda-list (nth 1 fun)) + (let* ((arglist (nth 1 fun)) (byte-compile-bound-variables (append (and (not lexical-binding) - (byte-compile-arglist-vars bytecomp-arglist)) + (byte-compile-arglist-vars arglist)) byte-compile-bound-variables)) - (bytecomp-body (cdr (cdr bytecomp-fun))) - (bytecomp-doc (if (stringp (car bytecomp-body)) - (prog1 (car bytecomp-body) - ;; Discard the doc string - ;; unless it is the last element of the body. - (if (cdr bytecomp-body) - (setq bytecomp-body (cdr bytecomp-body)))))) - (bytecomp-int (assq 'interactive bytecomp-body))) + (body (cdr (cdr fun))) + (doc (if (stringp (car body)) + (prog1 (car body) + ;; Discard the doc string + ;; unless it is the last element of the body. + (if (cdr body) + (setq body (cdr body)))))) + (int (assq 'interactive body))) ;; Process the interactive spec. - (when bytecomp-int + (when int (byte-compile-set-symbol-position 'interactive) ;; Skip (interactive) if it is in front (the most usual location). - (if (eq bytecomp-int (car bytecomp-body)) - (setq bytecomp-body (cdr bytecomp-body))) - (cond ((consp (cdr bytecomp-int)) - (if (cdr (cdr bytecomp-int)) + (if (eq int (car body)) + (setq body (cdr body))) + (cond ((consp (cdr int)) + (if (cdr (cdr int)) (byte-compile-warn "malformed interactive spec: %s" - (prin1-to-string bytecomp-int))) + (prin1-to-string int))) ;; If the interactive spec is a call to `list', don't ;; compile it, because `call-interactively' looks at the ;; args of `list'. Actually, compile it to get warnings, ;; but don't use the result. - (let* ((form (nth 1 bytecomp-int)) + (let* ((form (nth 1 int)) (newform (byte-compile-top-level form))) (while (memq (car-safe form) '(let let* progn save-excursion)) (while (consp (cdr form)) @@ -2739,48 +2713,46 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; it won't be eval'd in the right mode. (not lexical-binding)) nil - (setq bytecomp-int `(interactive ,newform))))) - ((cdr bytecomp-int) + (setq int `(interactive ,newform))))) + ((cdr int) (byte-compile-warn "malformed interactive spec: %s" - (prin1-to-string bytecomp-int))))) + (prin1-to-string int))))) ;; Process the body. (let ((compiled - (byte-compile-top-level (cons 'progn bytecomp-body) nil 'lambda + (byte-compile-top-level (cons 'progn body) nil 'lambda ;; If doing lexical binding, push a new ;; lexical environment containing just the ;; args (since lambda expressions should be ;; closed by now). (and lexical-binding - (byte-compile-make-lambda-lexenv - bytecomp-fun)) + (byte-compile-make-lambda-lexenv fun)) reserved-csts))) ;; Build the actual byte-coded function. (if (eq 'byte-code (car-safe compiled)) (apply 'make-byte-code (if lexical-binding - (byte-compile-make-args-desc bytecomp-arglist) - bytecomp-arglist) + (byte-compile-make-args-desc arglist) + arglist) (append ;; byte-string, constants-vector, stack depth (cdr compiled) ;; optionally, the doc string. (cond (lexical-binding (require 'help-fns) - (list (help-add-fundoc-usage - bytecomp-doc bytecomp-arglist))) - ((or bytecomp-doc bytecomp-int) - (list bytecomp-doc))) + (list (help-add-fundoc-usage doc arglist))) + ((or doc int) + (list doc))) ;; optionally, the interactive spec. - (if bytecomp-int - (list (nth 1 bytecomp-int))))) + (if int + (list (nth 1 int))))) (setq compiled - (nconc (if bytecomp-int (list bytecomp-int)) + (nconc (if int (list int)) (cond ((eq (car-safe compiled) 'progn) (cdr compiled)) (compiled (list compiled))))) - (nconc (list 'lambda bytecomp-arglist) - (if (or bytecomp-doc (stringp (car compiled))) - (cons bytecomp-doc (cond (compiled) - (bytecomp-body (list nil)))) + (nconc (list 'lambda arglist) + (if (or doc (stringp (car compiled))) + (cons doc (cond (compiled) + (body (list nil)))) compiled)))))) (defun byte-compile-closure (form &optional add-lambda) @@ -2951,14 +2923,14 @@ If FORM is a lambda or a macro, byte-compile it as a function." ((cdr body) (cons 'progn (nreverse body))) ((car body))))) -;; Given BYTECOMP-BODY, compile it and return a new body. -(defun byte-compile-top-level-body (bytecomp-body &optional for-effect) - (setq bytecomp-body - (byte-compile-top-level (cons 'progn bytecomp-body) for-effect t)) - (cond ((eq (car-safe bytecomp-body) 'progn) - (cdr bytecomp-body)) - (bytecomp-body - (list bytecomp-body)))) +;; Given BODY, compile it and return a new body. +(defun byte-compile-top-level-body (body &optional for-effect) + (setq body + (byte-compile-top-level (cons 'progn body) for-effect t)) + (cond ((eq (car-safe body) 'progn) + (cdr body)) + (body + (list body)))) ;; Special macro-expander used during byte-compilation. (defun byte-compile-macroexpand-declare-function (fn file &rest args) @@ -3002,28 +2974,28 @@ If FORM is a lambda or a macro, byte-compile it as a function." (t (byte-compile-variable-ref form)))) ((symbolp (car form)) - (let* ((bytecomp-fn (car form)) - (bytecomp-handler (get bytecomp-fn 'byte-compile))) - (when (byte-compile-const-symbol-p bytecomp-fn) - (byte-compile-warn "`%s' called as a function" bytecomp-fn)) + (let* ((fn (car form)) + (handler (get fn 'byte-compile))) + (when (byte-compile-const-symbol-p fn) + (byte-compile-warn "`%s' called as a function" fn)) (and (byte-compile-warning-enabled-p 'interactive-only) - (memq bytecomp-fn byte-compile-interactive-only-functions) + (memq fn byte-compile-interactive-only-functions) (byte-compile-warn "`%s' used from Lisp code\n\ -That command is designed for interactive use only" bytecomp-fn)) +That command is designed for interactive use only" fn)) (if (and (fboundp (car form)) (eq (car-safe (symbol-function (car form))) 'macro)) (byte-compile-report-error (format "Forgot to expand macro %s" (car form)))) - (if (and bytecomp-handler + (if (and handler ;; Make sure that function exists. This is important ;; for CL compiler macros since the symbol may be ;; `cl-byte-compile-compiler-macro' but if CL isn't ;; loaded, this function doesn't exist. - (and (not (eq bytecomp-handler + (and (not (eq handler ;; Already handled by macroexpand-all. 'cl-byte-compile-compiler-macro)) - (functionp bytecomp-handler))) - (funcall bytecomp-handler form) + (functionp handler))) + (funcall handler form) (byte-compile-normal-call form)) (if (byte-compile-warning-enabled-p 'cl-functions) (byte-compile-cl-warn form)))) @@ -3609,14 +3581,14 @@ discarding." (byte-defop-compiler-1 quote) (defun byte-compile-setq (form) - (let ((bytecomp-args (cdr form))) - (if bytecomp-args - (while bytecomp-args - (byte-compile-form (car (cdr bytecomp-args))) - (or byte-compile--for-effect (cdr (cdr bytecomp-args)) + (let ((args (cdr form))) + (if args + (while args + (byte-compile-form (car (cdr args))) + (or byte-compile--for-effect (cdr (cdr args)) (byte-compile-out 'byte-dup 0)) - (byte-compile-variable-set (car bytecomp-args)) - (setq bytecomp-args (cdr (cdr bytecomp-args)))) + (byte-compile-variable-set (car args)) + (setq args (cdr (cdr args)))) ;; (setq), with no arguments. (byte-compile-form nil byte-compile--for-effect)) (setq byte-compile--for-effect nil))) @@ -3653,14 +3625,14 @@ discarding." ;;; control structures -(defun byte-compile-body (bytecomp-body &optional for-effect) - (while (cdr bytecomp-body) - (byte-compile-form (car bytecomp-body) t) - (setq bytecomp-body (cdr bytecomp-body))) - (byte-compile-form (car bytecomp-body) for-effect)) +(defun byte-compile-body (body &optional for-effect) + (while (cdr body) + (byte-compile-form (car body) t) + (setq body (cdr body))) + (byte-compile-form (car body) for-effect)) -(defsubst byte-compile-body-do-effect (bytecomp-body) - (byte-compile-body bytecomp-body byte-compile--for-effect) +(defsubst byte-compile-body-do-effect (body) + (byte-compile-body body byte-compile--for-effect) (setq byte-compile--for-effect nil)) (defsubst byte-compile-form-do-effect (form) @@ -3818,10 +3790,10 @@ that suppresses all warnings during execution of BODY." (defun byte-compile-and (form) (let ((failtag (byte-compile-make-tag)) - (bytecomp-args (cdr form))) - (if (null bytecomp-args) + (args (cdr form))) + (if (null args) (byte-compile-form-do-effect t) - (byte-compile-and-recursion bytecomp-args failtag)))) + (byte-compile-and-recursion args failtag)))) ;; Handle compilation of a nontrivial `and' call. ;; We use tail recursion so we can use byte-compile-maybe-guarded. @@ -3837,10 +3809,10 @@ that suppresses all warnings during execution of BODY." (defun byte-compile-or (form) (let ((wintag (byte-compile-make-tag)) - (bytecomp-args (cdr form))) - (if (null bytecomp-args) + (args (cdr form))) + (if (null args) (byte-compile-form-do-effect nil) - (byte-compile-or-recursion bytecomp-args wintag)))) + (byte-compile-or-recursion args wintag)))) ;; Handle compilation of a nontrivial `or' call. ;; We use tail recursion so we can use byte-compile-maybe-guarded. @@ -4554,57 +4526,54 @@ already up-to-date." (defvar command-line-args-left) ;Avoid 'free variable' warning (if (not noninteractive) (error "`batch-byte-compile' is to be used only with -batch")) - (let ((bytecomp-error nil)) + (let ((error nil)) (while command-line-args-left (if (file-directory-p (expand-file-name (car command-line-args-left))) ;; Directory as argument. - (let ((bytecomp-files (directory-files (car command-line-args-left))) - bytecomp-source bytecomp-dest) - (dolist (bytecomp-file bytecomp-files) - (if (and (string-match emacs-lisp-file-regexp bytecomp-file) - (not (auto-save-file-name-p bytecomp-file)) - (setq bytecomp-source - (expand-file-name bytecomp-file + (let (source dest) + (dolist (file (directory-files (car command-line-args-left))) + (if (and (string-match emacs-lisp-file-regexp file) + (not (auto-save-file-name-p file)) + (setq source + (expand-file-name file (car command-line-args-left))) - (setq bytecomp-dest (byte-compile-dest-file - bytecomp-source)) - (file-exists-p bytecomp-dest) - (file-newer-than-file-p bytecomp-source bytecomp-dest)) - (if (null (batch-byte-compile-file bytecomp-source)) - (setq bytecomp-error t))))) + (setq dest (byte-compile-dest-file source)) + (file-exists-p dest) + (file-newer-than-file-p source dest)) + (if (null (batch-byte-compile-file source)) + (setq error t))))) ;; Specific file argument (if (or (not noforce) - (let* ((bytecomp-source (car command-line-args-left)) - (bytecomp-dest (byte-compile-dest-file - bytecomp-source))) - (or (not (file-exists-p bytecomp-dest)) - (file-newer-than-file-p bytecomp-source bytecomp-dest)))) + (let* ((source (car command-line-args-left)) + (dest (byte-compile-dest-file source))) + (or (not (file-exists-p dest)) + (file-newer-than-file-p source dest)))) (if (null (batch-byte-compile-file (car command-line-args-left))) - (setq bytecomp-error t)))) + (setq error t)))) (setq command-line-args-left (cdr command-line-args-left))) - (kill-emacs (if bytecomp-error 1 0)))) + (kill-emacs (if error 1 0)))) -(defun batch-byte-compile-file (bytecomp-file) +(defun batch-byte-compile-file (file) (if debug-on-error - (byte-compile-file bytecomp-file) + (byte-compile-file file) (condition-case err - (byte-compile-file bytecomp-file) + (byte-compile-file file) (file-error (message (if (cdr err) ">>Error occurred processing %s: %s (%s)" ">>Error occurred processing %s: %s") - bytecomp-file + file (get (car err) 'error-message) (prin1-to-string (cdr err))) - (let ((bytecomp-destfile (byte-compile-dest-file bytecomp-file))) - (if (file-exists-p bytecomp-destfile) - (delete-file bytecomp-destfile))) + (let ((destfile (byte-compile-dest-file file))) + (if (file-exists-p destfile) + (delete-file destfile))) nil) (error (message (if (cdr err) ">>Error occurred processing %s: %s (%s)" ">>Error occurred processing %s: %s") - bytecomp-file + file (get (car err) 'error-message) (prin1-to-string (cdr err))) nil)))) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 2229be0de58..5d19bf969e6 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -65,8 +65,16 @@ ;; ;;; Code: -;; TODO: +;; TODO: (not just for cconv but also for the lexbind changes in general) +;; - inline lexical byte-code functions. +;; - investigate some old v18 stuff in bytecomp.el. +;; - optimize away unused cl-block-wrapper. +;; - let (e)debug find the value of lexical variables from the stack. ;; - byte-optimize-form should be applied before cconv. +;; OTOH, the warnings emitted by cconv-analyze need to come before optimize +;; since afterwards they can because obnoxious (warnings about an "unused +;; variable" should not be emitted when the variable use has simply been +;; optimized away). ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. ;; - new byte codes for unwind-protect, catch, and condition-case so that @@ -213,7 +221,7 @@ Returns a form where all lambdas don't have any free variables." (if (assq arg new-env) (push `(,arg) new-env)) (push `(,arg . (car ,arg)) new-env) (push `(,arg (list ,arg)) letbind))) - + (setq body-new (mapcar (lambda (form) (cconv-convert form new-env nil)) body)) @@ -255,7 +263,7 @@ places where they originally did not directly appear." (cconv--set-diff (cdr (cddr mapping)) extend))) env)))) - + ;; What's the difference between fvrs and envs? ;; Suppose that we have the code ;; (lambda (..) fvr (let ((fvr 1)) (+ fvr 1))) @@ -377,6 +385,7 @@ places where they originally did not directly appear." ; first element is lambda expression (`(,(and `(lambda . ,_) fun) . ,args) ;; FIXME: it's silly to create a closure just to call it. + ;; Running byte-optimize-form earlier will resolve this. `(funcall ,(cconv-convert `(function ,fun) env extend) ,@(mapcar (lambda (form) @@ -486,9 +495,9 @@ places where they originally did not directly appear." `(interactive . ,(mapcar (lambda (form) (cconv-convert form nil nil)) forms))) - + (`(declare . ,_) form) ;The args don't contain code. - + (`(,func . ,forms) ;; First element is function or whatever function-like forms are: or, and, ;; if, progn, prog1, prog2, while, until @@ -623,7 +632,7 @@ and updates the data stored in ENV." (`(function (lambda ,vrs . ,body-forms)) (cconv--analyse-function vrs body-forms env form)) - + (`(setq . ,forms) ;; If a local variable (member of env) is modified by setq then ;; it is a mutated variable. @@ -646,8 +655,8 @@ and updates the data stored in ENV." (`(condition-case ,var ,protected-form . ,handlers) ;; FIXME: The bytecode for condition-case forces us to wrap the - ;; form and handlers in closures (for handlers, it's probably - ;; unavoidable, but not for the protected form). + ;; form and handlers in closures (for handlers, it's understandable + ;; but not for the protected form). (cconv--analyse-function () (list protected-form) env form) (dolist (handler handlers) (cconv--analyse-function (if var (list var)) (cdr handler) env form))) @@ -657,8 +666,8 @@ and updates the data stored in ENV." (cconv-analyse-form form env) (cconv--analyse-function () body env form)) - ;; FIXME: The bytecode for save-window-excursion and the lack of - ;; bytecode for track-mouse forces us to wrap the body. + ;; FIXME: The lack of bytecode for track-mouse forces us to wrap the body. + ;; `track-mouse' really should be made into a macro. (`(track-mouse . ,body) (cconv--analyse-function () body env form)) @@ -686,7 +695,7 @@ and updates the data stored in ENV." (dolist (form forms) (cconv-analyse-form form nil))) (`(declare . ,_) nil) ;The args don't contain code. - + (`(,_ . ,body-forms) ; First element is a function or whatever. (dolist (form body-forms) (cconv-analyse-form form env))) diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 2795b143e47..3a6878ed16b 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -282,7 +282,7 @@ Not documented ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* -;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "864a28dc0495ad87d39637a965387526") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "80cb83265399ce021c8c0c7d1a8562f2") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 851355e2c75..785a45d9640 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -497,7 +497,7 @@ The result of the body appears to the compiler as a quoted constant." (symbol-function 'byte-compile-file-form))) (list 'byte-compile-file-form (list 'quote set)) '(byte-compile-file-form form))) - (print set (symbol-value 'bytecomp-outbuffer))) + (print set (symbol-value 'byte-compile-outbuffer))) (list 'symbol-value (list 'quote temp))) (list 'quote (eval form)))) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index d303dab4ad3..9c626dfcfa3 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -278,9 +278,9 @@ definitions to shadow the loaded ones for use in file byte-compilation. (defvar cl-compiling-file nil) (defun cl-compiling-file () (or cl-compiling-file - (and (boundp 'bytecomp-outbuffer) - (bufferp (symbol-value 'bytecomp-outbuffer)) - (equal (buffer-name (symbol-value 'bytecomp-outbuffer)) + (and (boundp 'byte-compile-outbuffer) + (bufferp (symbol-value 'byte-compile-outbuffer)) + (equal (buffer-name (symbol-value 'byte-compile-outbuffer)) " *Compiler Output*")))) (defvar cl-proclaims-deferred nil) diff --git a/lisp/emacs-lisp/pcase.el b/lisp/emacs-lisp/pcase.el index e95bcac2a70..e6c4ccbbc50 100644 --- a/lisp/emacs-lisp/pcase.el +++ b/lisp/emacs-lisp/pcase.el @@ -27,16 +27,21 @@ ;; Todo: +;; - (pcase e (`(,x . ,x) foo)) signals an "x unused" warning if `foo' doesn't +;; use x, because x is bound separately for the equality constraint +;; (as well as any pred/guard) and for the body, so uses at one place don't +;; count for the other. ;; - provide ways to extend the set of primitives, with some kind of ;; define-pcase-matcher. We could easily make it so that (guard BOOLEXP) ;; could be defined this way, as a shorthand for (pred (lambda (_) BOOLEXP)). ;; But better would be if we could define new ways to match by having the ;; extension provide its own `pcase--split-' thingy. +;; - along these lines, provide patterns to match CL structs. ;; - provide something like (setq VAR) so a var can be set rather than ;; let-bound. -;; - provide a way to fallthrough to other cases. +;; - provide a way to fallthrough to subsequent cases. ;; - try and be more clever to reduce the size of the decision tree, and -;; to reduce the number of leafs that need to be turned into function: +;; to reduce the number of leaves that need to be turned into function: ;; - first, do the tests shared by all remaining branches (it will have ;; to be performed anyway, so better so it first so it's shared). ;; - then choose the test that discriminates more (?). @@ -67,6 +72,7 @@ UPatterns can take the following forms: `QPAT matches if the QPattern QPAT matches. (pred PRED) matches if PRED applied to the object returns non-nil. (guard BOOLEXP) matches if BOOLEXP evaluates to non-nil. + (let UPAT EXP) matches if EXP matches UPAT. If a SYMBOL is used twice in the same pattern (i.e. the pattern is \"non-linear\"), then the second occurrence is turned into an `eq'uality test. @@ -297,15 +303,21 @@ MATCH is the pattern that needs to be matched, of the form: (symbolp . consp) (symbolp . arrayp) (symbolp . stringp) + (symbolp . byte-code-function-p) (integerp . consp) (integerp . arrayp) (integerp . stringp) + (integerp . byte-code-function-p) (numberp . consp) (numberp . arrayp) (numberp . stringp) + (numberp . byte-code-function-p) (consp . arrayp) (consp . stringp) - (arrayp . stringp))) + (consp . byte-code-function-p) + (arrayp . stringp) + (arrayp . byte-code-function-p) + (stringp . byte-code-function-p))) (defun pcase--split-match (sym splitter match) (cond @@ -514,11 +526,10 @@ Otherwise, it defers to REST which is a list of branches of the form (cond ((memq upat '(t _)) (pcase--u1 matches code vars rest)) ((eq upat 'dontcare) :pcase--dontcare) - ((functionp upat) (error "Feature removed, use (pred %s)" upat)) ((memq (car-safe upat) '(guard pred)) (if (eq (car upat) 'pred) (put sym 'pcase-used t)) (let* ((splitrest - (pcase--split-rest + (pcase--split-rest sym (apply-partially #'pcase--split-pred upat) rest)) (then-rest (car splitrest)) (else-rest (cdr splitrest))) @@ -527,21 +538,24 @@ Otherwise, it defers to REST which is a list of branches of the form (let* ((exp (cadr upat)) ;; `vs' is an upper bound on the vars we need. (vs (pcase--fgrep (mapcar #'car vars) exp)) - (call (cond - ((eq 'guard (car upat)) exp) - ((functionp exp) `(,exp ,sym)) - (t `(,@exp ,sym))))) + (env (mapcar (lambda (var) + (list var (cdr (assq var vars)))) + vs)) + (call (if (eq 'guard (car upat)) + exp + (when (memq sym vs) + ;; `sym' is shadowed by `env'. + (let ((newsym (make-symbol "x"))) + (push (list newsym sym) env) + (setq sym newsym))) + (if (functionp exp) `(,exp ,sym) + `(,@exp ,sym))))) (if (null vs) call ;; Let's not replace `vars' in `exp' since it's ;; too difficult to do it right, instead just ;; let-bind `vars' around `exp'. - `(let ,(mapcar (lambda (var) - (list var (cdr (assq var vars)))) - vs) - ;; FIXME: `vars' can capture `sym'. E.g. - ;; (pcase x ((and `(,x . ,y) (pred (fun x))))) - ,call)))) + `(let* ,env ,call)))) (pcase--u1 matches code vars then-rest) (pcase--u else-rest)))) ((symbolp upat) @@ -552,6 +566,25 @@ Otherwise, it defers to REST which is a list of branches of the form (pcase--u1 (cons `(match ,sym . (pred (eq ,(cdr (assq upat vars))))) matches) code vars rest))) + ((eq (car-safe upat) 'let) + ;; A upat of the form (let VAR EXP). + ;; (pcase--u1 matches code + ;; (cons (cons (nth 1 upat) (nth 2 upat)) vars) rest) + (let* ((exp + (let* ((exp (nth 2 upat)) + (found (assq exp vars))) + (if found (cdr found) + (let* ((vs (pcase--fgrep (mapcar #'car vars) exp)) + (env (mapcar (lambda (v) (list v (cdr (assq v vars)))) + vs))) + (if env `(let* ,env ,exp) exp))))) + (sym (if (symbolp exp) exp (make-symbol "x"))) + (body + (pcase--u1 (cons `(match ,sym . ,(nth 1 upat)) matches) + code vars rest))) + (if (eq sym exp) + body + `(let* ((,sym ,exp)) ,body)))) ((eq (car-safe upat) '\`) (put sym 'pcase-used t) (pcase--q1 sym (cadr upat) matches code vars rest)) diff --git a/lisp/startup.el b/lisp/startup.el index 384d81391ab..4dbf41d3ac6 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -2082,6 +2082,7 @@ A fancy display is used on graphic displays, normal otherwise." ;; Note that any local variables in this function affect the ;; ability of -f batch-byte-compile to detect free variables. ;; So we give some of them with common names a cl1- prefix. + ;; FIXME: A better fix would be to make this file use lexical-binding. (let ((cl1-dir command-line-default-directory) cl1-tem ;; This approach loses for "-batch -L DIR --eval "(require foo)", diff --git a/lisp/subr.el b/lisp/subr.el index 3a32a2f6558..45cfb56bdc1 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -187,10 +187,13 @@ Then evaluate RESULT to get return value, default nil. ;; It would be cleaner to create an uninterned symbol, ;; but that uses a lot more space when many functions in many files ;; use dolist. + ;; FIXME: This cost disappears in byte-compiled lexical-binding files. (let ((temp '--dolist-tail--)) `(let ((,temp ,(nth 1 spec)) ,(car spec)) (while ,temp + ;; FIXME: In lexical-binding code, a `let' inside the loop might + ;; turn out to be faster than the an outside `let' this `setq'. (setq ,(car spec) (car ,temp)) ,@body (setq ,temp (cdr ,temp))) diff --git a/src/ChangeLog b/src/ChangeLog index 00d8e4b8ee3..e34cd694321 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-03-16 Stefan Monnier + + * image.c (parse_image_spec): Use Ffunctionp. + * lisp.h: Declare Ffunctionp. + 2011-03-13 Stefan Monnier * eval.c (Ffunction): Use simpler format for closures. diff --git a/src/bytecode.c b/src/bytecode.c index b19f9687cdc..ba3c012bd1a 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -939,27 +939,27 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, save_restriction_save ()); break; - case Bcatch: + case Bcatch: /* FIXME: ill-suited for lexbind */ { Lisp_Object v1; BEFORE_POTENTIAL_GC (); v1 = POP; - TOP = internal_catch (TOP, eval_sub, v1); /* FIXME: lexbind */ + TOP = internal_catch (TOP, eval_sub, v1); AFTER_POTENTIAL_GC (); break; } - case Bunwind_protect: - record_unwind_protect (Fprogn, POP); /* FIXME: lexbind */ + case Bunwind_protect: /* FIXME: avoid closure for lexbind */ + record_unwind_protect (Fprogn, POP); break; - case Bcondition_case: + case Bcondition_case: /* FIXME: ill-suited for lexbind */ { Lisp_Object handlers, body; handlers = POP; body = POP; BEFORE_POTENTIAL_GC (); - TOP = internal_lisp_condition_case (TOP, body, handlers); /* FIXME: lexbind */ + TOP = internal_lisp_condition_case (TOP, body, handlers); AFTER_POTENTIAL_GC (); break; } diff --git a/src/image.c b/src/image.c index a7c6346f62c..73a45633f3b 100644 --- a/src/image.c +++ b/src/image.c @@ -835,10 +835,7 @@ parse_image_spec (Lisp_Object spec, struct image_keyword *keywords, case IMAGE_FUNCTION_VALUE: value = indirect_function (value); - /* FIXME: Shouldn't we use Ffunctionp here? */ - if (SUBRP (value) - || COMPILEDP (value) - || (CONSP (value) && EQ (XCAR (value), Qlambda))) + if (!NILP (Ffunctionp (value))) break; return 0; diff --git a/src/lisp.h b/src/lisp.h index ece96428253..e4788e63f5b 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -2864,6 +2864,7 @@ extern void xsignal2 (Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN; extern void xsignal3 (Lisp_Object, Lisp_Object, Lisp_Object, Lisp_Object) NO_RETURN; extern void signal_error (const char *, Lisp_Object) NO_RETURN; EXFUN (Fcommandp, 2); +EXFUN (Ffunctionp, 1); EXFUN (Feval, 2); extern Lisp_Object eval_sub (Lisp_Object form); EXFUN (Fapply, MANY); From 414dbb000dcd62c4f252b5f73f9847340de40396 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 18 Mar 2011 20:21:27 -0400 Subject: [PATCH 35/45] * lisp/emacs-lisp/cl-macs.el (cl-byte-compile-block, cl-block-wrapper) (cl-block-throw, cl-byte-compile-throw): Use a compiler-macro rather than a `byte-compile' hook to optimize away unused CL blocks, so that also works for lexbind code. Move the code after define-compiler-macro. --- lisp/ChangeLog | 8 ++++++ lisp/emacs-lisp/cl-macs.el | 54 +++++++++++++++++--------------------- 2 files changed, 32 insertions(+), 30 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8d5e2418341..7f131f97179 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,11 @@ +2011-03-19 Stefan Monnier + + * emacs-lisp/cl-macs.el (cl-byte-compile-block, cl-block-wrapper) + (cl-block-throw, cl-byte-compile-throw): Use a compiler-macro rather + than a `byte-compile' hook to optimize away unused CL blocks, so that + also works for lexbind code. + Move the code after define-compiler-macro. + 2011-03-16 Stefan Monnier * emacs-lisp/pcase.el (pcase-mutually-exclusive-predicates): diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 785a45d9640..d4279a1b200 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -598,33 +598,6 @@ called from BODY." (list* 'catch (list 'quote (intern (format "--cl-block-%s--" name))) body)))) -(defvar cl-active-block-names nil) - -(put 'cl-block-wrapper 'byte-compile 'cl-byte-compile-block) -(defun cl-byte-compile-block (cl-form) - ;; Here we try to determine if a catch tag is used or not, so as to get rid - ;; of the catch when it's not used. - (if (and (fboundp 'byte-compile-form-do-effect) ; Optimizing compiler? - ;; FIXME: byte-compile-top-level can only be used for code that is - ;; closed (as the name implies), so for lexical scoping we should - ;; implement this optimization differently. - (not lexical-binding)) - (progn - (let* ((cl-entry (cons (nth 1 (nth 1 (nth 1 cl-form))) nil)) - (cl-active-block-names (cons cl-entry cl-active-block-names)) - (cl-body (byte-compile-top-level - (cons 'progn (cddr (nth 1 cl-form)))))) - (if (cdr cl-entry) - (byte-compile-form (list 'catch (nth 1 (nth 1 cl-form)) cl-body)) - (byte-compile-form cl-body)))) - (byte-compile-form (nth 1 cl-form)))) - -(put 'cl-block-throw 'byte-compile 'cl-byte-compile-throw) -(defun cl-byte-compile-throw (cl-form) - (let ((cl-found (assq (nth 1 (nth 1 cl-form)) cl-active-block-names))) - (if cl-found (setcdr cl-found t))) - (byte-compile-normal-call (cons 'throw (cdr cl-form)))) - ;;;###autoload (defmacro return (&optional result) "Return from the block named nil. @@ -1433,7 +1406,7 @@ by EXPANSION, and (setq NAME ...) will act like (setf EXPANSION ...). "Like `let', but lexically scoped. The main visible difference is that lambdas inside BODY will create lexical closures as in Common Lisp. -\n(fn VARLIST BODY)" +\n(fn BINDINGS BODY)" (let* ((cl-closure-vars cl-closure-vars) (vars (mapcar (function (lambda (x) @@ -1476,10 +1449,10 @@ lexical closures as in Common Lisp. (defmacro lexical-let* (bindings &rest body) "Like `let*', but lexically scoped. The main visible difference is that lambdas inside BODY, and in -successive bindings within VARLIST, will create lexical closures +successive bindings within BINDINGS, will create lexical closures as in Common Lisp. This is similar to the behavior of `let*' in Common Lisp. -\n(fn VARLIST BODY)" +\n(fn BINDINGS BODY)" (if (null bindings) (cons 'progn body) (setq bindings (reverse bindings)) (while bindings @@ -2626,6 +2599,27 @@ and then returning foo." (byte-compile-normal-call form) (byte-compile-form form))) +;; Optimize away unused block-wrappers. + +(defvar cl-active-block-names nil) + +(define-compiler-macro cl-block-wrapper (cl-form) + (let* ((cl-entry (cons (nth 1 (nth 1 cl-form)) nil)) + (cl-active-block-names (cons cl-entry cl-active-block-names)) + (cl-body (macroexpand-all ;Performs compiler-macro expansions. + (cons 'progn (cddr cl-form)) + macroexpand-all-environment))) + ;; FIXME: To avoid re-applying macroexpand-all, we'd like to be able + ;; to indicate that this return value is already fully expanded. + (if (cdr cl-entry) + `(catch (nth 1 cl-form) ,@(cdr cl-body)) + cl-body))) + +(define-compiler-macro cl-block-throw (cl-tag cl-value) + (let ((cl-found (assq (nth 1 cl-tag) cl-active-block-names))) + (if cl-found (setcdr cl-found t))) + `(throw ,cl-tag ,cl-value)) + ;;;###autoload (defmacro defsubst* (name args &rest body) "Define NAME as a function. From bf02cb227d98626c3dff61c69fa8b4ce523d71bd Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 19 Mar 2011 23:53:45 -0400 Subject: [PATCH 36/45] * lisp/emacs-lisp/debug.el (debugger-setup-buffer): Revert local change to print depth and length. --- lisp/ChangeLog | 5 +++++ lisp/emacs-lisp/debug.el | 6 ++---- 2 files changed, 7 insertions(+), 4 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 7f131f97179..8a0f8084c53 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-03-20 Stefan Monnier + + * emacs-lisp/debug.el (debugger-setup-buffer): Revert local change to + print depth and length. + 2011-03-19 Stefan Monnier * emacs-lisp/cl-macs.el (cl-byte-compile-block, cl-block-wrapper) diff --git a/lisp/emacs-lisp/debug.el b/lisp/emacs-lisp/debug.el index 0bdab919434..88633eaaa46 100644 --- a/lisp/emacs-lisp/debug.el +++ b/lisp/emacs-lisp/debug.el @@ -269,10 +269,8 @@ That buffer should be current already." (setq buffer-undo-list t) (let ((standard-output (current-buffer)) (print-escape-newlines t) - (print-quoted t) ;Doesn't seem to work :-( - (print-level 1000) ;8 - ;; (print-length 50) - ) + (print-level 8) + (print-length 50)) (backtrace)) (goto-char (point-min)) (delete-region (point) From a08a25d7aaf251aa18f2ef747be53734bc55cae9 Mon Sep 17 00:00:00 2001 From: Christian Ohler Date: Sun, 20 Mar 2011 20:48:12 +1100 Subject: [PATCH 37/45] * emacs-lisp/cl-macs.el (cl-block-wrapper): Fix typo that broke CL blocks. --- lisp/ChangeLog | 5 +++++ lisp/emacs-lisp/cl-macs.el | 2 +- 2 files changed, 6 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 8a0f8084c53..ea512d99559 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,8 @@ +2011-03-20 Christian Ohler + + * emacs-lisp/cl-macs.el (cl-block-wrapper): Fix typo that broke CL + blocks. + 2011-03-20 Stefan Monnier * emacs-lisp/debug.el (debugger-setup-buffer): Revert local change to diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index d4279a1b200..7aac5bdaa01 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -2612,7 +2612,7 @@ and then returning foo." ;; FIXME: To avoid re-applying macroexpand-all, we'd like to be able ;; to indicate that this return value is already fully expanded. (if (cdr cl-entry) - `(catch (nth 1 cl-form) ,@(cdr cl-body)) + `(catch ,(nth 1 cl-form) ,@(cdr cl-body)) cl-body))) (define-compiler-macro cl-block-throw (cl-tag cl-value) From 29a4dcb06d4bd78db96d6305f7434ce464aff8a4 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 22 Mar 2011 20:53:36 -0400 Subject: [PATCH 38/45] Clean up left over Emacs-18/19 code, inline byte-code-functions. * lisp/emacs-lisp/byte-opt.el (byte-inline-lapcode): Move to bytecomp.el. (byte-compile-inline-expand): Inline all bytecompiled functions. Unify the inlining code of the lexbind and dynbind interpreted functions. (byte-compile-unfold-lambda): Don't handle byte-compiled functions at all. (byte-optimize-form-code-walker): Don't optimize byte-compiled inlined functions here. (byte-compile-splice-in-already-compiled-code): Remove. (byte-code): Don't optimize it any more. (byte-decompile-bytecode-1): Remove unused bytedecomp-bytes. Leave `byte-return's even for `make-spliceable'. * lisp/emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble): byte-compile-lambda now always returns a byte-code-function. (byte-compile-byte-code-maker, byte-compile-byte-code-unmake) (byte-compile-closure): Remove. (byte-compile-lambda): Always return a byte-code-function. (byte-compile-top-level): Don't handle `byte-code' forms specially. (byte-compile-inline-lapcode): New function, taken from byte-opt.el. (byte-compile-unfold-bcf): New function. (byte-compile-form): Use it to optimize inline byte-code-functions. (byte-compile-function-form, byte-compile-defun): Simplify. (byte-compile-defmacro): Don't bother calling byte-compile-byte-code-maker. --- lisp/ChangeLog | 27 ++++ lisp/emacs-lisp/byte-opt.el | 142 ++++++------------ lisp/emacs-lisp/bytecomp.el | 278 +++++++++++++++++------------------- lisp/emacs-lisp/cconv.el | 5 +- 4 files changed, 207 insertions(+), 245 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ea512d99559..d9c1e5a34da 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,30 @@ +2011-03-23 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble): + byte-compile-lambda now always returns a byte-code-function. + (byte-compile-byte-code-maker, byte-compile-byte-code-unmake) + (byte-compile-closure): Remove. + (byte-compile-lambda): Always return a byte-code-function. + (byte-compile-top-level): Don't handle `byte-code' forms specially. + (byte-compile-inline-lapcode): New function, taken from byte-opt.el. + (byte-compile-unfold-bcf): New function. + (byte-compile-form): Use it to optimize inline byte-code-functions. + (byte-compile-function-form, byte-compile-defun): Simplify. + (byte-compile-defmacro): Don't bother calling + byte-compile-byte-code-maker. + * emacs-lisp/byte-opt.el (byte-inline-lapcode): Move to bytecomp.el. + (byte-compile-inline-expand): Inline all bytecompiled functions. + Unify the inlining code of the lexbind and dynbind interpreted + functions. + (byte-compile-unfold-lambda): Don't handle byte-compiled functions + at all. + (byte-optimize-form-code-walker): Don't optimize byte-compiled inlined + functions here. + (byte-compile-splice-in-already-compiled-code): Remove. + (byte-code): Don't optimize it any more. + (byte-decompile-bytecode-1): Remove unused bytedecomp-bytes. + Leave `byte-return's even for `make-spliceable'. + 2011-03-20 Christian Ohler * emacs-lisp/cl-macs.el (cl-block-wrapper): Fix typo that broke CL diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 6a04dfb2507..35c9a5ddf45 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -244,25 +244,6 @@ sexp))) (cdr form)))) - -;; Splice the given lap code into the current instruction stream. -;; If it has any labels in it, you're responsible for making sure there -;; are no collisions, and that byte-compile-tag-number is reasonable -;; after this is spliced in. The provided list is destroyed. -(defun byte-inline-lapcode (lap) - ;; "Replay" the operations: we used to just do - ;; (setq byte-compile-output (nconc (nreverse lap) byte-compile-output)) - ;; but that fails to update byte-compile-depth, so we had to assume - ;; that `lap' ends up adding exactly 1 element to the stack. This - ;; happens to be true for byte-code generated by bytecomp.el without - ;; lexical-binding, but it's not true in general, and it's not true for - ;; code output by bytecomp.el with lexical-binding. - (dolist (op lap) - (cond - ((eq (car op) 'TAG) (byte-compile-out-tag op)) - ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op))) - (t (byte-compile-out (car op) (cdr op)))))) - (defun byte-compile-inline-expand (form) (let* ((name (car form)) (localfn (cdr (assq name byte-compile-function-environment))) @@ -280,54 +261,42 @@ (error "File `%s' didn't define `%s'" (nth 1 fn) name)) ((and (pred symbolp) (guard (not (eq fn t)))) ;A function alias. (byte-compile-inline-expand (cons fn (cdr form)))) - ((and (pred byte-code-function-p) - ;; FIXME: This only works to inline old-style-byte-codes into - ;; old-style-byte-codes. - (guard (not (or lexical-binding - (integerp (aref fn 0)))))) - ;; (message "Inlining %S byte-code" name) - (fetch-bytecode fn) - (let ((string (aref fn 1))) - (assert (not (multibyte-string-p string))) - ;; `byte-compile-splice-in-already-compiled-code' - ;; takes care of inlining the body. - (cons `(lambda ,(aref fn 0) - (byte-code ,string ,(aref fn 2) ,(aref fn 3))) - (cdr form)))) - ((and `(lambda . ,_) - ;; With lexical-binding we have several problems: - ;; - if `fn' comes from byte-compile-function-environment, we - ;; need to preprocess `fn', so we handle it below. - ;; - else, it means that `fn' is dyn-bound (otherwise it would - ;; start with `closure') so copying the code here would cause - ;; it to be mis-interpreted. - (guard (not lexical-binding))) - (macroexpand-all (cons fn (cdr form)) - byte-compile-macro-environment)) - ((and (or (and `(lambda ,args . ,body) - (let env nil) - (guard (eq fn localfn))) - `(closure ,env ,args . ,body)) - (guard lexical-binding)) - (let ((renv ())) - (dolist (binding env) - (cond - ((consp binding) - ;; We check shadowing by the args, so that the `let' can be - ;; moved within the lambda, which can then be unfolded. - ;; FIXME: Some of those bindings might be unused in `body'. - (unless (memq (car binding) args) ;Shadowed. - (push `(,(car binding) ',(cdr binding)) renv))) - ((eq binding t)) - (t (push `(defvar ,binding) body)))) - ;; (message "Inlining closure %S" (car form)) - (let ((newfn (byte-compile-preprocess - `(lambda ,args (let ,(nreverse renv) ,@body))))) - (if (eq (car-safe newfn) 'function) - (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) - (byte-compile-log-warning - (format "Inlining closure %S failed" name)) - form)))) + ((pred byte-code-function-p) + ;; (message "Inlining byte-code for %S!" name) + ;; The byte-code will be really inlined in byte-compile-unfold-bcf. + `(,fn ,@(cdr form))) + ((or (and `(lambda ,args . ,body) (let env nil)) + `(closure ,env ,args . ,body)) + (if (not (or (eq fn localfn) ;From the same file => same mode. + (eq (not lexical-binding) (not env)))) ;Same mode. + ;; While byte-compile-unfold-bcf can inline dynbind byte-code into + ;; letbind byte-code (or any other combination for that matter), we + ;; can only inline dynbind source into dynbind source or letbind + ;; source into letbind source. + ;; FIXME: we could of course byte-compile the inlined function + ;; first, and then inline its byte-code. + form + (let ((renv ())) + ;; Turn the function's closed vars (if any) into local let bindings. + (dolist (binding env) + (cond + ((consp binding) + ;; We check shadowing by the args, so that the `let' can be + ;; moved within the lambda, which can then be unfolded. + ;; FIXME: Some of those bindings might be unused in `body'. + (unless (memq (car binding) args) ;Shadowed. + (push `(,(car binding) ',(cdr binding)) renv))) + ((eq binding t)) + (t (push `(defvar ,binding) body)))) + (let ((newfn (byte-compile-preprocess + (if (null renv) + `(lambda ,args ,@body) + `(lambda ,args (let ,(nreverse renv) ,@body)))))) + (if (eq (car-safe newfn) 'function) + (byte-compile-unfold-lambda `(,(cadr newfn) ,@(cdr form))) + (byte-compile-log-warning + (format "Inlining closure %S failed" name)) + form))))) (t ;; Give up on inlining. form)))) @@ -341,10 +310,6 @@ (or name (setq name "anonymous lambda")) (let ((lambda (car form)) (values (cdr form))) - (if (byte-code-function-p lambda) - (setq lambda (list 'lambda (aref lambda 0) - (list 'byte-code (aref lambda 1) - (aref lambda 2) (aref lambda 3))))) (let ((arglist (nth 1 lambda)) (body (cdr (cdr lambda))) optionalp restp @@ -353,6 +318,7 @@ (setq body (cdr body))) (if (and (consp (car body)) (eq 'interactive (car (car body)))) (setq body (cdr body))) + ;; FIXME: The checks below do not belong in an optimization phase. (while arglist (cond ((eq (car arglist) '&optional) ;; ok, I'll let this slide because funcall_lambda() does... @@ -430,8 +396,7 @@ (and (nth 1 form) (not for-effect) form)) - ((or (byte-code-function-p fn) - (eq 'lambda (car-safe fn))) + ((eq 'lambda (car-safe fn)) (let ((newform (byte-compile-unfold-lambda form))) (if (eq newform form) ;; Some error occurred, avoid infinite recursion @@ -564,7 +529,10 @@ ;; Neeeded as long as we run byte-optimize-form after cconv. ((eq fn 'internal-make-closure) form) - + + ((byte-code-function-p fn) + (cons fn (mapcar #'byte-optimize-form (cdr form)))) + ((not (symbolp fn)) (debug) (byte-compile-warn "`%s' is a malformed function" @@ -1328,16 +1296,6 @@ (put (car pure-fns) 'pure t) (setq pure-fns (cdr pure-fns))) nil) - -(defun byte-compile-splice-in-already-compiled-code (form) - ;; form is (byte-code "..." [...] n) - (if (not (memq byte-optimize '(t lap))) - (byte-compile-normal-call form) - (byte-inline-lapcode - (byte-decompile-bytecode-1 (nth 1 form) (nth 2 form) t)))) - -(put 'byte-code 'byte-compile 'byte-compile-splice-in-already-compiled-code) - (defconst byte-constref-ops '(byte-constant byte-constant2 byte-varref byte-varset byte-varbind)) @@ -1405,18 +1363,17 @@ ;; In that case, we put a pc value into the list ;; before each insn (or its label). (defun byte-decompile-bytecode-1 (bytes constvec &optional make-spliceable) - (let ((bytedecomp-bytes bytes) - (length (length bytes)) + (let ((length (length bytes)) (bytedecomp-ptr 0) optr tags bytedecomp-op offset lap tmp endtag) (while (not (= bytedecomp-ptr length)) (or make-spliceable (push bytedecomp-ptr lap)) - (setq bytedecomp-op (aref bytedecomp-bytes bytedecomp-ptr) + (setq bytedecomp-op (aref bytes bytedecomp-ptr) optr bytedecomp-ptr ;; This uses dynamic-scope magic. - offset (disassemble-offset bytedecomp-bytes)) + offset (disassemble-offset bytes)) (setq bytedecomp-op (aref byte-code-vector bytedecomp-op)) (cond ((memq bytedecomp-op byte-goto-ops) ;; It's a pc. @@ -1437,12 +1394,6 @@ (let ((new (list tmp))) (push new byte-compile-variables) new))))) - ((and make-spliceable - (eq bytedecomp-op 'byte-return)) - (if (= bytedecomp-ptr (1- length)) - (setq bytedecomp-op nil) - (setq offset (or endtag (setq endtag (byte-compile-make-tag))) - bytedecomp-op 'byte-goto))) ((eq bytedecomp-op 'byte-stack-set2) (setq bytedecomp-op 'byte-stack-set)) ((and (eq bytedecomp-op 'byte-discardN) (>= offset #x80)) @@ -1467,9 +1418,6 @@ (setq rest (cdr rest)))) (setq rest (cdr rest)))) (if tags (error "optimizer error: missed tags %s" tags)) - ;; Take off the dummy nil op that we replaced a trailing "return" with. - (if (null (car (cdr (car lap)))) - (setq lap (cdr lap))) (if endtag (setq lap (cons (cons nil endtag) lap))) ;; Remove addrs, lap = ( [ (op . arg) | (TAG tagno) ]* ) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5a87f590020..5e671d7e694 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2390,15 +2390,15 @@ by side-effects." (not (assq (nth 1 form) byte-compile-initial-macro-environment))) (byte-compile-warn - "`%s' defined multiple times, as both function and macro" - (nth 1 form))) + "`%s' defined multiple times, as both function and macro" + (nth 1 form))) (setcdr that-one nil)) (this-one (when (and (byte-compile-warning-enabled-p 'redefine) - ;; hack: don't warn when compiling the magic internal - ;; byte-compiler macros in byte-run.el... - (not (assq (nth 1 form) - byte-compile-initial-macro-environment))) + ;; hack: don't warn when compiling the magic internal + ;; byte-compiler macros in byte-run.el... + (not (assq (nth 1 form) + byte-compile-initial-macro-environment))) (byte-compile-warn "%s `%s' defined multiple times in this file" (if macrop "macro" "function") (nth 1 form)))) @@ -2430,52 +2430,36 @@ by side-effects." (dolist (decl (byte-compile-defmacro-declaration form)) (prin1 decl byte-compile-outbuffer))) - (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t)) - (code (byte-compile-byte-code-maker new-one))) + (let* ((code (byte-compile-lambda (nthcdr 2 form) t))) (if this-one - (setcdr this-one new-one) + (setcdr this-one code) (set this-kind - (cons (cons name new-one) + (cons (cons name code) (symbol-value this-kind)))) - (if (and (stringp (nth 3 form)) - (eq 'quote (car-safe code)) - (eq 'lambda (car-safe (nth 1 code)))) - (cons (car form) - (cons name (cdr (nth 1 code)))) - (byte-compile-flush-pending) - (if (not (stringp (nth 3 form))) - ;; No doc string. Provide -1 as the "doc string index" - ;; so that no element will be treated as a doc string. - (byte-compile-output-docform - "\n(defalias '" - name - (cond ((atom code) - (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]"))) - ((eq (car code) 'quote) - (setq code new-one) - (if macrop '(" '(macro " -1 ")") '(" '(" -1 ")"))) - ((if macrop '(" (cons 'macro (" -1 "))") '(" (" -1 ")")))) - (append code nil) - (and (atom code) byte-compile-dynamic - 1) - nil) - ;; Output the form by hand, that's much simpler than having - ;; b-c-output-file-form analyze the defalias. - (byte-compile-output-docform - "\n(defalias '" - name - (cond ((atom code) - (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]"))) - ((eq (car code) 'quote) - (setq code new-one) - (if macrop '(" '(macro " 2 ")") '(" '(" 2 ")"))) - ((if macrop '(" (cons 'macro (" 5 "))") '(" (" 5 ")")))) - (append code nil) - (and (atom code) byte-compile-dynamic - 1) - nil)) - (princ ")" byte-compile-outbuffer) - nil)))) + (byte-compile-flush-pending) + (if (not (stringp (nth 3 form))) + ;; No doc string. Provide -1 as the "doc string index" + ;; so that no element will be treated as a doc string. + (byte-compile-output-docform + "\n(defalias '" + name + (if macrop '(" '(macro . #[" -1 "])") '(" #[" -1 "]")) + (append code nil) ; Turn byte-code-function-p into list. + (and (atom code) byte-compile-dynamic + 1) + nil) + ;; Output the form by hand, that's much simpler than having + ;; b-c-output-file-form analyze the defalias. + (byte-compile-output-docform + "\n(defalias '" + name + (if macrop '(" '(macro . #[" 4 "])") '(" #[" 4 "]")) + (append code nil) ; Turn byte-code-function-p into list. + (and (atom code) byte-compile-dynamic + 1) + nil)) + (princ ")" byte-compile-outbuffer) + nil))) ;; Print Lisp object EXP in the output file, inside a comment, ;; and return the file position it will have. @@ -2547,56 +2531,6 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-close-variables (byte-compile-top-level (byte-compile-preprocess sexp))))) -;; Given a function made by byte-compile-lambda, make a form which produces it. -(defun byte-compile-byte-code-maker (fun) - (cond - ;; ## atom is faster than compiled-func-p. - ((atom fun) ; compiled function. - ;; generate-emacs19-bytecodes must be on, otherwise byte-compile-lambda - ;; would have produced a lambda. - fun) - ;; b-c-lambda didn't produce a compiled-function, so it's either a trivial - ;; function, or this is Emacs 18, or generate-emacs19-bytecodes is off. - ((let (tmp) - ;; FIXME: can this happen? - (if (and (setq tmp (assq 'byte-code (cdr-safe (cdr fun)))) - (null (cdr (memq tmp fun)))) - ;; Generate a make-byte-code call. - (let* ((interactive (assq 'interactive (cdr (cdr fun))))) - (nconc (list 'make-byte-code - (list 'quote (nth 1 fun)) ;arglist - (nth 1 tmp) ;bytes - (nth 2 tmp) ;consts - (nth 3 tmp)) ;depth - (cond ((stringp (nth 2 fun)) - (list (nth 2 fun))) ;doc - (interactive - (list nil))) - (cond (interactive - (list (if (or (null (nth 1 interactive)) - (stringp (nth 1 interactive))) - (nth 1 interactive) - ;; Interactive spec is a list or a variable - ;; (if it is correct). - (list 'quote (nth 1 interactive)))))))) - ;; a non-compiled function (probably trivial) - (list 'quote fun)))))) - -;; Turn a function into an ordinary lambda. Needed for v18 files. -(defun byte-compile-byte-code-unmake (function) ;FIXME: what is it? - (if (consp function) - function;;It already is a lambda. - (setq function (append function nil)) ; turn it into a list - (nconc (list 'lambda (nth 0 function)) - (and (nth 4 function) (list (nth 4 function))) - (if (nthcdr 5 function) - (list (cons 'interactive (if (nth 5 function) - (nthcdr 5 function))))) - (list (list 'byte-code - (nth 1 function) (nth 2 function) - (nth 3 function)))))) - - (defun byte-compile-check-lambda-list (list) "Check lambda-list LIST for errors." (let (vars) @@ -2745,20 +2679,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; optionally, the interactive spec. (if int (list (nth 1 int))))) - (setq compiled - (nconc (if int (list int)) - (cond ((eq (car-safe compiled) 'progn) (cdr compiled)) - (compiled (list compiled))))) - (nconc (list 'lambda arglist) - (if (or doc (stringp (car compiled))) - (cons doc (cond (compiled) - (body (list nil)))) - compiled)))))) - -(defun byte-compile-closure (form &optional add-lambda) - (let ((code (byte-compile-lambda form add-lambda))) - ;; A simple lambda is just a constant. - (byte-compile-constant code))) + (error "byte-compile-top-level did not return byte-code"))))) (defvar byte-compile-reserved-constants 0) @@ -2818,23 +2739,18 @@ If FORM is a lambda or a macro, byte-compile it as a function." (setq form (byte-optimize-form form byte-compile--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. - (setq byte-compile-depth (length byte-compile-lexical-environment)) - ;; 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)))) - ;; Now compile FORM - (byte-compile-form form byte-compile--for-effect) - (byte-compile-out-toplevel byte-compile--for-effect output-type)))) + ;; 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. + (setq byte-compile-depth (length byte-compile-lexical-environment)) + ;; 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)))) + ;; Now compile FORM + (byte-compile-form form byte-compile--for-effect) + (byte-compile-out-toplevel byte-compile--for-effect output-type))) (defun byte-compile-out-toplevel (&optional for-effect output-type) (if for-effect @@ -2873,7 +2789,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; progn -> as <> or (progn <> atom) ;; file -> as progn, but takes both quotes and atoms, and longer forms. (let (rest - (byte-compile--for-effect for-effect) + (byte-compile--for-effect for-effect) ;FIXME: Probably unused! (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. tmp body) (cond @@ -2999,8 +2915,10 @@ That command is designed for interactive use only" fn)) (byte-compile-normal-call form)) (if (byte-compile-warning-enabled-p 'cl-functions) (byte-compile-cl-warn form)))) - ((and (or (byte-code-function-p (car form)) - (eq (car-safe (car form)) 'lambda)) + ((and (byte-code-function-p (car form)) + (memq byte-optimize '(t lap))) + (byte-compile-unfold-bcf form)) + ((and (eq (car-safe (car form)) 'lambda) ;; if the form comes out the same way it went in, that's ;; because it was malformed, and we couldn't unfold it. (not (eq form (setq form (byte-compile-unfold-lambda form))))) @@ -3032,6 +2950,80 @@ That command is designed for interactive use only" fn)) (mapc 'byte-compile-form (cdr form)) ; wasteful, but faster. (byte-compile-out 'byte-call (length (cdr form)))) + +;; Splice the given lap code into the current instruction stream. +;; If it has any labels in it, you're responsible for making sure there +;; are no collisions, and that byte-compile-tag-number is reasonable +;; after this is spliced in. The provided list is destroyed. +(defun byte-compile-inline-lapcode (lap end-depth) + ;; "Replay" the operations: we used to just do + ;; (setq byte-compile-output (nconc (nreverse lap) byte-compile-output)) + ;; but that fails to update byte-compile-depth, so we had to assume + ;; that `lap' ends up adding exactly 1 element to the stack. This + ;; happens to be true for byte-code generated by bytecomp.el without + ;; lexical-binding, but it's not true in general, and it's not true for + ;; code output by bytecomp.el with lexical-binding. + (let ((endtag (byte-compile-make-tag))) + (dolist (op lap) + (cond + ((eq (car op) 'TAG) (byte-compile-out-tag op)) + ((memq (car op) byte-goto-ops) (byte-compile-goto (car op) (cdr op))) + ((eq (car op) 'byte-return) + (byte-compile-discard (- byte-compile-depth end-depth) t) + (byte-compile-goto 'byte-goto endtag)) + (t (byte-compile-out (car op) (cdr op))))) + (byte-compile-out-tag endtag))) + +(defun byte-compile-unfold-bcf (form) + (let* ((byte-compile-bound-variables byte-compile-bound-variables) + (fun (car form)) + (fargs (aref fun 0)) + (start-depth byte-compile-depth) + (fmax2 (if (numberp fargs) (lsh fargs -7))) ;2*max+rest. + ;; (fmin (if (numberp fargs) (logand fargs 127))) + (alen (length (cdr form))) + (dynbinds ())) + (fetch-bytecode fun) + (mapc 'byte-compile-form (cdr form)) + (unless fmax2 + ;; Old-style byte-code. + (assert (listp fargs)) + (while fargs + (case (car fargs) + (&optional (setq fargs (cdr fargs))) + (&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) + (push (cadr fargs) dynbinds) + (setq fargs nil)) + (t (push (pop fargs) dynbinds)))) + (unless fmax2 (setq fmax2 (* 2 (length dynbinds))))) + (cond + ((<= (+ alen alen) fmax2) + ;; Add missing &optional (or &rest) arguments. + (dotimes (i (- (/ (1+ fmax2) 2) alen)) + (byte-compile-push-constant nil))) + ((zerop (logand fmax2 1)) + (byte-compile-log-warning "Too many arguments for inlined function" + nil :error) + (byte-compile-discard (- alen (/ fmax2 2)))) + (t + ;; Turn &rest args into a list. + (let ((n (- alen (/ (1- fmax2) 2)))) + (assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n) + (if (< n 5) + (byte-compile-out + (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n)) + 0) + (byte-compile-out 'byte-listN n))))) + (mapc #'byte-compile-dynamic-variable-bind dynbinds) + (byte-compile-inline-lapcode + (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t) + (1+ start-depth)) + ;; Unbind dynamic variables. + (when dynbinds + (byte-compile-out 'byte-unbind (length dynbinds))) + (assert (eq byte-compile-depth (1+ start-depth)) + nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth))) + (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." @@ -3271,7 +3263,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-compile-warn "`%s' called with %d arg%s, but requires %s" (car form) (length (cdr form)) (if (= 1 (length (cdr form))) "" "s") n) - ;; get run-time wrong-number-of-args error. + ;; Get run-time wrong-number-of-args error. (byte-compile-normal-call form)) (defun byte-compile-no-args (form) @@ -3534,7 +3526,7 @@ discarding." (byte-compile-warn "A quoted lambda form is the second argument of `fset'. This is probably not what you want, as that lambda cannot be compiled. Consider using - the syntax (function (lambda (...) ...)) instead."))))) + the syntax #'(lambda (...) ...) instead."))))) (byte-compile-two-args form)) ;; (function foo) must compile like 'foo, not like (symbol-function 'foo). @@ -3542,9 +3534,9 @@ discarding." ;; and (funcall (function foo)) will lose with autoloads. (defun byte-compile-function-form (form) - (if (symbolp (nth 1 form)) - (byte-compile-constant (nth 1 form)) - (byte-compile-closure (nth 1 form)))) + (byte-compile-constant (if (symbolp (nth 1 form)) + (nth 1 form) + (byte-compile-lambda (nth 1 form))))) (defun byte-compile-indent-to (form) (let ((len (length form))) @@ -4102,18 +4094,16 @@ binding slots have been popped." (byte-compile-set-symbol-position (car form)) (byte-compile-set-symbol-position 'defun) (error "defun name must be a symbol, not %s" (car form))) - (let ((byte-compile--for-effect nil)) - (byte-compile-push-constant 'defalias) - (byte-compile-push-constant (nth 1 form)) - (byte-compile-closure (cdr (cdr form)) t)) + (byte-compile-push-constant 'defalias) + (byte-compile-push-constant (nth 1 form)) + (byte-compile-push-constant (byte-compile-lambda (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)))) + (code (byte-compile-lambda (cdr (cdr form)) t))) `((defalias ',(nth 1 form) ,(if (eq (car-safe code) 'make-byte-code) `(cons 'macro ,code) diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 5d19bf969e6..fe5d7230fb8 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -66,9 +66,6 @@ ;;; Code: ;; TODO: (not just for cconv but also for the lexbind changes in general) -;; - inline lexical byte-code functions. -;; - investigate some old v18 stuff in bytecomp.el. -;; - optimize away unused cl-block-wrapper. ;; - let (e)debug find the value of lexical variables from the stack. ;; - byte-optimize-form should be applied before cconv. ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize @@ -87,7 +84,7 @@ ;; - Since we know here when a variable is not mutated, we could pass that ;; info to the byte-compiler, e.g. by using a new `immutable-let'. ;; - add tail-calls to bytecode.c and the byte compiler. -;; - call known non-escaping functions with gotos rather than `call'. +;; - call known non-escaping functions with `goto' rather than `call'. ;; - optimize mapcar to a while loop. ;; (defmacro dlet (binders &rest body) From 06788a55302c7da6566c7efe8d8d800538a22c0a Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Thu, 24 Mar 2011 11:31:56 -0400 Subject: [PATCH 39/45] Fix C-M-x in lexbind mode. Misc tweaks. * lisp/startup.el: Convert to lexical-binding. Mark unused arguments. (command-line-1): Get rid of the "cl1-" prefix now that we use lexical scoping instead. * lisp/emacs-lisp/float-sup.el (pi): Leave it lexically scoped. * lisp/emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): New fun. (eval-last-sexp-1): Use eval-sexp-add-defvars. * lisp/emacs-lisp/edebug.el (edebug-eval-defun): Use eval-sexp-add-defvars. * lisp/emacs-lisp/cconv.el (cconv--analyse-function): Fix `report-error/log-warning' mixup. --- lisp/ChangeLog | 12 +++ lisp/emacs-lisp/cconv.el | 2 +- lisp/emacs-lisp/edebug.el | 3 +- lisp/emacs-lisp/float-sup.el | 8 +- lisp/emacs-lisp/lisp-mode.el | 20 ++++- lisp/startup.el | 154 +++++++++++++++++------------------ 6 files changed, 117 insertions(+), 82 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d9c1e5a34da..acdb301b4f0 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,15 @@ +2011-03-24 Stefan Monnier + + * startup.el: Convert to lexical-binding. Mark unused arguments. + (command-line-1): Get rid of the "cl1-" prefix now that we use lexical + scoping instead. + * emacs-lisp/float-sup.el (pi): Leave it lexically scoped. + * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): New fun. + (eval-last-sexp-1): Use eval-sexp-add-defvars. + * emacs-lisp/edebug.el (edebug-eval-defun): Use eval-sexp-add-defvars. + * emacs-lisp/cconv.el (cconv--analyse-function): + Fix `report-error/log-warning' mixup. + 2011-03-23 Stefan Monnier * emacs-lisp/bytecomp.el (byte-compile-file-form-defmumble): diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index fe5d7230fb8..46d14880a2c 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -553,7 +553,7 @@ FORM is the parent form that binds this var." (dolist (arg args) (cond ((byte-compile-not-lexical-var-p arg) - (byte-compile-report-error + (byte-compile-log-warning (format "Argument %S is not a lexical variable" arg))) ((eq ?& (aref (symbol-name arg) 0)) nil) ;Ignore &rest, &optional, ... (t (let ((varstruct (list arg nil nil nil nil))) diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index d711ba59a42..dfc268421e7 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -519,6 +519,7 @@ the minibuffer." ((and (eq (car form) 'defcustom) (default-boundp (nth 1 form))) ;; Force variable to be bound. + ;; FIXME: Shouldn't this use the :setter or :initializer? (set-default (nth 1 form) (eval (nth 2 form) lexical-binding))) ((eq (car form) 'defface) ;; Reset the face. @@ -532,7 +533,7 @@ the minibuffer." (put ',(nth 1 form) 'customized-face ,(nth 2 form))) (put (nth 1 form) 'saved-face nil))))) - (setq edebug-result (eval form lexical-binding)) + (setq edebug-result (eval (eval-sexp-add-defvars form) lexical-binding)) (if (not edebugging) (princ edebug-result) edebug-result))) diff --git a/lisp/emacs-lisp/float-sup.el b/lisp/emacs-lisp/float-sup.el index ceb1eb3bafb..7e40fdad352 100644 --- a/lisp/emacs-lisp/float-sup.el +++ b/lisp/emacs-lisp/float-sup.el @@ -28,7 +28,13 @@ ;; Provide an easy hook to tell if we are running with floats or not. ;; Define pi and e via math-lib calls (much less prone to killer typos). (defconst float-pi (* 4 (atan 1)) "The value of Pi (3.1415926...).") -(defconst pi float-pi "Obsolete since Emacs-23.3. Use `float-pi' instead.") +(progn + ;; Simulate a defconst that doesn't declare the variable dynamically bound. + (setq-default pi float-pi) + (put 'pi 'variable-documentation + "Obsolete since Emacs-23.3. Use `float-pi' instead.") + (put 'pi 'risky-local-variable t) + (push 'pi current-load-list)) (defconst float-e (exp 1) "The value of e (2.7182818...).") diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 85717408121..408774fbbf1 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -700,7 +700,8 @@ If CHAR is not a character, return nil." With argument, print output into current buffer." (let ((standard-output (if eval-last-sexp-arg-internal (current-buffer) t))) ;; Setup the lexical environment if lexical-binding is enabled. - (eval-last-sexp-print-value (eval (preceding-sexp) lexical-binding)))) + (eval-last-sexp-print-value + (eval (eval-sexp-add-defvars (preceding-sexp)) lexical-binding)))) (defun eval-last-sexp-print-value (value) @@ -728,6 +729,23 @@ With argument, print output into current buffer." (defvar eval-last-sexp-fake-value (make-symbol "t")) +(defun eval-sexp-add-defvars (exp &optional pos) + "Prepend EXP with all the `defvar's that precede it in the buffer. +POS specifies the starting position where EXP was found and defaults to point." + (if (not lexical-binding) + exp + (save-excursion + (unless pos (setq pos (point))) + (let ((vars ())) + (goto-char (point-min)) + (while (re-search-forward + "^(def\\(?:var\\|const\\|custom\\)[ \t\n]+\\([^; '()\n\t]+\\)" + pos t) + (let ((var (intern (match-string 1)))) + (unless (special-variable-p var) + (push var vars)))) + `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) + (defun eval-last-sexp (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. Interactively, with prefix argument, print output into current buffer. diff --git a/lisp/startup.el b/lisp/startup.el index 765ca1540ee..ebfed702735 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1,4 +1,4 @@ -;;; startup.el --- process Emacs shell arguments +;;; startup.el --- process Emacs shell arguments -*- lexical-binding: t -*- ;; Copyright (C) 1985-1986, 1992, 1994-2011 Free Software Foundation, Inc. @@ -98,6 +98,7 @@ the remaining command-line args are in the variable `command-line-args-left'.") "List of command-line args not yet processed.") (defvaralias 'argv 'command-line-args-left + ;; FIXME: Bad name for a dynamically bound variable. "List of command-line args not yet processed. This is a convenience alias, so that one can write \(pop argv\) inside of --eval command line arguments in order to access @@ -326,7 +327,7 @@ this variable usefully is to set it while building and dumping Emacs." :type '(choice (const :tag "none" nil) string) :group 'initialization :initialize 'custom-initialize-default - :set (lambda (variable value) + :set (lambda (_variable _value) (error "Customizing `site-run-file' does not work"))) (defcustom mail-host-address nil @@ -1526,7 +1527,7 @@ a face or button specification." (make-button (prog1 (point) (insert-image img)) (point) 'face 'default 'help-echo "mouse-2, RET: Browse http://www.gnu.org/" - 'action (lambda (button) (browse-url "http://www.gnu.org/")) + 'action (lambda (_button) (browse-url "http://www.gnu.org/")) 'follow-link t) (insert "\n\n"))))) @@ -1539,15 +1540,15 @@ a face or button specification." :face 'variable-pitch "\nTo start... " :link '("Open a File" - (lambda (button) (call-interactively 'find-file)) + (lambda (_button) (call-interactively 'find-file)) "Specify a new file's name, to edit the file") " " :link '("Open Home Directory" - (lambda (button) (dired "~")) + (lambda (_button) (dired "~")) "Open your home directory, to operate on its files") " " :link '("Customize Startup" - (lambda (button) (customize-group 'initialization)) + (lambda (_button) (customize-group 'initialization)) "Change initialization settings including this screen") "\n")) (fancy-splash-insert @@ -1587,7 +1588,7 @@ a face or button specification." (fancy-splash-insert :face 'variable-pitch "\n" :link '("Dismiss this startup screen" - (lambda (button) + (lambda (_button) (when startup-screen-inhibit-startup-screen (customize-set-variable 'inhibit-startup-screen t) (customize-mark-to-save 'inhibit-startup-screen) @@ -1809,37 +1810,37 @@ To quit a partially entered command, type Control-g.\n") (insert "\nImportant Help menu items:\n") (insert-button "Emacs Tutorial" - 'action (lambda (button) (help-with-tutorial)) + 'action (lambda (_button) (help-with-tutorial)) 'follow-link t) (insert "\t\tLearn basic Emacs keystroke commands\n") (insert-button "Read the Emacs Manual" - 'action (lambda (button) (info-emacs-manual)) + 'action (lambda (_button) (info-emacs-manual)) 'follow-link t) (insert "\tView the Emacs manual using Info\n") (insert-button "\(Non)Warranty" - 'action (lambda (button) (describe-no-warranty)) + 'action (lambda (_button) (describe-no-warranty)) 'follow-link t) (insert "\t\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n") (insert-button "Copying Conditions" - 'action (lambda (button) (describe-copying)) + 'action (lambda (_button) (describe-copying)) 'follow-link t) (insert "\tConditions for redistributing and changing Emacs\n") (insert-button "More Manuals / Ordering Manuals" - 'action (lambda (button) (view-order-manuals)) + 'action (lambda (_button) (view-order-manuals)) 'follow-link t) (insert " How to order printed manuals from the FSF\n") (insert "\nUseful tasks:\n") (insert-button "Visit New File" - 'action (lambda (button) (call-interactively 'find-file)) + 'action (lambda (_button) (call-interactively 'find-file)) 'follow-link t) (insert "\t\tSpecify a new file's name, to edit the file\n") (insert-button "Open Home Directory" - 'action (lambda (button) (dired "~")) + 'action (lambda (_button) (dired "~")) 'follow-link t) (insert "\tOpen your home directory, to operate on its files\n") (insert-button "Customize Startup" - 'action (lambda (button) (customize-group 'initialization)) + 'action (lambda (_button) (customize-group 'initialization)) 'follow-link t) (insert "\tChange initialization settings including this screen\n") @@ -1873,20 +1874,20 @@ To quit a partially entered command, type Control-g.\n") (where (key-description where)) (t "M-x help"))))) (insert-button "Emacs manual" - 'action (lambda (button) (info-emacs-manual)) + 'action (lambda (_button) (info-emacs-manual)) 'follow-link t) (insert (substitute-command-keys"\t \\[info-emacs-manual]\t")) (insert-button "Browse manuals" - 'action (lambda (button) (Info-directory)) + 'action (lambda (_button) (Info-directory)) 'follow-link t) (insert (substitute-command-keys "\t \\[info]\n")) (insert-button "Emacs tutorial" - 'action (lambda (button) (help-with-tutorial)) + 'action (lambda (_button) (help-with-tutorial)) 'follow-link t) (insert (substitute-command-keys "\t \\[help-with-tutorial]\tUndo changes\t \\[undo]\n")) (insert-button "Buy manuals" - 'action (lambda (button) (view-order-manuals)) + 'action (lambda (_button) (view-order-manuals)) 'follow-link t) (insert (substitute-command-keys "\t \\[view-order-manuals]\tExit Emacs\t \\[save-buffers-kill-terminal]"))) @@ -1894,7 +1895,7 @@ To quit a partially entered command, type Control-g.\n") ;; Say how to use the menu bar with the keyboard. (insert "\n") (insert-button "Activate menubar" - 'action (lambda (button) (tmm-menubar)) + 'action (lambda (_button) (tmm-menubar)) 'follow-link t) (if (and (eq (key-binding "\M-`") 'tmm-menubar) (eq (key-binding [f10]) 'tmm-menubar)) @@ -1910,21 +1911,21 @@ If you have no Meta key, you may instead type ESC followed by the character.)") (insert "\nUseful tasks:\n") (insert-button "Visit New File" - 'action (lambda (button) (call-interactively 'find-file)) + 'action (lambda (_button) (call-interactively 'find-file)) 'follow-link t) (insert "\t\t\t") (insert-button "Open Home Directory" - 'action (lambda (button) (dired "~")) + 'action (lambda (_button) (dired "~")) 'follow-link t) (insert "\n") (insert-button "Customize Startup" - 'action (lambda (button) (customize-group 'initialization)) + 'action (lambda (_button) (customize-group 'initialization)) 'follow-link t) (insert "\t\t") (insert-button "Open *scratch* buffer" - 'action (lambda (button) (switch-to-buffer - (get-buffer-create "*scratch*"))) + 'action (lambda (_button) (switch-to-buffer + (get-buffer-create "*scratch*"))) 'follow-link t) (insert "\n") (insert "\n" (emacs-version) "\n" emacs-copyright "\n") @@ -1977,7 +1978,7 @@ Type \\[describe-distribution] for information on ")) (insert-button "Authors" 'action - (lambda (button) + (lambda (_button) (view-file (expand-file-name "AUTHORS" data-directory)) (goto-char (point-min))) 'follow-link t) @@ -1985,34 +1986,34 @@ Type \\[describe-distribution] for information on ")) (insert-button "Contributing" 'action - (lambda (button) + (lambda (_button) (view-file (expand-file-name "CONTRIBUTE" data-directory)) (goto-char (point-min))) 'follow-link t) (insert "\tHow to contribute improvements to Emacs\n\n") (insert-button "GNU and Freedom" - 'action (lambda (button) (describe-gnu-project)) + 'action (lambda (_button) (describe-gnu-project)) 'follow-link t) (insert "\t\tWhy we developed GNU Emacs and the GNU system\n") (insert-button "Absence of Warranty" - 'action (lambda (button) (describe-no-warranty)) + 'action (lambda (_button) (describe-no-warranty)) 'follow-link t) (insert "\tGNU Emacs comes with ABSOLUTELY NO WARRANTY\n") (insert-button "Copying Conditions" - 'action (lambda (button) (describe-copying)) + 'action (lambda (_button) (describe-copying)) 'follow-link t) (insert "\tConditions for redistributing and changing Emacs\n") (insert-button "Getting New Versions" - 'action (lambda (button) (describe-distribution)) + 'action (lambda (_button) (describe-distribution)) 'follow-link t) (insert "\tHow to get the latest version of GNU Emacs\n") (insert-button "More Manuals / Ordering Manuals" - 'action (lambda (button) (view-order-manuals)) + 'action (lambda (_button) (view-order-manuals)) 'follow-link t) (insert "\tBuying printed manuals from the FSF\n")) @@ -2078,7 +2079,7 @@ A fancy display is used on graphic displays, normal otherwise." (defalias 'about-emacs 'display-about-screen) (defalias 'display-splash-screen 'display-startup-screen) -(defun command-line-1 (command-line-args-left) +(defun command-line-1 (args-left) (display-startup-echo-area-message) (when (and pure-space-overflow (not noninteractive)) @@ -2089,15 +2090,12 @@ A fancy display is used on graphic displays, normal otherwise." :warning)) (let ((file-count 0) + (command-line-args-left args-left) first-file-buffer) (when command-line-args-left ;; We have command args; process them. - ;; Note that any local variables in this function affect the - ;; ability of -f batch-byte-compile to detect free variables. - ;; So we give some of them with common names a cl1- prefix. - ;; FIXME: A better fix would be to make this file use lexical-binding. - (let ((cl1-dir command-line-default-directory) - cl1-tem + (let ((dir command-line-default-directory) + tem ;; This approach loses for "-batch -L DIR --eval "(require foo)", ;; if foo is intended to be found in DIR. ;; @@ -2120,8 +2118,8 @@ A fancy display is used on graphic displays, normal otherwise." "--find-file" "--visit" "--file" "--no-desktop") (mapcar (lambda (elt) (concat "-" (car elt))) command-switch-alist))) - (cl1-line 0) - (cl1-column 0)) + (line 0) + (column 0)) ;; Add the long X options to longopts. (dolist (tem command-line-x-option-alist) @@ -2162,12 +2160,12 @@ A fancy display is used on graphic displays, normal otherwise." argi orig-argi))))) ;; Execute the option. - (cond ((setq cl1-tem (assoc argi command-switch-alist)) + (cond ((setq tem (assoc argi command-switch-alist)) (if argval (let ((command-line-args-left (cons argval command-line-args-left))) - (funcall (cdr cl1-tem) argi)) - (funcall (cdr cl1-tem) argi))) + (funcall (cdr tem) argi)) + (funcall (cdr tem) argi))) ((equal argi "-no-splash") (setq inhibit-startup-screen t)) @@ -2176,22 +2174,22 @@ A fancy display is used on graphic displays, normal otherwise." "-funcall" "-e")) ; what the source used to say (setq inhibit-startup-screen t) - (setq cl1-tem (intern (or argval (pop command-line-args-left)))) - (if (commandp cl1-tem) - (command-execute cl1-tem) - (funcall cl1-tem))) + (setq tem (intern (or argval (pop command-line-args-left)))) + (if (commandp tem) + (command-execute tem) + (funcall tem))) ((member argi '("-eval" "-execute")) (setq inhibit-startup-screen t) (eval (read (or argval (pop command-line-args-left))))) ((member argi '("-L" "-directory")) - (setq cl1-tem (expand-file-name + (setq tem (expand-file-name (command-line-normalize-file-name (or argval (pop command-line-args-left))))) - (cond (splice (setcdr splice (cons cl1-tem (cdr splice))) + (cond (splice (setcdr splice (cons tem (cdr splice))) (setq splice (cdr splice))) - (t (setq load-path (cons cl1-tem load-path) + (t (setq load-path (cons tem load-path) splice load-path)))) ((member argi '("-l" "-load")) @@ -2215,10 +2213,10 @@ A fancy display is used on graphic displays, normal otherwise." ((equal argi "-insert") (setq inhibit-startup-screen t) - (setq cl1-tem (or argval (pop command-line-args-left))) - (or (stringp cl1-tem) + (setq tem (or argval (pop command-line-args-left))) + (or (stringp tem) (error "File name omitted from `-insert' option")) - (insert-file-contents (command-line-normalize-file-name cl1-tem))) + (insert-file-contents (command-line-normalize-file-name tem))) ((equal argi "-kill") (kill-emacs t)) @@ -2231,42 +2229,42 @@ A fancy display is used on graphic displays, normal otherwise." (message "\"--no-desktop\" ignored because the Desktop package is not loaded")) ((string-match "^\\+[0-9]+\\'" argi) - (setq cl1-line (string-to-number argi))) + (setq line (string-to-number argi))) ((string-match "^\\+\\([0-9]+\\):\\([0-9]+\\)\\'" argi) - (setq cl1-line (string-to-number (match-string 1 argi)) - cl1-column (string-to-number (match-string 2 argi)))) + (setq line (string-to-number (match-string 1 argi)) + column (string-to-number (match-string 2 argi)))) - ((setq cl1-tem (assoc orig-argi command-line-x-option-alist)) + ((setq tem (assoc orig-argi command-line-x-option-alist)) ;; Ignore X-windows options and their args if not using X. (setq command-line-args-left - (nthcdr (nth 1 cl1-tem) command-line-args-left))) + (nthcdr (nth 1 tem) command-line-args-left))) - ((setq cl1-tem (assoc orig-argi command-line-ns-option-alist)) + ((setq tem (assoc orig-argi command-line-ns-option-alist)) ;; Ignore NS-windows options and their args if not using NS. (setq command-line-args-left - (nthcdr (nth 1 cl1-tem) command-line-args-left))) + (nthcdr (nth 1 tem) command-line-args-left))) ((member argi '("-find-file" "-file" "-visit")) (setq inhibit-startup-screen t) ;; An explicit option to specify visiting a file. - (setq cl1-tem (or argval (pop command-line-args-left))) - (unless (stringp cl1-tem) + (setq tem (or argval (pop command-line-args-left))) + (unless (stringp tem) (error "File name omitted from `%s' option" argi)) (setq file-count (1+ file-count)) (let ((file (expand-file-name - (command-line-normalize-file-name cl1-tem) - cl1-dir))) + (command-line-normalize-file-name tem) + dir))) (if (= file-count 1) (setq first-file-buffer (find-file file)) (find-file-other-window file))) - (unless (zerop cl1-line) + (unless (zerop line) (goto-char (point-min)) - (forward-line (1- cl1-line))) - (setq cl1-line 0) - (unless (< cl1-column 1) - (move-to-column (1- cl1-column))) - (setq cl1-column 0)) + (forward-line (1- line))) + (setq line 0) + (unless (< column 1) + (move-to-column (1- column))) + (setq column 0)) ;; These command lines now have no effect. ((string-match "\\`--?\\(no-\\)?\\(uni\\|multi\\)byte$" argi) @@ -2294,19 +2292,19 @@ A fancy display is used on graphic displays, normal otherwise." (let ((file (expand-file-name (command-line-normalize-file-name orig-argi) - cl1-dir))) + dir))) (cond ((= file-count 1) (setq first-file-buffer (find-file file))) (inhibit-startup-screen (find-file-other-window file)) (t (find-file file)))) - (unless (zerop cl1-line) + (unless (zerop line) (goto-char (point-min)) - (forward-line (1- cl1-line))) - (setq cl1-line 0) - (unless (< cl1-column 1) - (move-to-column (1- cl1-column))) - (setq cl1-column 0)))))) + (forward-line (1- line))) + (setq line 0) + (unless (< column 1) + (move-to-column (1- column))) + (setq column 0)))))) ;; In unusual circumstances, the execution of Lisp code due ;; to command-line options can cause the last visible frame ;; to be deleted. In this case, kill emacs to avoid an From 9dba2c644978f9c51ad38da97134fca7d8cf29e2 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Tue, 29 Mar 2011 23:27:56 -0400 Subject: [PATCH 40/45] * lisp/subr.el (with-output-to-temp-buffer): Don't change current-buffer to standard-output while running the body. * lisp/Makefile.in (COMPILE_FIRST): Remove pcase; it's not so important. * lisp/startup.el: Fix up warnings, move lambda expressions outside of quote. --- lisp/ChangeLog | 10 +++++ lisp/Makefile.in | 1 - lisp/startup.el | 112 ++++++++++++++++++++++++----------------------- lisp/subr.el | 33 +++++++------- 4 files changed, 85 insertions(+), 71 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index acdb301b4f0..d7246d31df3 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2011-03-30 Stefan Monnier + + * subr.el (with-output-to-temp-buffer): Don't change current-buffer to + standard-output while running the body. + + * startup.el: Fix up warnings, move lambda expressions + outside of quote. + + * Makefile.in (COMPILE_FIRST): Remove pcase; it's not so important. + 2011-03-24 Stefan Monnier * startup.el: Convert to lexical-binding. Mark unused arguments. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index 4db5ef4f008..ab82c99ac33 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -85,7 +85,6 @@ BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) COMPILE_FIRST = \ $(lisp)/emacs-lisp/bytecomp.elc \ $(lisp)/emacs-lisp/byte-opt.elc \ - $(lisp)/emacs-lisp/pcase.elc \ $(lisp)/emacs-lisp/macroexp.elc \ $(lisp)/emacs-lisp/cconv.elc \ $(lisp)/emacs-lisp/autoload.elc diff --git a/lisp/startup.el b/lisp/startup.el index ebfed702735..d2184778212 100644 --- a/lisp/startup.el +++ b/lisp/startup.el @@ -1096,7 +1096,8 @@ the `--debug-init' option to view a complete error backtrace." user-init-file (get (car error) 'error-message) (if (cdr error) ": " "") - (mapconcat (lambda (s) (prin1-to-string s t)) (cdr error) ", ")) + (mapconcat (lambda (s) (prin1-to-string s t)) + (cdr error) ", ")) :warning) (setq init-file-had-error t)))) @@ -1292,25 +1293,25 @@ If this is nil, no message will be displayed." ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defconst fancy-startup-text - '((:face (variable-pitch (:foreground "red")) + `((:face (variable-pitch (:foreground "red")) "Welcome to " :link ("GNU Emacs" - (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) + ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/")) "Browse http://www.gnu.org/software/emacs/") ", one component of the " :link - (lambda () + ,(lambda () (if (eq system-type 'gnu/linux) - '("GNU/Linux" - (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) + `("GNU/Linux" + ,(lambda (_button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) "Browse http://www.gnu.org/gnu/linux-and-gnu.html") - '("GNU" (lambda (button) (describe-gnu-project)) + `("GNU" ,(lambda (_button) (describe-gnu-project)) "Display info on the GNU project"))) " operating system.\n\n" :face variable-pitch - :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial))) + :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial))) "\tLearn basic keystroke commands" - (lambda () + ,(lambda () (let* ((en "TUTORIAL") (tut (or (get-language-info current-language-environment 'tutorial) @@ -1328,19 +1329,20 @@ If this is nil, no message will be displayed." (concat " (" title ")")))) "\n" :link ("Emacs Guided Tour" - (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/")) + ,(lambda (_button) + (browse-url "http://www.gnu.org/software/emacs/tour/")) "Browse http://www.gnu.org/software/emacs/tour/") "\tOverview of Emacs features at gnu.org\n" - :link ("View Emacs Manual" (lambda (button) (info-emacs-manual))) + :link ("View Emacs Manual" ,(lambda (_button) (info-emacs-manual))) "\tView the Emacs manual using Info\n" - :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) + :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty))) "\tGNU Emacs comes with " :face (variable-pitch (:slant oblique)) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch - :link ("Copying Conditions" (lambda (button) (describe-copying))) + :link ("Copying Conditions" ,(lambda (_button) (describe-copying))) "\tConditions for redistributing and changing Emacs\n" - :link ("Ordering Manuals" (lambda (button) (view-order-manuals))) + :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals))) "\tPurchasing printed copies of manuals\n" "\n")) "A list of texts to show in the middle part of splash screens. @@ -1348,61 +1350,62 @@ Each element in the list should be a list of strings or pairs `:face FACE', like `fancy-splash-insert' accepts them.") (defconst fancy-about-text - '((:face (variable-pitch (:foreground "red")) + `((:face (variable-pitch (:foreground "red")) "This is " :link ("GNU Emacs" - (lambda (button) (browse-url "http://www.gnu.org/software/emacs/")) + ,(lambda (_button) (browse-url "http://www.gnu.org/software/emacs/")) "Browse http://www.gnu.org/software/emacs/") ", one component of the " :link - (lambda () + ,(lambda () (if (eq system-type 'gnu/linux) - '("GNU/Linux" - (lambda (button) (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) + `("GNU/Linux" + ,(lambda (_button) + (browse-url "http://www.gnu.org/gnu/linux-and-gnu.html")) "Browse http://www.gnu.org/gnu/linux-and-gnu.html") - '("GNU" (lambda (button) (describe-gnu-project)) + `("GNU" ,(lambda (_button) (describe-gnu-project)) "Display info on the GNU project."))) " operating system.\n" - :face (lambda () + :face ,(lambda () (list 'variable-pitch (list :foreground (if (eq (frame-parameter nil 'background-mode) 'dark) "cyan" "darkblue")))) "\n" - (lambda () (emacs-version)) + ,(lambda () (emacs-version)) "\n" :face (variable-pitch (:height 0.8)) - (lambda () emacs-copyright) + ,(lambda () emacs-copyright) "\n\n" :face variable-pitch :link ("Authors" - (lambda (button) + ,(lambda (_button) (view-file (expand-file-name "AUTHORS" data-directory)) (goto-char (point-min)))) "\tMany people have contributed code included in GNU Emacs\n" :link ("Contributing" - (lambda (button) + ,(lambda (_button) (view-file (expand-file-name "CONTRIBUTE" data-directory)) (goto-char (point-min)))) "\tHow to contribute improvements to Emacs\n" "\n" - :link ("GNU and Freedom" (lambda (button) (describe-gnu-project))) + :link ("GNU and Freedom" ,(lambda (_button) (describe-gnu-project))) "\tWhy we developed GNU Emacs, and the GNU operating system\n" - :link ("Absence of Warranty" (lambda (button) (describe-no-warranty))) + :link ("Absence of Warranty" ,(lambda (_button) (describe-no-warranty))) "\tGNU Emacs comes with " :face (variable-pitch (:slant oblique)) "ABSOLUTELY NO WARRANTY\n" :face variable-pitch - :link ("Copying Conditions" (lambda (button) (describe-copying))) + :link ("Copying Conditions" ,(lambda (_button) (describe-copying))) "\tConditions for redistributing and changing Emacs\n" - :link ("Getting New Versions" (lambda (button) (describe-distribution))) + :link ("Getting New Versions" ,(lambda (_button) (describe-distribution))) "\tHow to obtain the latest version of Emacs\n" - :link ("Ordering Manuals" (lambda (button) (view-order-manuals))) + :link ("Ordering Manuals" ,(lambda (_button) (view-order-manuals))) "\tBuying printed manuals from the FSF\n" "\n" - :link ("Emacs Tutorial" (lambda (button) (help-with-tutorial))) + :link ("Emacs Tutorial" ,(lambda (_button) (help-with-tutorial))) "\tLearn basic Emacs keystroke commands" - (lambda () + ,(lambda () (let* ((en "TUTORIAL") (tut (or (get-language-info current-language-environment 'tutorial) @@ -1420,7 +1423,8 @@ Each element in the list should be a list of strings or pairs (concat " (" title ")")))) "\n" :link ("Emacs Guided Tour" - (lambda (button) (browse-url "http://www.gnu.org/software/emacs/tour/")) + ,(lambda (_button) + (browse-url "http://www.gnu.org/software/emacs/tour/")) "Browse http://www.gnu.org/software/emacs/tour/") "\tSee an overview of Emacs features at gnu.org" )) @@ -1539,16 +1543,16 @@ a face or button specification." (fancy-splash-insert :face 'variable-pitch "\nTo start... " - :link '("Open a File" - (lambda (_button) (call-interactively 'find-file)) + :link `("Open a File" + ,(lambda (_button) (call-interactively 'find-file)) "Specify a new file's name, to edit the file") " " - :link '("Open Home Directory" - (lambda (_button) (dired "~")) + :link `("Open Home Directory" + ,(lambda (_button) (dired "~")) "Open your home directory, to operate on its files") " " - :link '("Customize Startup" - (lambda (_button) (customize-group 'initialization)) + :link `("Customize Startup" + ,(lambda (_button) (customize-group 'initialization)) "Change initialization settings including this screen") "\n")) (fancy-splash-insert @@ -1587,15 +1591,15 @@ a face or button specification." (when concise (fancy-splash-insert :face 'variable-pitch "\n" - :link '("Dismiss this startup screen" - (lambda (_button) - (when startup-screen-inhibit-startup-screen - (customize-set-variable 'inhibit-startup-screen t) - (customize-mark-to-save 'inhibit-startup-screen) - (custom-save-all)) - (let ((w (get-buffer-window "*GNU Emacs*"))) - (and w (not (one-window-p)) (delete-window w))) - (kill-buffer "*GNU Emacs*"))) + :link `("Dismiss this startup screen" + ,(lambda (_button) + (when startup-screen-inhibit-startup-screen + (customize-set-variable 'inhibit-startup-screen t) + (customize-mark-to-save 'inhibit-startup-screen) + (custom-save-all)) + (let ((w (get-buffer-window "*GNU Emacs*"))) + (and w (not (one-window-p)) (delete-window w))) + (kill-buffer "*GNU Emacs*"))) " ") (when (or user-init-file custom-file) (let ((checked (create-image "checked.xpm" @@ -1938,36 +1942,36 @@ If you have no Meta key, you may instead type ESC followed by the character.)") " GNU Emacs comes with ABSOLUTELY NO WARRANTY; type C-h C-w for ") (insert-button "full details" - 'action (lambda (button) (describe-no-warranty)) + 'action (lambda (_button) (describe-no-warranty)) 'follow-link t) (insert ". Emacs is Free Software--Free as in Freedom--so you can redistribute copies of Emacs and modify it; type C-h C-c to see ") (insert-button "the conditions" - 'action (lambda (button) (describe-copying)) + 'action (lambda (_button) (describe-copying)) 'follow-link t) (insert ". Type C-h C-d for information on ") (insert-button "getting the latest version" - 'action (lambda (button) (describe-distribution)) + 'action (lambda (_button) (describe-distribution)) 'follow-link t) (insert ".")) (insert (substitute-command-keys " GNU Emacs comes with ABSOLUTELY NO WARRANTY; type \\[describe-no-warranty] for ")) (insert-button "full details" - 'action (lambda (button) (describe-no-warranty)) + 'action (lambda (_button) (describe-no-warranty)) 'follow-link t) (insert (substitute-command-keys ". Emacs is Free Software--Free as in Freedom--so you can redistribute copies of Emacs and modify it; type \\[describe-copying] to see ")) (insert-button "the conditions" - 'action (lambda (button) (describe-copying)) + 'action (lambda (_button) (describe-copying)) 'follow-link t) (insert (substitute-command-keys". Type \\[describe-distribution] for information on ")) (insert-button "getting the latest version" - 'action (lambda (button) (describe-distribution)) + 'action (lambda (_button) (describe-distribution)) 'follow-link t) (insert "."))) diff --git a/lisp/subr.el b/lisp/subr.el index 9f4e35fcbe0..c5fedae2bfc 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -2871,22 +2871,23 @@ temporarily selected. But it doesn't run `temp-buffer-show-hook' if it uses `temp-buffer-show-function'." (let ((old-dir (make-symbol "old-dir")) (buf (make-symbol "buf"))) - `(let ((,old-dir default-directory)) - (with-current-buffer (get-buffer-create ,bufname) - (kill-all-local-variables) - ;; FIXME: delete_all_overlays - (setq default-directory ,old-dir) - (setq buffer-read-only nil) - (setq buffer-file-name nil) - (setq buffer-undo-list t) - (let ((,buf (current-buffer))) - (let ((inhibit-read-only t) - (inhibit-modification-hooks t)) - (erase-buffer) - (run-hooks 'temp-buffer-setup-hook)) - (let ((standard-output ,buf)) - (prog1 (progn ,@body) - (internal-temp-output-buffer-show ,buf)))))))) + `(let* ((,old-dir default-directory) + (,buf + (with-current-buffer (get-buffer-create ,bufname) + (prog1 (current-buffer) + (kill-all-local-variables) + ;; FIXME: delete_all_overlays + (setq default-directory ,old-dir) + (setq buffer-read-only nil) + (setq buffer-file-name nil) + (setq buffer-undo-list t) + (let ((inhibit-read-only t) + (inhibit-modification-hooks t)) + (erase-buffer) + (run-hooks 'temp-buffer-setup-hook))))) + (standard-output ,buf)) + (prog1 (progn ,@body) + (internal-temp-output-buffer-show ,buf))))) (defmacro with-temp-file (file &rest body) "Create a new buffer, evaluate BODY there, and write the buffer to FILE. From ebe0c9b6b02cfb328457156c25387c3e2b7ba961 Mon Sep 17 00:00:00 2001 From: Juanma Barranquero Date: Wed, 30 Mar 2011 16:01:28 +0200 Subject: [PATCH 41/45] lisp/makefile.w32-in (COMPILE_FIRST): Remove pcase. --- lisp/ChangeLog | 4 ++++ lisp/makefile.w32-in | 1 - 2 files changed, 4 insertions(+), 1 deletion(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index d7246d31df3..c1e12152f11 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-03-30 Juanma Barranquero + + * makefile.w32-in (COMPILE_FIRST): Remove pcase. + 2011-03-30 Stefan Monnier * subr.el (with-output-to-temp-buffer): Don't change current-buffer to diff --git a/lisp/makefile.w32-in b/lisp/makefile.w32-in index 9ea61498ffa..ed2fe4031b7 100644 --- a/lisp/makefile.w32-in +++ b/lisp/makefile.w32-in @@ -84,7 +84,6 @@ BYTE_COMPILE_FLAGS = $(BIG_STACK_OPTS) $(BYTE_COMPILE_EXTRA_FLAGS) COMPILE_FIRST = \ $(lisp)/emacs-lisp/byte-opt.el \ $(lisp)/emacs-lisp/bytecomp.el \ - $(lisp)/emacs-lisp/pcase.el \ $(lisp)/emacs-lisp/macroexp.el \ $(lisp)/emacs-lisp/cconv.el \ $(lisp)/subr.el \ From f488fb6528738131ef41859e1f04125f2e50efce Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Wed, 30 Mar 2011 14:40:00 -0400 Subject: [PATCH 42/45] * lisp/subr.el (apply-partially): Use a non-nil static environment. (--dolist-tail--, --dotimes-limit--): Don't declare dynamically bound. (dolist): Use a more efficient form for lexical-binding. (dotimes): Use a cleaner semantics for lexical-binding. * lisp/emacs-lisp/edebug.el (edebug-eval-top-level-form): Use eval-sexp-add-defvars. --- lisp/ChangeLog | 10 ++++++ lisp/emacs-lisp/edebug.el | 3 +- lisp/subr.el | 65 ++++++++++++++++++++++++++------------- src/lread.c | 1 + 4 files changed, 56 insertions(+), 23 deletions(-) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index c1e12152f11..b517c48738f 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,13 @@ +2011-03-30 Stefan Monnier + + * subr.el (apply-partially): Use a non-nil static environment. + (--dolist-tail--, --dotimes-limit--): Don't declare dynamically bound. + (dolist): Use a more efficient form for lexical-binding. + (dotimes): Use a cleaner semantics for lexical-binding. + + * emacs-lisp/edebug.el (edebug-eval-top-level-form): + Use eval-sexp-add-defvars. + 2011-03-30 Juanma Barranquero * makefile.w32-in (COMPILE_FIRST): Remove pcase. diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index dfc268421e7..8135b5c4f24 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -566,7 +566,8 @@ already is one.)" ;; but this causes problems while edebugging edebug. (let ((edebug-all-forms t) (edebug-all-defs t)) - (edebug-read-top-level-form)))) + (eval-sexp-add-defvars + (edebug-read-top-level-form))))) (defun edebug-read-top-level-form () diff --git a/lisp/subr.el b/lisp/subr.el index c5fedae2bfc..205828b4169 100644 --- a/lisp/subr.el +++ b/lisp/subr.el @@ -124,7 +124,7 @@ ARGS is a list of the first N arguments to pass to FUN. The result is a new function which does the same as FUN, except that the first N arguments are fixed at the values with which this function was called." - `(closure () (&rest args) + `(closure (t) (&rest args) (apply ',fun ,@(mapcar (lambda (arg) `',arg) args) args))) (if (null (featurep 'cl)) @@ -174,8 +174,6 @@ value of last one, or nil if there are none. ;; If we reload subr.el after having loaded CL, be careful not to ;; overwrite CL's extended definition of `dolist', `dotimes', ;; `declare', `push' and `pop'. -(defvar --dolist-tail-- nil - "Temporary variable used in `dolist' expansion.") (defmacro dolist (spec &rest body) "Loop over a list. @@ -189,19 +187,27 @@ Then evaluate RESULT to get return value, default nil. ;; use dolist. ;; FIXME: This cost disappears in byte-compiled lexical-binding files. (let ((temp '--dolist-tail--)) - `(let ((,temp ,(nth 1 spec)) - ,(car spec)) - (while ,temp - ;; FIXME: In lexical-binding code, a `let' inside the loop might - ;; turn out to be faster than the an outside `let' this `setq'. - (setq ,(car spec) (car ,temp)) - ,@body - (setq ,temp (cdr ,temp))) - ,@(if (cdr (cdr spec)) - `((setq ,(car spec) nil) ,@(cdr (cdr spec))))))) - -(defvar --dotimes-limit-- nil - "Temporary variable used in `dotimes' expansion.") + ;; This is not a reliable test, but it does not matter because both + ;; semantics are acceptable, tho one is slightly faster with dynamic + ;; scoping and the other is slightly faster (and has cleaner semantics) + ;; with lexical scoping. + (if lexical-binding + `(let ((,temp ,(nth 1 spec))) + (while ,temp + (let ((,(car spec) (car ,temp))) + ,@body + (setq ,temp (cdr ,temp)))) + ,@(if (cdr (cdr spec)) + ;; FIXME: This let often leads to "unused var" warnings. + `((let ((,(car spec) nil)) ,@(cdr (cdr spec)))))) + `(let ((,temp ,(nth 1 spec)) + ,(car spec)) + (while ,temp + (setq ,(car spec) (car ,temp)) + ,@body + (setq ,temp (cdr ,temp))) + ,@(if (cdr (cdr spec)) + `((setq ,(car spec) nil) ,@(cdr (cdr spec)))))))) (defmacro dotimes (spec &rest body) "Loop a certain number of times. @@ -214,15 +220,30 @@ the return value (nil if RESULT is omitted). ;; It would be cleaner to create an uninterned symbol, ;; but that uses a lot more space when many functions in many files ;; use dotimes. + ;; FIXME: This cost disappears in byte-compiled lexical-binding files. (let ((temp '--dotimes-limit--) (start 0) (end (nth 1 spec))) - `(let ((,temp ,end) - (,(car spec) ,start)) - (while (< ,(car spec) ,temp) - ,@body - (setq ,(car spec) (1+ ,(car spec)))) - ,@(cdr (cdr spec))))) + ;; This is not a reliable test, but it does not matter because both + ;; semantics are acceptable, tho one is slightly faster with dynamic + ;; scoping and the other has cleaner semantics. + (if lexical-binding + (let ((counter '--dotimes-counter--)) + `(let ((,temp ,end) + (,counter ,start)) + (while (< ,counter ,temp) + (let ((,(car spec) ,counter)) + ,@body) + (setq ,counter (1+ ,counter))) + ,@(if (cddr spec) + ;; FIXME: This let often leads to "unused var" warnings. + `((let ((,(car spec) ,counter)) ,@(cddr spec)))))) + `(let ((,temp ,end) + (,(car spec) ,start)) + (while (< ,(car spec) ,temp) + ,@body + (setq ,(car spec) (1+ ,(car spec)))) + ,@(cdr (cdr spec)))))) (defmacro declare (&rest specs) "Do not evaluate any arguments and return nil. diff --git a/src/lread.c b/src/lread.c index 7a8d7cf9a6a..24183532527 100644 --- a/src/lread.c +++ b/src/lread.c @@ -1889,6 +1889,7 @@ which is the input stream for reading characters. This function does not move point. */) (Lisp_Object start, Lisp_Object end, Lisp_Object printflag, Lisp_Object read_function) { + /* FIXME: Do the eval-sexp-add-defvars danse! */ int count = SPECPDL_INDEX (); Lisp_Object tem, cbuf; From 0f0c1f27a974ee41d96f19a5930e54f14e41ba89 Mon Sep 17 00:00:00 2001 From: Eli Zaretskii Date: Fri, 1 Apr 2011 13:10:47 +0300 Subject: [PATCH 43/45] Add a new command `info-display-manual'. lisp/info.el (info-display-manual): New function. --- etc/NEWS | 8 ++++++++ lisp/ChangeLog | 4 ++++ lisp/info.el | 21 +++++++++++++++++++++ 3 files changed, 33 insertions(+) diff --git a/etc/NEWS b/etc/NEWS index 14d788ec554..999d278dc2e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -676,6 +676,14 @@ binding `log-view-expanded-log-entry-function' to a suitable function. *** New command `nato-region' converts text to NATO phonetic alphabet. +*** The new command `info-display-manual' will display an Info manual +specified by its name. If that manual is already visited in some Info +buffer within the current session, the command will display that +buffer. Otherwise, it will load the manual and display it. This is +handy if you have many manuals in many Info buffers, and don't +remember the name of the buffer visiting the manual you want to +consult. + * New Modes and Packages in Emacs 24.1 diff --git a/lisp/ChangeLog b/lisp/ChangeLog index 32e9c92a255..5c6e7365491 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,7 @@ +2011-04-01 Eli Zaretskii + + * info.el (info-display-manual): New function. + 2011-03-31 Stefan Monnier * loadup.el: Load minibuffer after loaddefs, to use define-minor-mode. diff --git a/lisp/info.el b/lisp/info.el index fb753659737..34c486d3754 100644 --- a/lisp/info.el +++ b/lisp/info.el @@ -4930,6 +4930,27 @@ type returned by `Info-bookmark-make-record', which see." (bookmark-default-handler `("" (buffer . ,buf) . ,(bookmark-get-bookmark-record bmk))))) + +;;;###autoload +(defun info-display-manual (manual) + "Go to Info buffer that displays MANUAL, creating it if none already exists." + (interactive "sManual name: ") + (let ((blist (buffer-list)) + (manual-re (concat "\\(/\\|\\`\\)" manual "\\(\\.\\|\\'\\)")) + (case-fold-search t) + found) + (dolist (buffer blist) + (with-current-buffer buffer + (when (and (eq major-mode 'Info-mode) + (stringp Info-current-file) + (string-match manual-re Info-current-file)) + (setq found buffer + blist nil)))) + (if found + (pop-to-buffer found) + (info-initialize) + (info (Info-find-file manual))))) + (provide 'info) ;;; info.el ends here From 1c412c000a5d61d1be7f6fa7e632a517b89de95b Mon Sep 17 00:00:00 2001 From: Julien Danjou Date: Fri, 1 Apr 2011 14:24:22 +0000 Subject: [PATCH 44/45] mm-view.el (mm-display-inline-fontify): Do not fontify with fundamental-mode. --- lisp/gnus/ChangeLog | 5 +++++ lisp/gnus/mm-view.el | 4 +++- 2 files changed, 8 insertions(+), 1 deletion(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index 2496453dd89..37faf83fd12 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,8 @@ +2011-04-01 Julien Danjou + + * mm-view.el (mm-display-inline-fontify): Do not fontify with + fundamental-mode. + 2011-03-30 Lars Magne Ingebrigtsen * gnus-sum.el (gnus-update-marks): Revert intersection change, which diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el index abd78b8de02..5a90f015aed 100644 --- a/lisp/gnus/mm-view.el +++ b/lisp/gnus/mm-view.el @@ -608,7 +608,9 @@ If MODE is not set, try to find mode automatically." (funcall mode) (set-auto-mode)) ;; The mode function might have already turned on font-lock. - (unless (symbol-value 'font-lock-mode) + ;; Do not fontify if the guess mode is fundamental. + (unless (or (symbol-value 'font-lock-mode) + (eq major-mode 'fundamental-mode)) (font-lock-fontify-buffer))) ;; By default, XEmacs font-lock uses non-duplicable text ;; properties. This code forces all the text properties From 7200d79c65c65686495dd95e9f6dd436cf6db55e Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 1 Apr 2011 11:16:50 -0400 Subject: [PATCH 45/45] Miscellanous cleanups in preparation for the merge. * lisp/emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): Remove debug statement. * lisp/emacs-lisp/bytecomp.el (byte-compile-single-version) (byte-compile-version-cond, byte-compile-delay-out) (byte-compile-delayed-out): Remove, unused. * src/bytecode.c (Fbyte_code): Revert to old calling convention. * src/lisp.h (COMPILED_PUSH_ARGS): Remove, unused. --- doc/lispref/variables.texi | 2 +- etc/NEWS.lexbind | 2 +- lisp/ChangeLog | 9 ++ lisp/Makefile.in | 6 +- lisp/cedet/semantic/wisent/comp.el | 3 + lisp/emacs-lisp/byte-opt.el | 16 ++- lisp/emacs-lisp/bytecomp.el | 162 +++++++++-------------------- lisp/emacs-lisp/cconv.el | 8 ++ lisp/emacs-lisp/cl-loaddefs.el | 2 +- lisp/emacs-lisp/cl-macs.el | 2 +- lisp/emacs-lisp/cl.el | 6 +- lisp/emacs-lisp/disass.el | 1 - lisp/emacs-lisp/edebug.el | 2 +- lisp/emacs-lisp/eieio.el | 3 +- lisp/emacs-lisp/lisp-mode.el | 2 +- src/ChangeLog | 5 + src/bytecode.c | 41 +++----- src/callint.c | 4 +- src/eval.c | 15 ++- src/lisp.h | 3 +- src/lread.c | 33 +++--- src/window.c | 1 + test/automated/lexbind-tests.el | 4 +- 23 files changed, 138 insertions(+), 194 deletions(-) diff --git a/doc/lispref/variables.texi b/doc/lispref/variables.texi index fad76ed39f8..7e2c32334a4 100644 --- a/doc/lispref/variables.texi +++ b/doc/lispref/variables.texi @@ -1137,7 +1137,7 @@ by @code{funcall}, and they are represented by a cons cell whose @code{car} is the symbol @code{closure}. @menu -* Converting to Lexical Binding:: How to start using lexical scoping +* Converting to Lexical Binding:: How to start using lexical scoping @end menu @node Converting to Lexical Binding diff --git a/etc/NEWS.lexbind b/etc/NEWS.lexbind index de5d9a07715..a55b8e38dcf 100644 --- a/etc/NEWS.lexbind +++ b/etc/NEWS.lexbind @@ -17,7 +17,7 @@ It is typically set via file-local variables, in which case it applies to all the code in that file. ** Lexically scoped interpreted functions are represented with a new form -of function value which looks like (closure ENV lambda ARGS &rest BODY). +of function value which looks like (closure ENV ARGS &rest BODY). ** New macro `letrec' to define recursive local functions. ---------------------------------------------------------------------- diff --git a/lisp/ChangeLog b/lisp/ChangeLog index b517c48738f..f977b976c4b 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,12 @@ +2011-04-01 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-single-version) + (byte-compile-version-cond, byte-compile-delay-out) + (byte-compile-delayed-out): Remove, unused. + + * emacs-lisp/byte-opt.el (byte-optimize-form-code-walker): + Remove debug statement. + 2011-03-30 Stefan Monnier * subr.el (apply-partially): Use a non-nil static environment. diff --git a/lisp/Makefile.in b/lisp/Makefile.in index ab82c99ac33..083f312d613 100644 --- a/lisp/Makefile.in +++ b/lisp/Makefile.in @@ -206,8 +206,8 @@ compile-onefile: @echo Compiling $(THEFILE) @# Use byte-compile-refresh-preloaded to try and work around some of @# the most common bootstrapping problems. - @$(emacs) $(BYTE_COMPILE_FLAGS) -l bytecomp \ - -f byte-compile-refresh-preloaded \ + @$(emacs) $(BYTE_COMPILE_FLAGS) \ + -l bytecomp -f byte-compile-refresh-preloaded \ -f batch-byte-compile $(THEFILE) # Files MUST be compiled one by one. If we compile several files in a @@ -292,7 +292,7 @@ compile-always: doit compile-calc: for el in $(lisp)/calc/*.el; do \ echo Compiling $$el; \ - $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1; \ + $(emacs) $(BYTE_COMPILE_FLAGS) -f batch-byte-compile $$el || exit 1;\ done # Backup compiled Lisp files in elc.tar.gz. If that file already diff --git a/lisp/cedet/semantic/wisent/comp.el b/lisp/cedet/semantic/wisent/comp.el index 6b473f9ad81..f92ae88c14e 100644 --- a/lisp/cedet/semantic/wisent/comp.el +++ b/lisp/cedet/semantic/wisent/comp.el @@ -3484,6 +3484,9 @@ Automatically called by the Emacs Lisp byte compiler as a (macroexpand-all (wisent-automaton-lisp-form (eval form))))) +;; FIXME: We shouldn't use a `byte-compile' handler. Maybe using a hash-table +;; instead of an obarray would work around the problem that obarrays +;; aren't printable. Then (put 'wisent-compile-grammar 'side-effect-free t). (put 'wisent-compile-grammar 'byte-compile 'wisent-byte-compile-grammar) (defun wisent-automaton-lisp-form (automaton) diff --git a/lisp/emacs-lisp/byte-opt.el b/lisp/emacs-lisp/byte-opt.el index 35c9a5ddf45..548fcd133df 100644 --- a/lisp/emacs-lisp/byte-opt.el +++ b/lisp/emacs-lisp/byte-opt.el @@ -534,7 +534,6 @@ (cons fn (mapcar #'byte-optimize-form (cdr form)))) ((not (symbolp fn)) - (debug) (byte-compile-warn "`%s' is a malformed function" (prin1-to-string fn)) form) @@ -1455,8 +1454,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-stack-ref ;; byte-closed-var - )) + byte-current-buffer byte-stack-ref)) (defconst byte-compile-side-effect-free-ops (nconc @@ -2029,7 +2027,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (+ (cdr lap0) (cdr lap1)))) (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 @@ -2053,10 +2051,9 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." (setq lap (delq lap0 lap)) (setcar lap1 (if (= 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. + ;; 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. 'byte-discardN-preserve-tos ;; Otherwise, the value stored is lost, so just use a ;; normal discard. @@ -2071,8 +2068,7 @@ If FOR-EFFECT is non-nil, the return value is assumed to be of no importance." ;; discardN-(X+Y) ;; ((and (memq (car lap0) - '(byte-discard - byte-discardN + '(byte-discard byte-discardN byte-discardN-preserve-tos)) (memq (car lap1) '(byte-discard byte-discardN))) (setq lap (delq lap0 lap)) diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 5e671d7e694..7d259cda574 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -128,10 +128,6 @@ ;; 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) - - (defgroup bytecomp nil "Emacs Lisp byte-compiler." :group 'lisp) @@ -404,9 +400,7 @@ specify different fields to sort on." :type '(choice (const name) (const callers) (const calls) (const calls+callers) (const nil))) -(defvar byte-compile-debug t) -(setq debug-on-error t) - +(defvar byte-compile-debug nil) (defvar byte-compile-constants nil "List of all constants encountered during compilation of this form.") (defvar byte-compile-variables nil @@ -465,7 +459,7 @@ 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 +(defvar byte-compile--lexical-environment nil "The current lexical environment.") (defvar byte-compile-tag-number 0) @@ -586,6 +580,7 @@ Each element is (INDEX . VALUE)") (byte-defop 114 0 byte-save-current-buffer "To make a binding to record the current buffer") (byte-defop 115 0 byte-set-mark-OBSOLETE) +;; (byte-defop 116 1 byte-interactive-p) ;Let's not use it any more. ;; These ops are new to v19 (byte-defop 117 0 byte-forward-char) @@ -621,6 +616,8 @@ otherwise pop it") (byte-defop 138 0 byte-save-excursion "to make a binding to record the buffer, point and mark") +;; (byte-defop 139 0 byte-save-window-excursion ; Obsolete: It's a macro now. +;; "to make a binding to record entire window configuration") (byte-defop 140 0 byte-save-restriction "to make a binding to record the current buffer clipping restrictions") (byte-defop 141 -1 byte-catch @@ -632,16 +629,8 @@ otherwise pop it") ;; an expression for the body, and a list of clauses. (byte-defop 143 -2 byte-condition-case) -;; For entry to with-output-to-temp-buffer. -;; Takes, on stack, the buffer name. -;; Binds standard-output and does some other things. -;; Returns with temp buffer on the stack in place of buffer name. +;; Obsolete: `with-output-to-temp-buffer' is a macro now. ;; (byte-defop 144 0 byte-temp-output-buffer-setup) - -;; For exit from with-output-to-temp-buffer. -;; Expects the temp buffer on the stack underneath value to return. -;; Pops them both, then pushes the value back on. -;; Unbinds standard-output and makes the temp buffer visible. ;; (byte-defop 145 -1 byte-temp-output-buffer-show) ;; these ops are new to v19 @@ -675,15 +664,14 @@ 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) -(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 178 -1 byte-stack-set) ; Stack offset in following one byte. +(byte-defop 179 -1 byte-stack-set2) ; Stack offset in following two bytes. -;; if (following one byte & 0x80) == 0 +;; If (following one byte & 0x80) == 0 ;; discard (following one byte & 0x7F) stack entries ;; else ;; discard (following one byte & 0x7F) stack entries _underneath_ TOS @@ -776,12 +764,6 @@ CONST2 may be evaulated multiple times." (error "Non-symbolic opcode `%s'" op)) ((eq op 'TAG) (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 opcode (if (eq op 'byte-discardN-preserve-tos) @@ -793,13 +775,13 @@ CONST2 may be evaulated multiple times." (cond ((memq op byte-goto-ops) ;; goto (byte-compile-push-bytecodes opcode nil (cdr off) bytes pc) - (push bytes patchlist)) + (push bytes patchlist)) ((or (and (consp off) ;; Variable or constant reference (progn (setq off (cdr off)) (eq op 'byte-constant))) - (and (eq op 'byte-constant) ;; 'byte-closed-var + (and (eq op 'byte-constant) (integerp off))) ;; constant ref (if (< off byte-constant-limit) @@ -847,10 +829,9 @@ CONST2 may be evaulated multiple times." bytes pc)))))) ;;(if (not (= pc (length bytes))) ;; (error "Compiler error: pc mismatch - %s %s" pc (length bytes))) - - ;; Patch tag PCs into absolute jumps + ;; Patch tag PCs into absolute jumps. (dolist (bytes-tail patchlist) - (setq pc (caar bytes-tail)) ; Pick PC from goto's tag + (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. @@ -1861,10 +1842,10 @@ With argument ARG, insert value in current buffer after the form." ;; Dynamically bound in byte-compile-from-buffer. ;; NB also used in cl.el and cl-macs.el. -(defvar byte-compile-outbuffer) +(defvar byte-compile--outbuffer) (defun byte-compile-from-buffer (inbuffer) - (let (byte-compile-outbuffer + (let (byte-compile--outbuffer (byte-compile-current-buffer inbuffer) (byte-compile-read-position nil) (byte-compile-last-position nil) @@ -1893,7 +1874,8 @@ With argument ARG, insert value in current buffer after the form." ) (byte-compile-close-variables (with-current-buffer - (setq byte-compile-outbuffer (get-buffer-create " *Compiler Output*")) + (setq byte-compile--outbuffer + (get-buffer-create " *Compiler Output*")) (set-buffer-multibyte t) (erase-buffer) ;; (emacs-lisp-mode) @@ -1902,7 +1884,7 @@ With argument ARG, insert value in current buffer after the form." (with-current-buffer inbuffer (and byte-compile-current-file (byte-compile-insert-header byte-compile-current-file - byte-compile-outbuffer)) + byte-compile--outbuffer)) (goto-char (point-min)) ;; Should we always do this? When calling multiple files, it ;; would be useful to delay this warning until all have been @@ -1935,9 +1917,9 @@ and will be removed soon. See (elisp)Backquote in the manual.")) ;; Fix up the header at the front of the output ;; if the buffer contains multibyte characters. (and byte-compile-current-file - (with-current-buffer byte-compile-outbuffer + (with-current-buffer byte-compile--outbuffer (byte-compile-fix-header byte-compile-current-file))))) - byte-compile-outbuffer)) + byte-compile--outbuffer)) (defun byte-compile-fix-header (filename) "If the current buffer has any multibyte characters, insert a version test." @@ -2046,8 +2028,8 @@ Call from the source buffer." (print-gensym t) (print-circle ; handle circular data structures (not byte-compile-disable-print-circle))) - (princ "\n" byte-compile-outbuffer) - (prin1 form byte-compile-outbuffer) + (princ "\n" byte-compile--outbuffer) + (prin1 form byte-compile--outbuffer) nil))) (defvar print-gensym-alist) ;Used before print-circle existed. @@ -2067,7 +2049,7 @@ list that represents a doc string reference. ;; We need to examine byte-compile-dynamic-docstrings ;; in the input buffer (now current), not in the output buffer. (let ((dynamic-docstrings byte-compile-dynamic-docstrings)) - (with-current-buffer byte-compile-outbuffer + (with-current-buffer byte-compile--outbuffer (let (position) ;; Insert the doc string, and make it a comment with #@LENGTH. @@ -2091,7 +2073,7 @@ list that represents a doc string reference. (if preface (progn (insert preface) - (prin1 name byte-compile-outbuffer))) + (prin1 name byte-compile--outbuffer))) (insert (car info)) (let ((print-escape-newlines t) (print-quoted t) @@ -2106,7 +2088,7 @@ list that represents a doc string reference. (print-continuous-numbering t) print-number-table (index 0)) - (prin1 (car form) byte-compile-outbuffer) + (prin1 (car form) byte-compile--outbuffer) (while (setq form (cdr form)) (setq index (1+ index)) (insert " ") @@ -2129,21 +2111,22 @@ list that represents a doc string reference. (setq position (- (position-bytes position) (point-min) -1)) (princ (format "(#$ . %d) nil" position) - byte-compile-outbuffer) + byte-compile--outbuffer) (setq form (cdr form)) (setq index (1+ index)))) ((= index (nth 1 info)) (if position (princ (format (if quoted "'(#$ . %d)" "(#$ . %d)") position) - byte-compile-outbuffer) + byte-compile--outbuffer) (let ((print-escape-newlines nil)) (goto-char (prog1 (1+ (point)) - (prin1 (car form) byte-compile-outbuffer))) + (prin1 (car form) + byte-compile--outbuffer))) (insert "\\\n") (goto-char (point-max))))) (t - (prin1 (car form) byte-compile-outbuffer))))) + (prin1 (car form) byte-compile--outbuffer))))) (insert (nth 2 info))))) nil) @@ -2428,7 +2411,7 @@ by side-effects." ;; Remove declarations from the body of the macro definition. (when macrop (dolist (decl (byte-compile-defmacro-declaration form)) - (prin1 decl byte-compile-outbuffer))) + (prin1 decl byte-compile--outbuffer))) (let* ((code (byte-compile-lambda (nthcdr 2 form) t))) (if this-one @@ -2458,7 +2441,7 @@ by side-effects." (and (atom code) byte-compile-dynamic 1) nil)) - (princ ")" byte-compile-outbuffer) + (princ ")" byte-compile--outbuffer) nil))) ;; Print Lisp object EXP in the output file, inside a comment, @@ -2466,13 +2449,13 @@ by side-effects." ;; If QUOTED is non-nil, print with quoting; otherwise, print without quoting. (defun byte-compile-output-as-comment (exp quoted) (let ((position (point))) - (with-current-buffer byte-compile-outbuffer + (with-current-buffer byte-compile--outbuffer ;; Insert EXP, and make it a comment with #@LENGTH. (insert " ") (if quoted - (prin1 exp byte-compile-outbuffer) - (princ exp byte-compile-outbuffer)) + (prin1 exp byte-compile--outbuffer) + (princ exp byte-compile--outbuffer)) (goto-char position) ;; Quote certain special characters as needed. ;; get_doc_string in doc.c does the unquoting. @@ -2732,7 +2715,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (byte-compile-tag-number 0) (byte-compile-depth 0) (byte-compile-maxdepth 0) - (byte-compile-lexical-environment lexenv) + (byte-compile--lexical-environment lexenv) (byte-compile-reserved-constants (or reserved-csts 0)) (byte-compile-output nil)) (if (memq byte-optimize '(t source)) @@ -2743,7 +2726,7 @@ If FORM is a lambda or a macro, byte-compile it as a function." (when (and lexical-binding (eq output-type 'lambda)) ;; See how many arguments there are, and set the current stack depth ;; accordingly. - (setq byte-compile-depth (length byte-compile-lexical-environment)) + (setq byte-compile-depth (length byte-compile--lexical-environment)) ;; If there are args, output a tag to record the initial ;; stack-depth for the optimizer. (when (> byte-compile-depth 0) @@ -2789,7 +2772,6 @@ If FORM is a lambda or a macro, byte-compile it as a function." ;; progn -> as <> or (progn <> atom) ;; file -> as progn, but takes both quotes and atoms, and longer forms. (let (rest - (byte-compile--for-effect for-effect) ;FIXME: Probably unused! (maycall (not (eq output-type 'lambda))) ; t if we may make a funcall. tmp body) (cond @@ -2975,6 +2957,7 @@ That command is designed for interactive use only" fn)) (byte-compile-out-tag endtag))) (defun byte-compile-unfold-bcf (form) + "Inline call to byte-code-functions." (let* ((byte-compile-bound-variables byte-compile-bound-variables) (fun (car form)) (fargs (aref fun 0)) @@ -3056,7 +3039,7 @@ If BINDING is non-nil, VAR is being bound." (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))) + (let ((lex-binding (assq var byte-compile--lexical-environment))) (if lex-binding ;; VAR is lexically bound (byte-compile-stack-ref (cdr lex-binding)) @@ -3072,7 +3055,7 @@ If BINDING is non-nil, VAR is being bound." (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))) + (let ((lex-binding (assq var byte-compile--lexical-environment))) (if lex-binding ;; VAR is lexically bound (byte-compile-stack-set (cdr lex-binding)) @@ -3181,6 +3164,7 @@ If it is nil, then the handler is \"byte-compile-SYMBOL.\"" (byte-defop-compiler bobp 0) (byte-defop-compiler current-buffer 0) ;;(byte-defop-compiler read-char 0) ;; obsolete +;; (byte-defop-compiler interactive-p 0) ;; Obsolete. (byte-defop-compiler widen 0) (byte-defop-compiler end-of-line 0-1) (byte-defop-compiler forward-char 0-1) @@ -3355,6 +3339,7 @@ discarding." (defconst byte-compile--env-var (make-symbol "env")) (defun byte-compile-make-closure (form) + "Byte-compile the special `internal-make-closure' form." (if byte-compile--for-effect (setq byte-compile--for-effect nil) (let* ((vars (nth 1 form)) (env (nth 2 form)) @@ -3366,12 +3351,11 @@ discarding." ',(aref fun 0) ',(aref fun 1) (vconcat (vector . ,env) ',(aref fun 2)) ,@(nthcdr 3 (mapcar (lambda (x) `',x) fun))))))) - (defun byte-compile-get-closed-var (form) + "Byte-compile the special `internal-get-closed-var' form." (if byte-compile--for-effect (setq byte-compile--for-effect nil) - (byte-compile-out 'byte-constant ;; byte-closed-var - (nth 1 form)))) + (byte-compile-out 'byte-constant (nth 1 form)))) ;; Compile a function that accepts one or more args and is right-associative. ;; We do it by left-associativity so that the operations @@ -3856,7 +3840,7 @@ Return the offset in the form (VAR . OFFSET)." (keywordp var))) (defun byte-compile-bind (var init-lexenv) - "Emit byte-codes to bind VAR and update `byte-compile-lexical-environment'. + "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. Return non-nil if the TOS value was popped." @@ -3866,7 +3850,7 @@ Return non-nil if the TOS value was popped." (cond ((not (byte-compile-not-lexical-var-p var)) ;; VAR is a simple stack-allocated lexical variable (push (assq var init-lexenv) - byte-compile-lexical-environment) + byte-compile--lexical-environment) nil) ((eq var (caar init-lexenv)) ;; VAR is dynamic and is on the top of the @@ -3898,7 +3882,7 @@ binding slots have been popped." (let ((num-dynamic-bindings 0)) (dolist (clause clauses) (unless (assq (if (consp clause) (car clause) clause) - byte-compile-lexical-environment) + byte-compile--lexical-environment) (setq num-dynamic-bindings (1+ num-dynamic-bindings)))) (unless (zerop num-dynamic-bindings) (byte-compile-out 'byte-unbind num-dynamic-bindings))) @@ -3918,7 +3902,8 @@ binding slots have been popped." (push (byte-compile-push-binding-init var) init-lexenv))) ;; New scope. (let ((byte-compile-bound-variables byte-compile-bound-variables) - (byte-compile-lexical-environment byte-compile-lexical-environment)) + (byte-compile--lexical-environment + byte-compile--lexical-environment)) ;; Bind the variables. ;; For `let', do it in reverse order, because it makes no ;; semantic difference, but it is a lot more efficient since the @@ -3969,7 +3954,6 @@ binding slots have been popped." "Compiler error: `%s' has no `byte-compile-negated-op' property" (car form))) (cdr form)))) - ;;; other tricky macro-like special-forms @@ -3979,6 +3963,8 @@ binding slots have been popped." (byte-defop-compiler-1 save-excursion) (byte-defop-compiler-1 save-current-buffer) (byte-defop-compiler-1 save-restriction) +;; (byte-defop-compiler-1 save-window-excursion) ;Obsolete: now a macro. +;; (byte-defop-compiler-1 with-output-to-temp-buffer) ;Obsolete: now a macro. (byte-defop-compiler-1 track-mouse) (defun byte-compile-catch (form) @@ -4286,7 +4272,7 @@ OP and OPERAND are as passed to `byte-compile-out'." ;; 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) @@ -4298,50 +4284,6 @@ OP and OPERAND are as passed to `byte-compile-out'." (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/cconv.el b/lisp/emacs-lisp/cconv.el index 46d14880a2c..5cc9ecb4cf7 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el @@ -67,15 +67,23 @@ ;; TODO: (not just for cconv but also for the lexbind changes in general) ;; - let (e)debug find the value of lexical variables from the stack. +;; - make eval-region do the eval-sexp-add-defvars danse. ;; - byte-optimize-form should be applied before cconv. ;; OTOH, the warnings emitted by cconv-analyze need to come before optimize ;; since afterwards they can because obnoxious (warnings about an "unused ;; variable" should not be emitted when the variable use has simply been ;; optimized away). +;; - turn defun and defmacro into macros (and remove special handling of +;; `declare' afterwards). +;; - let macros specify that some let-bindings come from the same source, +;; so the unused warning takes all uses into account. +;; - let interactive specs return a function to build the args (to stash into +;; command-history). ;; - canonize code in macro-expand so we don't have to handle (let (var) body) ;; and other oddities. ;; - new byte codes for unwind-protect, catch, and condition-case so that ;; closures aren't needed at all. +;; - inline source code of different binding mode by first compiling it. ;; - a reference to a var that is known statically to always hold a constant ;; should be turned into a byte-constant rather than a byte-stack-ref. ;; Hmm... right, that's called constant propagation and could be done here, diff --git a/lisp/emacs-lisp/cl-loaddefs.el b/lisp/emacs-lisp/cl-loaddefs.el index 8bcbd67f46b..4c824d4a6d4 100644 --- a/lisp/emacs-lisp/cl-loaddefs.el +++ b/lisp/emacs-lisp/cl-loaddefs.el @@ -282,7 +282,7 @@ Not documented ;;;;;; flet progv psetq do-all-symbols do-symbols dotimes dolist ;;;;;; do* do loop return-from return block etypecase typecase ecase ;;;;;; case load-time-value eval-when destructuring-bind function* -;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "c4734fbda33043d967624d39d80c3304") +;;;;;; defmacro* defun* gentemp gensym) "cl-macs" "cl-macs.el" "fe8a5acbe14e32846a77578b2165fab5") ;;; Generated autoloads from cl-macs.el (autoload 'gensym "cl-macs" "\ diff --git a/lisp/emacs-lisp/cl-macs.el b/lisp/emacs-lisp/cl-macs.el index 7aac5bdaa01..9ce3dd6a7fe 100644 --- a/lisp/emacs-lisp/cl-macs.el +++ b/lisp/emacs-lisp/cl-macs.el @@ -497,7 +497,7 @@ The result of the body appears to the compiler as a quoted constant." (symbol-function 'byte-compile-file-form))) (list 'byte-compile-file-form (list 'quote set)) '(byte-compile-file-form form))) - (print set (symbol-value 'byte-compile-outbuffer))) + (print set (symbol-value 'byte-compile--outbuffer))) (list 'symbol-value (list 'quote temp))) (list 'quote (eval form)))) diff --git a/lisp/emacs-lisp/cl.el b/lisp/emacs-lisp/cl.el index 9c626dfcfa3..526475eb1bd 100644 --- a/lisp/emacs-lisp/cl.el +++ b/lisp/emacs-lisp/cl.el @@ -278,9 +278,9 @@ definitions to shadow the loaded ones for use in file byte-compilation. (defvar cl-compiling-file nil) (defun cl-compiling-file () (or cl-compiling-file - (and (boundp 'byte-compile-outbuffer) - (bufferp (symbol-value 'byte-compile-outbuffer)) - (equal (buffer-name (symbol-value 'byte-compile-outbuffer)) + (and (boundp 'byte-compile--outbuffer) + (bufferp (symbol-value 'byte-compile--outbuffer)) + (equal (buffer-name (symbol-value 'byte-compile--outbuffer)) " *Compiler Output*")))) (defvar cl-proclaims-deferred nil) diff --git a/lisp/emacs-lisp/disass.el b/lisp/emacs-lisp/disass.el index 9318876fe61..4fd10185c17 100644 --- a/lisp/emacs-lisp/disass.el +++ b/lisp/emacs-lisp/disass.el @@ -72,7 +72,6 @@ redefine OBJECT if it is a symbol." (let ((macro 'nil) (name 'nil) (doc 'nil) - (lexical-binding nil) args) (while (symbolp obj) (setq name obj diff --git a/lisp/emacs-lisp/edebug.el b/lisp/emacs-lisp/edebug.el index 8135b5c4f24..f84de0308bf 100644 --- a/lisp/emacs-lisp/edebug.el +++ b/lisp/emacs-lisp/edebug.el @@ -3640,7 +3640,7 @@ Return the result of the last expression." (eval (if (bound-and-true-p cl-debug-env) (cl-macroexpand-all edebug-expr cl-debug-env) edebug-expr) - lexical-binding)) ;; FIXME: lexbind. + lexical-binding)) (defun edebug-safe-eval (edebug-expr) ;; Evaluate EXPR safely. diff --git a/lisp/emacs-lisp/eieio.el b/lisp/emacs-lisp/eieio.el index 4e443452d8b..7a119e6bbc0 100644 --- a/lisp/emacs-lisp/eieio.el +++ b/lisp/emacs-lisp/eieio.el @@ -96,6 +96,7 @@ default setting for optimization purposes.") "Non-nil means to optimize the method dispatch on primary methods.") ;; State Variables +;; FIXME: These two constants below should have an `eieio-' prefix added!! (defvar this nil "Inside a method, this variable is the object in question. DO NOT SET THIS YOURSELF unless you are trying to simulate friendly slots. @@ -122,7 +123,7 @@ execute a `call-next-method'. DO NOT SET THIS YOURSELF!") ;; while it is being built itself. (defvar eieio-default-superclass nil) -;; FIXME: The constants below should have a `eieio-' prefix added!! +;; FIXME: The constants below should have an `eieio-' prefix added!! (defconst class-symbol 1 "Class's symbol (self-referencing.).") (defconst class-parent 2 "Class parent slot.") (defconst class-children 3 "Class children class slot.") diff --git a/lisp/emacs-lisp/lisp-mode.el b/lisp/emacs-lisp/lisp-mode.el index 408774fbbf1..39bdb505039 100644 --- a/lisp/emacs-lisp/lisp-mode.el +++ b/lisp/emacs-lisp/lisp-mode.el @@ -745,7 +745,7 @@ POS specifies the starting position where EXP was found and defaults to point." (unless (special-variable-p var) (push var vars)))) `(progn ,@(mapcar (lambda (v) `(defvar ,v)) vars) ,exp))))) - + (defun eval-last-sexp (eval-last-sexp-arg-internal) "Evaluate sexp before point; print value in minibuffer. Interactively, with prefix argument, print output into current buffer. diff --git a/src/ChangeLog b/src/ChangeLog index e34cd694321..04064adbaa3 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,8 @@ +2011-04-01 Stefan Monnier + + * bytecode.c (Fbyte_code): Revert to old calling convention. + * lisp.h (COMPILED_PUSH_ARGS): Remove, unused. + 2011-03-16 Stefan Monnier * image.c (parse_image_spec): Use Ffunctionp. diff --git a/src/bytecode.c b/src/bytecode.c index 01ae8055ebf..5d94cb0fb39 100644 --- a/src/bytecode.c +++ b/src/bytecode.c @@ -51,7 +51,7 @@ by Hallvard: * * define BYTE_CODE_METER to enable generation of a byte-op usage histogram. */ -#define BYTE_CODE_SAFE 1 +/* #define BYTE_CODE_SAFE */ /* #define BYTE_CODE_METER */ @@ -160,7 +160,7 @@ extern Lisp_Object Qand_optional, Qand_rest; #ifdef BYTE_CODE_SAFE #define Bset_mark 0163 /* this loser is no longer generated as of v18 */ #endif -#define Binteractive_p 0164 /* Obsolete. */ +#define Binteractive_p 0164 /* Obsolete since Emacs-24.1. */ #define Bforward_char 0165 #define Bforward_word 0166 @@ -185,16 +185,16 @@ extern Lisp_Object Qand_optional, Qand_rest; #define Bdup 0211 #define Bsave_excursion 0212 -#define Bsave_window_excursion 0213 /* Obsolete. */ +#define Bsave_window_excursion 0213 /* Obsolete since Emacs-24.1. */ #define Bsave_restriction 0214 #define Bcatch 0215 #define Bunwind_protect 0216 #define Bcondition_case 0217 -#define Btemp_output_buffer_setup 0220 /* Obsolete. */ -#define Btemp_output_buffer_show 0221 /* Obsolete. */ +#define Btemp_output_buffer_setup 0220 /* Obsolete since Emacs-24.1. */ +#define Btemp_output_buffer_show 0221 /* Obsolete since Emacs-24.1. */ -#define Bunbind_all 0222 /* Obsolete. */ +#define Bunbind_all 0222 /* Obsolete. Never used. */ #define Bset_marker 0223 #define Bmatch_beginning 0224 @@ -413,24 +413,15 @@ unmark_byte_stack (void) } while (0) -DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, MANY, 0, +DEFUN ("byte-code", Fbyte_code, Sbyte_code, 3, 3, 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. - -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) */) - (size_t nargs, Lisp_Object *args) +If the third argument is incorrect, Emacs may crash. */) + (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth) { - 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); + return exec_byte_code (bytestr, vector, maxdepth, Qnil, 0, NULL); } /* Execute the byte-code in BYTESTR. VECTOR is the constant vector, and @@ -810,7 +801,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Bunbind_all: /* Obsolete. */ + case Bunbind_all: /* Obsolete. Never used. */ /* To unbind back to the beginning of this frame. Not used yet, but will be needed for tail-recursion elimination. */ BEFORE_POTENTIAL_GC (); @@ -938,12 +929,12 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, save_excursion_save ()); break; - case Bsave_current_buffer: /* Obsolete. */ + case Bsave_current_buffer: /* Obsolete since ??. */ case Bsave_current_buffer_1: record_unwind_protect (set_buffer_if_live, Fcurrent_buffer ()); break; - case Bsave_window_excursion: /* Obsolete. */ + case Bsave_window_excursion: /* Obsolete since 24.1. */ { register int count = SPECPDL_INDEX (); record_unwind_protect (Fset_window_configuration, @@ -985,7 +976,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, break; } - case Btemp_output_buffer_setup: /* Obsolete. */ + case Btemp_output_buffer_setup: /* Obsolete since 24.1. */ BEFORE_POTENTIAL_GC (); CHECK_STRING (TOP); temp_output_buffer_setup (SSDATA (TOP)); @@ -993,7 +984,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, TOP = Vstandard_output; break; - case Btemp_output_buffer_show: /* Obsolete. */ + case Btemp_output_buffer_show: /* Obsolete since 24.1. */ { Lisp_Object v1; BEFORE_POTENTIAL_GC (); @@ -1465,7 +1456,7 @@ exec_byte_code (Lisp_Object bytestr, Lisp_Object vector, Lisp_Object maxdepth, AFTER_POTENTIAL_GC (); break; - case Binteractive_p: /* Obsolete. */ + case Binteractive_p: /* Obsolete since 24.1. */ PUSH (Finteractive_p ()); break; diff --git a/src/callint.c b/src/callint.c index 489fa392e46..60570369d9e 100644 --- a/src/callint.c +++ b/src/callint.c @@ -171,8 +171,8 @@ static void fix_command (Lisp_Object input, Lisp_Object values) { /* FIXME: Instead of this ugly hack, we should provide a way for an - interactive spec to return an expression that will re-build the args - without user intervention. */ + interactive spec to return an expression/function that will re-build the + args without user intervention. */ if (CONSP (input)) { Lisp_Object car; diff --git a/src/eval.c b/src/eval.c index 9f90e6df4b5..0e47d7c757c 100644 --- a/src/eval.c +++ b/src/eval.c @@ -117,10 +117,10 @@ Lisp_Object Vsignaling_function; int handling_signal; -static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); static Lisp_Object funcall_lambda (Lisp_Object, size_t, Lisp_Object *); static void unwind_to_catch (struct catchtag *, Lisp_Object) NO_RETURN; static int interactive_p (int); +static Lisp_Object apply_lambda (Lisp_Object fun, Lisp_Object args); void init_eval_once (void) @@ -684,7 +684,7 @@ usage: (defmacro NAME ARGLIST [DOCSTRING] [DECL] BODY...) */) tail = Fcons (lambda_list, tail); else tail = Fcons (lambda_list, Fcons (doc, tail)); - + defn = Fcons (Qlambda, tail); if (!NILP (Vinternal_interpreter_environment)) /* Mere optimization! */ defn = Ffunction (Fcons (defn, Qnil)); @@ -1012,11 +1012,8 @@ usage: (let* VARLIST BODY...) */) varlist = XCDR (varlist); } - UNGCPRO; - val = Fprogn (Fcdr (args)); - return unbind_to (count, val); } @@ -2083,7 +2080,8 @@ then strings and vectors are not accepted. */) return Qnil; funcar = XCAR (fun); if (EQ (funcar, Qclosure)) - return !NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) ? Qt : if_prop; + return (!NILP (Fassq (Qinteractive, Fcdr (Fcdr (XCDR (fun))))) + ? Qt : if_prop); else if (EQ (funcar, Qlambda)) return !NILP (Fassq (Qinteractive, Fcdr (XCDR (fun)))) ? Qt : if_prop; else if (EQ (funcar, Qautoload)) @@ -2898,7 +2896,7 @@ call7 (Lisp_Object fn, Lisp_Object arg1, Lisp_Object arg2, Lisp_Object arg3, /* 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. */) + doc: /* Non-nil if OBJECT is a function. */) (Lisp_Object object) { if (SYMBOLP (object) && !NILP (Ffboundp (object))) @@ -3220,7 +3218,7 @@ funcall_lambda (Lisp_Object fun, size_t nargs, xsignal2 (Qwrong_number_of_arguments, fun, make_number (nargs)); else val = Qnil; - + /* Bind the argument. */ if (!NILP (lexenv) && SYMBOLP (next)) /* Lexically bind NEXT by adding it to the lexenv alist. */ @@ -3501,7 +3499,6 @@ context where binding is lexical by default. */) } - 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. */) diff --git a/src/lisp.h b/src/lisp.h index bd70dcebbdb..580dbd11013 100644 --- a/src/lisp.h +++ b/src/lisp.h @@ -1483,7 +1483,6 @@ typedef unsigned char UCHAR; #define COMPILED_STACK_DEPTH 3 #define COMPILED_DOC_STRING 4 #define COMPILED_INTERACTIVE 5 -#define COMPILED_PUSH_ARGS 6 /* Flag bits in a character. These also get used in termhooks.h. Richard Stallman thinks that MULE @@ -3264,7 +3263,7 @@ extern int read_bytecode_char (int); /* Defined in bytecode.c */ extern Lisp_Object Qbytecode; -EXFUN (Fbyte_code, MANY); +EXFUN (Fbyte_code, 3); extern void syms_of_bytecode (void); extern struct byte_stack *byte_stack_list; #ifdef BYTE_MARK_STACK diff --git a/src/lread.c b/src/lread.c index 24183532527..6a24569f552 100644 --- a/src/lread.c +++ b/src/lread.c @@ -796,16 +796,16 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) } 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; \ +#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. */ @@ -834,7 +834,7 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) UPDATE_BEG_END_STATE (ch); ch = READCHAR; } - + while (var_end > var && (var_end[-1] == ' ' || var_end[-1] == '\t')) var_end--; @@ -880,7 +880,6 @@ lisp_file_lexically_bound_p (Lisp_Object readcharfun) 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 @@ -1275,7 +1274,6 @@ 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; @@ -1863,11 +1861,9 @@ 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); + specbind (Qlexical_binding, lisp_file_lexically_bound_p (buf) ? Qt : Qnil); readevalloop (buf, 0, filename, !NILP (printflag), unibyte, Qnil, Qnil, Qnil); unbind_to (count, Qnil); @@ -3336,7 +3332,6 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) for (i = 0; i < size; i++) { item = Fcar (tem); - /* 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 @@ -3394,7 +3389,6 @@ read_vector (Lisp_Object readcharfun, int bytecodeflag) tem = Fcdr (tem); free_cons (otem); } - return vector; } @@ -4024,7 +4018,6 @@ 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. */ @@ -4470,7 +4463,7 @@ to load. See also `load-dangerous-libraries'. */); 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'. */); + Lisp file read using `load'. */); Fmake_variable_buffer_local (Qlexical_binding); DEFVAR_LISP ("eval-buffer-list", Veval_buffer_list, diff --git a/src/window.c b/src/window.c index 4bd533c22ac..7e40cdff42b 100644 --- a/src/window.c +++ b/src/window.c @@ -3649,6 +3649,7 @@ displaying that buffer. */) return Qnil; } + void temp_output_buffer_show (register Lisp_Object buf) { diff --git a/test/automated/lexbind-tests.el b/test/automated/lexbind-tests.el index 1ff31e2422d..95b8bbe8858 100644 --- a/test/automated/lexbind-tests.el +++ b/test/automated/lexbind-tests.el @@ -3,7 +3,7 @@ ;; Copyright (C) 2011 Free Software Foundation, Inc. ;; Author: Stefan Monnier -;; Keywords: +;; Keywords: ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -20,7 +20,7 @@ ;;; Commentary: -;; +;; ;;; Code: