;;; bytecomp.el --- compilation of Lisp code into byte code -*- lexical-binding: t -*-
-;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2014 Free Software
+;; Copyright (C) 1985-1987, 1992, 1994, 1998, 2000-2015 Free Software
;; Foundation, Inc.
;; Author: Jamie Zawinski <jwz@lucid.com>
;; faster. [`LAP' == `Lisp Assembly Program'.]
;; The user entry points are byte-compile-file and byte-recompile-directory.
+;;; Todo:
+
+;; - Turn "not bound at runtime" functions into autoloads.
+
;;; Code:
;; ========================================================================
This list lives partly on the stack.")
(defvar byte-compile-lexical-variables nil
"List of variables that have been treated as lexical.
-Filled in `cconv-analyse-form' but initialized and consulted here.")
+Filled in `cconv-analyze-form' but initialized and consulted here.")
(defvar byte-compile-const-variables nil
"List of variables declared as constants during compilation of this file.")
(defvar byte-compile-free-references)
;; 3.2.3.1, "Processing of Top Level Forms". The semantics are very
;; subtle: see test/automated/bytecomp-tests.el for interesting
;; cases.
- (setf form (macroexpand form byte-compile-macro-environment))
+ (setf form (macroexp-macroexpand form byte-compile-macro-environment))
(if (eq (car-safe form) 'progn)
(cons 'progn
(mapcar (lambda (subform)
;; (apply 'byte-compiler-options-handler forms)))
(declare-function . byte-compile-macroexpand-declare-function)
(eval-when-compile . ,(lambda (&rest body)
- (let ((result nil))
- (byte-compile-recurse-toplevel
- (cons 'progn body)
- (lambda (form)
- (setf result
- (byte-compile-eval
- (byte-compile-top-level
- (byte-compile-preprocess form))))))
- (list 'quote result))))
+ (let ((result nil))
+ (byte-compile-recurse-toplevel
+ (macroexp-progn body)
+ (lambda (form)
+ (setf result
+ (byte-compile-eval
+ (byte-compile-top-level
+ (byte-compile-preprocess form))))))
+ (list 'quote result))))
(eval-and-compile . ,(lambda (&rest body)
- (byte-compile-recurse-toplevel
- (cons 'progn body)
- (lambda (form)
- ;; Don't compile here, since we don't know
- ;; whether to compile as byte-compile-form
- ;; or byte-compile-file-form.
- (let ((expanded
- (byte-compile-preprocess form)))
- (eval expanded lexical-binding)
- expanded))))))
+ (byte-compile-recurse-toplevel
+ (macroexp-progn body)
+ (lambda (form)
+ ;; Don't compile here, since we don't know
+ ;; whether to compile as byte-compile-form
+ ;; or byte-compile-file-form.
+ (let ((expanded
+ (macroexpand-all
+ form
+ macroexpand-all-environment)))
+ (eval expanded lexical-binding)
+ expanded))))))
"The default macro-environment passed to macroexpand by the compiler.
Placing a macro here will cause a macro to have different semantics when
expanded by the compiler as when expanded by the interpreter.")
(byte-compile-warn "%s" msg)))))
(defun byte-compile-report-error (error-info)
- "Report Lisp error in compilation. ERROR-INFO is the error data."
+ "Report Lisp error in compilation.
+ERROR-INFO is the error data, in the form of either (ERROR-SYMBOL . DATA)
+or STRING."
(setq byte-compiler-error-flag t)
(byte-compile-log-warning
- (error-message-string error-info)
+ (if (stringp error-info) error-info
+ (error-message-string error-info))
nil :error))
\f
;;; sanity-checking arglists
(let ((keyword-args (cdr (cdr (cdr (cdr form)))))
(name (cadr form)))
(or (not (eq (car-safe name) 'quote))
- (and (eq (car form) 'custom-declare-group)
- (equal name ''emacs))
- (plist-get keyword-args :group)
- (not (and (consp name) (eq (car name) 'quote)))
- (byte-compile-warn
- "%s for `%s' fails to specify containing group"
- (cdr (assq (car form)
+ (and (eq (car form) 'custom-declare-group)
+ (equal name ''emacs))
+ (plist-get keyword-args :group)
+ (not (and (consp name) (eq (car name) 'quote)))
+ (byte-compile-warn
+ "%s for `%s' fails to specify containing group"
+ (cdr (assq (car form)
'((custom-declare-group . defgroup)
(custom-declare-face . defface)
(custom-declare-variable . defcustom))))
;; These would sometimes be warned about
;; but such warnings are never useful,
;; so don't warn about them.
- macroexpand cl-macroexpand-all
+ macroexpand
cl--compiling-file))))
(byte-compile-warn "function `%s' from cl package called at runtime"
func)))
;; recompiled). Previously this was accomplished by
;; deleting target-file before writing it.
(rename-file tempfile target-file t)
- (message "Wrote %s" target-file))
+ (or noninteractive (message "Wrote %s" target-file)))
;; This is just to give a better error message than write-region
(signal 'file-error
(list "Opening output file"
(if (file-exists-p target-file)
- "cannot overwrite file"
- "directory not writable or nonexistent")
+ "Cannot overwrite file"
+ "Directory not writable or nonexistent")
target-file)))
(kill-buffer (current-buffer)))
(if (and byte-compile-generate-call-tree
(eq (aref (nth (nth 1 info) form) 0) ?*))
(setq position (- position)))))
- (if preface
- (progn
- (insert preface)
- (prin1 name byte-compile--outbuffer)))
- (insert (car info))
(let ((print-continuous-numbering t)
print-number-table
(index 0)
(print-gensym t)
(print-circle ; Handle circular data structures.
(not byte-compile-disable-print-circle)))
+ (if preface
+ (progn
+ ;; FIXME: We don't handle uninterned names correctly.
+ ;; E.g. if cl-define-compiler-macro uses uninterned name we get:
+ ;; (defalias '#1=#:foo--cmacro #[514 ...])
+ ;; (put 'foo 'compiler-macro '#:foo--cmacro)
+ (insert preface)
+ (prin1 name byte-compile--outbuffer)))
+ (insert (car info))
(prin1 (car form) byte-compile--outbuffer)
(while (setq form (cdr form))
(setq index (1+ index))
form))
(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))))
- (byte-compile--declare-var (car-safe (cdr (cadr form)))))
+ 'byte-compile-file-form-defvar-function)
+(put 'defvaralias 'byte-hunk-handler 'byte-compile-file-form-defvar-function)
+
+(defun byte-compile-file-form-defvar-function (form)
+ (pcase-let (((or `',name (let name nil)) (nth 1 form)))
+ (if name (byte-compile--declare-var name)))
(byte-compile-keep-pending form))
(put 'custom-declare-variable 'byte-hunk-handler
(defun byte-compile-file-form-custom-declare-variable (form)
(when (byte-compile-warning-enabled-p 'callargs)
(byte-compile-nogroup-warn form))
- (byte-compile--declare-var (nth 1 (nth 1 form)))
- (byte-compile-keep-pending form))
+ (byte-compile-file-form-defvar-function form))
(put 'require 'byte-hunk-handler 'byte-compile-file-form-require)
(defun byte-compile-file-form-require (form)
fun)
(t
(when (symbolp form)
- (unless (memq (car-safe fun) '(closure lambda))
- (error "Don't know how to compile %S" fun))
(setq lexical-binding (eq (car fun) 'closure))
(setq fun (byte-compile--reify-function fun)))
- (unless (eq (car-safe fun) 'lambda)
- (error "Don't know how to compile %S" fun))
;; Expand macros.
(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 (byte-compile-lambda fun))
+ (setq fun (byte-compile-top-level fun nil 'eval))
(if macro (push 'macro fun))
(if (symbolp form)
(fset form fun)
(interactive-only
(or (get fn 'interactive-only)
(memq fn byte-compile-interactive-only-functions))))
+ (when (memq fn '(set symbol-value run-hooks ;; add-to-list
+ add-hook remove-hook run-hook-with-args
+ run-hook-with-args-until-success
+ run-hook-with-args-until-failure))
+ (pcase (cdr form)
+ (`(',var . ,_)
+ (when (assq var byte-compile-lexical-variables)
+ (byte-compile-log-warning
+ (format "%s cannot use lexical var `%s'" fn var)
+ nil :error)))))
(when (macroexp--const-symbol-p fn)
(byte-compile-warn "`%s' called as a function" fn))
(when (and (byte-compile-warning-enabled-p 'interactive-only)
(dotimes (_ (- (/ (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-log-warning
+ (format "Too many arguments for inlined function %S" form)
+ nil :error)
(byte-compile-discard (- alen (/ fmax2 2))))
(t
;; Turn &rest args into a list.
(if byte-compile--for-effect (setq byte-compile--for-effect nil)
(let* ((vars (nth 1 form))
(env (nth 2 form))
- (body (nthcdr 3 form))
+ (docstring-exp (nth 3 form))
+ (body (nthcdr 4 form))
(fun
(byte-compile-lambda `(lambda ,vars . ,body) nil (length env))))
- (cl-assert (> (length env) 0)) ;Otherwise, we don't need a closure.
+ (cl-assert (or (> (length env) 0)
+ docstring-exp)) ;Otherwise, we don't need a closure.
(cl-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)))))))
+ ,@(let ((rest (nthcdr 3 (mapcar (lambda (x) `',x) fun))))
+ (if docstring-exp
+ `(,(car rest)
+ ,docstring-exp
+ ,@(cddr rest))
+ rest)))))))
(defun byte-compile-get-closed-var (form)
"Byte-compile the special `internal-get-closed-var' form."
;; 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.
+ ;; FIXME: If `foo' is obsoleted by `bar', the code below
+ ;; correctly arranges to silence the warnings after testing
+ ;; existence of `foo', but the warning should also be
+ ;; silenced after testing the existence of `bar'.
(let ((byte-compile-not-obsolete-vars
(append byte-compile-not-obsolete-vars bound-list))
(byte-compile-not-obsolete-funcs