;;; bytecomp.el --- compilation of Lisp code into byte code
;; Copyright (C) 1985, 1986, 1987, 1992, 1994, 1998, 2000, 2001, 2002,
-;; 2003, 2004, 2005 Free Software Foundation, Inc.
+;; 2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; Hallvard Furuseth <hbf@ulrik.uio.no>
;; The user may want to redefine this along with emacs-lisp-file-regexp,
;; so only define it if it is undefined.
(defun byte-compile-dest-file (filename)
- "Convert an Emacs Lisp source file name to a compiled file name."
+ "Convert an Emacs Lisp source file name to a compiled file name.
+If FILENAME matches `emacs-lisp-file-regexp' (by default, files
+with the extension `.el'), add `c' to it; otherwise add `.elc'."
(setq filename (byte-compiler-base-file-name filename))
(setq filename (file-name-sans-versions filename))
(cond ((eq system-type 'vax-vms)
;; this way can never be run in Emacs 18, and may even cause it to crash.")
(defcustom byte-optimize t
- "*Enables optimization in the byte compiler.
-nil means don't do any optimization.
-t means do all optimizations.
-`source' means do source-level optimizations only.
-`byte' means do code-level optimizations only."
+ "*Enable optimization in the byte compiler.
+Possible values are:
+ nil - no optimization
+ t - all optimizations
+ `source' - source-level optimizations only
+ `byte' - code-level optimizations only"
:group 'bytecomp
:type '(choice (const :tag "none" nil)
(const :tag "all" t)
When this option is true, if you load the compiled file and then move it,
the functions you loaded will not be able to run.")
+;;;###autoload(put 'byte-compile-dynamic 'safe-local-variable 'booleanp)
+
+(defvar byte-compile-disable-print-circle nil
+ "If non-nil, disable `print-circle' on printing a byte-compiled code.")
+;;;###autoload(put 'byte-compile-disable-print-circle 'safe-local-variable 'booleanp)
(defcustom byte-compile-dynamic-docstrings t
"*If non-nil, compile doc strings for lazy access.
This option is enabled by default because it reduces Emacs memory usage."
:group 'bytecomp
:type 'boolean)
+;;;###autoload(put 'byte-compile-dynamic-docstrings 'safe-local-variable 'booleanp)
(defcustom byte-optimize-log nil
"*If true, the byte-compiler will log its optimizations into *Compile-Log*.
(defcustom byte-compile-warnings t
"*List of warnings that the byte-compiler should issue (t for all).
-Elements of the list may be be:
+Elements of the list may be:
free-vars references to variables not in the current lexical scope.
unresolved calls to unknown functions.
(const callargs) (const redefine)
(const obsolete) (const noruntime)
(const cl-functions) (const interactive-only))))
+(put 'byte-compile-warnings 'safe-local-variable 'byte-compile-warnings-safe-p)
+;;;###autoload
+(defun byte-compile-warnings-safe-p (x)
+ (or (booleanp x)
+ (and (listp x)
+ (equal (mapcar
+ (lambda (e)
+ (when (memq e '(free-vars unresolved
+ callargs redefine
+ obsolete noruntime
+ cl-functions interactive-only))
+ e))
+ x)
+ x))))
(defvar byte-compile-interactive-only-functions
'(beginning-of-buffer end-of-buffer replace-string replace-regexp
;; list. If our current position is after the symbol's position, we
;; assume we've already passed that point, and look for the next
;; occurrence of the symbol.
+;;
+;; This function should not be called twice for the same occurrence of
+;; a symbol, and it should not be called for symbols generated by the
+;; byte compiler itself; because rather than just fail looking up the
+;; symbol, we may find an occurrence of the symbol further ahead, and
+;; then `byte-compile-last-position' as advanced too far.
+;;
;; So your're probably asking yourself: Isn't this function a
;; gross hack? And the answer, of course, would be yes.
(defun byte-compile-set-symbol-position (sym &optional allow-previous)
(pos (if (and byte-compile-current-file
(integerp byte-compile-read-position))
(with-current-buffer byte-compile-current-buffer
- (format "%d:%d:" (count-lines (point-min)
- byte-compile-last-position)
+ (format "%d:%d:"
+ (save-excursion
+ (goto-char byte-compile-last-position)
+ (1+ (count-lines (point-min) (point-at-bol))))
(save-excursion
(goto-char byte-compile-last-position)
(1+ (current-column)))))
This is normally set in local file variables at the end of the elisp file:
;; Local Variables:\n;; no-byte-compile: t\n;; End: ")
+;;;###autoload(put 'no-byte-compile 'safe-local-variable 'booleanp)
;;;###autoload
(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 made by appending `c' to the end of FILENAME.
+The output file's name is generated by passing FILENAME to the
+`byte-compile-dest-file' function (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")
;; If they change the file name, then change it for the output also.
(let ((buffer-file-name filename)
(default-major-mode 'emacs-lisp-mode)
+ ;; Ignore unsafe local variables.
+ ;; We only care about a few of them for our purposes.
+ (enable-local-variables :safe)
(enable-local-eval nil))
- (normal-mode)
+ ;; Arg of t means don't alter enable-local-variables.
+ (normal-mode t)
(setq filename buffer-file-name))
;; Set the default directory, in case an eval-when-compile uses it.
(setq default-directory (file-name-directory filename)))
(print-length nil)
(print-level nil)
(print-quoted t)
- (print-gensym t))
+ (print-gensym t)
+ (print-circle ; handle circular data structures
+ (not byte-compile-disable-print-circle)))
(princ "\n" outbuffer)
(prin1 form outbuffer)
nil)))
;; print-gensym-alist not to be cleared
;; between calls to print functions.
(print-gensym '(t))
+ (print-circle ; handle circular data structures
+ (not byte-compile-disable-print-circle))
print-gensym-alist ; was used before print-circle existed.
(print-continuous-numbering t)
print-number-table
(eq (car (car (cdr tail))) 'declare))
(let ((declaration (car (cdr tail))))
(setcdr tail (cdr (cdr tail)))
- (princ `(if macro-declaration-function
+ (prin1 `(if macro-declaration-function
(funcall macro-declaration-function
',name ',declaration))
outbuffer)))))
- (let* ((new-one (byte-compile-lambda (cons 'lambda (nthcdr 2 form))))
+ (let* ((new-one (byte-compile-lambda (nthcdr 2 form) t))
(code (byte-compile-byte-code-maker new-one)))
(if this-one
(setcdr this-one new-one)
;; Byte-compile a lambda-expression and return a valid function.
;; The value is usually a compiled function but may be the original
;; lambda-expression.
-(defun byte-compile-lambda (fun)
- (unless (eq 'lambda (car-safe fun))
- (error "Not a lambda list: %S" fun))
- (byte-compile-set-symbol-position 'lambda)
+;; When ADD-LAMBDA is non-nil, the symbol `lambda' is added as head
+;; 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 (fun &optional add-lambda)
+ (if add-lambda
+ (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 fun))
(let* ((arglist (nth 1 fun))
(byte-compile-bound-variables
(byte-compile-warn "`%s' used from Lisp code\n\
That command is designed for interactive use only" fn))
(if (and handler
- (or (not (byte-compile-version-cond
- byte-compile-compatibility))
- (not (get (get fn 'byte-opcode) 'emacs19-opcode))))
- (progn
- (byte-compile-set-symbol-position fn)
- (funcall handler form))
+ ;; 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.
+ (or (not (memq handler '(cl-byte-compile-compiler-macro)))
+ (functionp handler))
+ (not (and (byte-compile-version-cond
+ byte-compile-compatibility)
+ (get (get fn 'byte-opcode) 'emacs19-opcode))))
+ (funcall handler form)
(when (memq 'callargs byte-compile-warnings)
(if (memq fn '(custom-declare-group custom-declare-variable custom-declare-face))
(byte-compile-nogroup-warn form))
(defmacro byte-compile-get-constant (const)
`(or (if (stringp ,const)
- (assoc-default ,const byte-compile-constants
- 'equal-including-properties nil)
+ ;; In a string constant, treat properties as significant.
+ (let (result)
+ (dolist (elt byte-compile-constants)
+ (if (equal-including-properties (car elt) ,const)
+ (setq result elt)))
+ result)
(assq ,const byte-compile-constants))
(car (setq byte-compile-constants
(cons (list ,const) byte-compile-constants)))))
\f
;; more complicated compiler macros
+(byte-defop-compiler char-before)
+(byte-defop-compiler backward-char)
+(byte-defop-compiler backward-word)
(byte-defop-compiler list)
(byte-defop-compiler concat)
(byte-defop-compiler fset)
(byte-defop-compiler19 (/ byte-quo) byte-compile-quo)
(byte-defop-compiler19 nconc)
+(defun byte-compile-char-before (form)
+ (cond ((= 2 (length form))
+ (byte-compile-form (list 'char-after (if (numberp (nth 1 form))
+ (1- (nth 1 form))
+ `(1- ,(nth 1 form))))))
+ ((= 1 (length form))
+ (byte-compile-form '(char-after (1- (point)))))
+ (t (byte-compile-subr-wrong-args form "0-1"))))
+
+;; backward-... ==> forward-... with negated argument.
+(defun byte-compile-backward-char (form)
+ (cond ((= 2 (length form))
+ (byte-compile-form (list 'forward-char (if (numberp (nth 1 form))
+ (- (nth 1 form))
+ `(- ,(nth 1 form))))))
+ ((= 1 (length form))
+ (byte-compile-form '(forward-char -1)))
+ (t (byte-compile-subr-wrong-args form "0-1"))))
+
+(defun byte-compile-backward-word (form)
+ (cond ((= 2 (length form))
+ (byte-compile-form (list 'forward-word (if (numberp (nth 1 form))
+ (- (nth 1 form))
+ `(- ,(nth 1 form))))))
+ ((= 1 (length form))
+ (byte-compile-form '(forward-word -1)))
+ (t (byte-compile-subr-wrong-args form "0-1"))))
+
(defun byte-compile-list (form)
(let ((count (length (cdr form))))
(cond ((= count 0)
(list 'fset
(list 'quote (nth 1 form))
(byte-compile-byte-code-maker
- (byte-compile-lambda (cons 'lambda (cdr (cdr form)))))))
+ (byte-compile-lambda (cdr (cdr form)) t))))
(byte-compile-discard))
;; We prefer to generate a defalias form so it will record the function
;; definition just like interpreting a defun.
(list 'defalias
(list 'quote (nth 1 form))
(byte-compile-byte-code-maker
- (byte-compile-lambda (cons 'lambda (cdr (cdr form))))))
+ (byte-compile-lambda (cdr (cdr form)) t)))
t))
(byte-compile-constant (nth 1 form)))
(byte-compile-body-do-effect
(list (list 'fset (list 'quote (nth 1 form))
(let ((code (byte-compile-byte-code-maker
- (byte-compile-lambda
- (cons 'lambda (cdr (cdr form)))))))
+ (byte-compile-lambda (cdr (cdr form)) t))))
(if (eq (car-safe code) 'make-byte-code)
(list 'cons ''macro code)
(list 'quote (cons 'macro (eval code))))))
(push (cons (nth 1 (nth 1 form))
(if constant (nth 1 (nth 2 form)) t))
byte-compile-function-environment)))
- (byte-compile-normal-call form))
+ ;; We used to jus do: (byte-compile-normal-call form)
+ ;; But it turns out that this fails to optimize the code.
+ ;; So instead we now do the same as what other byte-hunk-handlers do,
+ ;; which is to call back byte-compile-file-form and then return nil.
+ ;; Except that we can't just call byte-compile-file-form since it would
+ ;; call us right back.
+ (byte-compile-keep-pending form)
+ ;; Return nil so the form is not output twice.
+ nil)
;; Turn off warnings about prior calls to the function being defalias'd.
;; This could be smarter and compare those calls with
(defun batch-byte-recompile-directory (&optional arg)
"Run `byte-recompile-directory' on the dirs remaining on the command line.
Must be used only with `-batch', and kills Emacs on completion.
-For example, invoke `emacs -batch -f batch-byte-recompile-directory .'."
+For example, invoke `emacs -batch -f batch-byte-recompile-directory .'.
+
+Optional argument ARG is passed as second argument ARG to
+`batch-recompile-directory'; see there for its possible values
+and corresponding effects."
;; command-line-args-left is what is left of the command line (startup.el)
(defvar command-line-args-left) ;Avoid 'free variable' warning
(if (not noninteractive)