;; 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:
;; ========================================================================
(eval-when-compile . ,(lambda (&rest body)
(let ((result nil))
(byte-compile-recurse-toplevel
- (cons 'progn body)
+ (macroexp-progn body)
(lambda (form)
(setf result
(byte-compile-eval
(list 'quote result))))
(eval-and-compile . ,(lambda (&rest body)
(byte-compile-recurse-toplevel
- (cons 'progn body)
+ (macroexp-progn body)
(lambda (form)
;; Don't compile here, since we don't know
;; whether to compile as byte-compile-form
(lambda (x) (if (symbolp x) (list 'prin1-to-string x) x))
args))))))
+(defvar byte-compile--interactive nil
+ "Determine if `byte-compile--message' uses the minibuffer.")
+
+(defun byte-compile--message (format &rest args)
+ "Like `message', except sometimes don't print to minibuffer.
+If the variable `byte-compile--interactive' is nil, the message
+is not displayed on the minibuffer."
+ (apply #'message format args)
+ (unless byte-compile--interactive
+ (message nil)))
+
;; Log something that isn't a warning.
(defun byte-compile-log-1 (string)
(with-current-buffer byte-compile-log-buffer
(goto-char (point-max))
(byte-compile-warning-prefix nil nil)
(cond (noninteractive
- (message " %s" string))
+ (byte-compile--message " %s" string))
(t
(insert (format "%s\n" string)))))))
(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)))
"Recompile every `.el' file in DIRECTORY that already has a `.elc' file.
Files in subdirectories of DIRECTORY are processed also."
(interactive "DByte force recompile (directory): ")
- (byte-recompile-directory directory nil t))
+ (let ((byte-compile--interactive
+ (or byte-compile--interactive
+ (called-interactively-p 'any))))
+ (byte-recompile-directory directory nil t)))
;;;###autoload
(defun byte-recompile-directory (directory &optional arg force)
(compilation-mode))
(let ((directories (list default-directory))
(default-directory default-directory)
+ (byte-compile--interactive
+ (or byte-compile--interactive
+ (called-interactively-p 'any)))
(skip-count 0)
(fail-count 0)
(file-count 0)
(displaying-byte-compile-warnings
(while directories
(setq directory (car directories))
- (message "Checking %s..." directory)
+ (byte-compile--message "Checking %s..." directory)
(dolist (file (directory-files directory))
(let ((source (expand-file-name file directory)))
(if (file-directory-p source)
(`t file-count)
(_ fail-count)))
(or noninteractive
- (message "Checking %s..." directory))
+ (byte-compile--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)"
+ (byte-compile--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) "")
(if (> skip-count 0) (format ", %d skipped" skip-count) "")
current-prefix-arg)))
(let ((dest (byte-compile-dest-file filename))
;; Expand now so we get the current buffer's defaults
- (filename (expand-file-name filename)))
+ (filename (expand-file-name filename))
+ (byte-compile--interactive
+ (or byte-compile--interactive
+ (called-interactively-p 'any))))
(if (if (file-exists-p dest)
;; File was already compiled
;; Compile if forced to, or filename newer
filename "? ")))))
(progn
(if (and noninteractive (not byte-compile-verbose))
- (message "Compiling %s..." filename))
+ (byte-compile--message "Compiling %s..." filename))
(byte-compile-file filename load))
(when load
(load (if (file-exists-p dest) dest filename)))
(let ((byte-compile-current-file filename)
(byte-compile-current-group nil)
(set-auto-coding-for-load t)
+ (byte-compile--interactive
+ (or byte-compile--interactive
+ (called-interactively-p 'any)))
target-file input-buffer output-buffer
byte-compile-dest-file)
(setq target-file (byte-compile-dest-file filename))
(progn
(setq-default major-mode 'emacs-lisp-mode)
;; Arg of t means don't alter enable-local-variables.
- (normal-mode t))
+ (delay-mode-hooks (normal-mode t)))
(setq-default major-mode dmm))
;; There may be a file local variable setting (bug#10419).
(setq buffer-read-only nil
;; (byte-compile-abbreviate-file filename)
;; (with-current-buffer input-buffer no-byte-compile))
(when (file-exists-p target-file)
- (message "%s deleted because of `no-byte-compile: %s'"
+ (byte-compile--message "%s deleted because of `no-byte-compile: %s'"
(byte-compile-abbreviate-file target-file)
(buffer-local-value 'no-byte-compile input-buffer))
(condition-case nil (delete-file target-file) (error nil)))
;; We successfully didn't compile this file.
'no-byte-compile)
(when byte-compile-verbose
- (message "Compiling %s..." filename))
+ (byte-compile--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
(if byte-compiler-error-flag
nil
(when byte-compile-verbose
- (message "Compiling %s...done" filename))
+ (byte-compile--message "Compiling %s...done" filename))
(kill-buffer input-buffer)
(with-current-buffer output-buffer
(goto-char (point-max))
;; recompiled). Previously this was accomplished by
;; deleting target-file before writing it.
(rename-file tempfile target-file t)
- (or noninteractive (message "Wrote %s" target-file)))
+ (or noninteractive (byte-compile--message "Wrote %s" target-file)))
;; This is just to give a better error message than write-region
(signal 'file-error
(list "Opening output file"
(byte-compile-read-position (point))
(byte-compile-last-position byte-compile-read-position)
(byte-compile-last-warned-form 'nothing)
+ (byte-compile--interactive
+ (or byte-compile--interactive
+ (called-interactively-p 'any)))
(value (eval
(let ((read-with-symbol-positions (current-buffer))
(read-symbol-positions-list nil))
(byte-compile-sexp (read (current-buffer)))))
lexical-binding)))
(cond (arg
- (message "Compiling from buffer... done.")
+ (byte-compile--message "Compiling from buffer... done.")
(prin1 value (current-buffer))
(insert "\n"))
- ((message "%s" (prin1-to-string value)))))))
+ ((byte-compile--message "%s" (prin1-to-string value)))))))
(defun byte-compile-from-buffer (inbuffer)
(let ((byte-compile-current-buffer inbuffer)
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)
(byte-compile-arglist-warn name arglist macro))
(if byte-compile-verbose
- (message "Compiling %s... (%s)"
+ (byte-compile--message "Compiling %s... (%s)"
(or byte-compile-current-file "") name))
(cond ((not (or macro (listp body)))
;; We do not know positively if the definition is a macro
;; error to a simple message for the known case where signaling an error
;; causes problems.
((byte-code-function-p fun)
- (message "Function %s is already compiled"
+ (byte-compile--message "Function %s is already compiled"
(if (symbolp form) form "provided"))
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."
name macro arglist body rest)
(when macro
(if (null fun)
- (message "Macro %s unrecognized, won't work in file" name)
- (message "Macro %s partly recognized, trying our luck" name)
+ (byte-compile--message "Macro %s unrecognized, won't work in file" name)
+ (byte-compile--message "Macro %s partly recognized, trying our luck" name)
(push (cons name (eval fun))
byte-compile-macro-environment)))
(byte-compile-keep-pending form))))
\(that is, to which no calls have been compiled\), and which cannot be
invoked interactively."
(interactive)
- (message "Generating call tree...")
+ (byte-compile--message "Generating call tree...")
(with-output-to-temp-buffer "*Call-Tree*"
(set-buffer "*Call-Tree*")
(erase-buffer)
- (message "Generating call tree... (sorting on %s)"
+ (byte-compile--message "Generating call tree... (sorting on %s)"
byte-compile-call-tree-sort)
(insert "Call tree for "
(cond ((null byte-compile-current-file) (or filename "???"))