diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2011-03-16 16:08:39 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2011-03-16 16:08:39 -0400 |
commit | ca1055060d5793e368c1a165c412944d6800c3a6 (patch) | |
tree | 81c850f1a6fdee4a2faea041d72212569bc6ff4f /lisp | |
parent | 2663659f1f1a8566cf0f602969f85965a398f618 (diff) | |
download | emacs-ca1055060d5793e368c1a165c412944d6800c3a6.tar.gz |
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.
Diffstat (limited to 'lisp')
-rw-r--r-- | lisp/ChangeLog | 20 | ||||
-rw-r--r-- | lisp/emacs-lisp/byte-opt.el | 164 | ||||
-rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 527 | ||||
-rw-r--r-- | lisp/emacs-lisp/cconv.el | 31 | ||||
-rw-r--r-- | lisp/emacs-lisp/cl-loaddefs.el | 2 | ||||
-rw-r--r-- | lisp/emacs-lisp/cl-macs.el | 2 | ||||
-rw-r--r-- | lisp/emacs-lisp/cl.el | 6 | ||||
-rw-r--r-- | lisp/emacs-lisp/pcase.el | 63 | ||||
-rw-r--r-- | lisp/startup.el | 1 | ||||
-rw-r--r-- | lisp/subr.el | 3 |
10 files changed, 440 insertions, 379 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 <monnier@iro.umontreal.ca> + + * 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 <monnier@iro.umontreal.ca> * 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-<foo>' 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))) |