diff options
Diffstat (limited to 'lisp/emacs-lisp/bytecomp.el')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 92 |
1 files changed, 50 insertions, 42 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 03c45e44a56..f176e769bf5 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -129,6 +129,7 @@ ;; us from emitting warnings when compiling files which use cl-lib without ;; requiring it! (bug#30635) (eval-when-compile (require 'cl-lib)) +(eval-when-compile (require 'subr-x)) ;; The feature of compiling in a specific target Emacs version ;; has been turned off because compile time options are a bad idea. @@ -1185,27 +1186,22 @@ message buffer `default-directory'." (defun byte-compile--first-symbol-with-pos (form) "Return the first symbol with position in form, or nil if none. Order is by depth-first search." - (cond - ((symbol-with-pos-p form) form) - ((consp form) - (or (byte-compile--first-symbol-with-pos (car form)) - (let ((sym nil)) - (setq form (cdr form)) - (while (and (consp form) - (not (setq sym (byte-compile--first-symbol-with-pos - (car form))))) - (setq form (cdr form))) - (or sym - (and form (byte-compile--first-symbol-with-pos form)))))) - ((or (vectorp form) (recordp form)) - (let ((len (length form)) - (i 0) - (sym nil)) - (while (and (< i len) - (not (setq sym (byte-compile--first-symbol-with-pos - (aref form i))))) - (setq i (1+ i))) - sym)))) + (named-let loop ((form form) + (depth 10)) ;Arbitrary limit. + (cond + ((<= depth 0) nil) ;Avoid cycles (bug#58601). + ((symbol-with-pos-p form) form) + ((consp form) + (or (loop (car form) (1- depth)) + (loop (cdr form) (1- depth)))) + ((or (vectorp form) (recordp form)) + (let ((len (length form)) + (i 0) + (sym nil)) + (while (and (< i len) + (not (setq sym (loop (aref form i) (1- depth))))) + (setq i (1+ i))) + sym))))) (defun byte-compile--warning-source-offset () "Return a source offset from `byte-compile-form-stack' or nil if none." @@ -1405,11 +1401,11 @@ when printing the error message." (and (not macro-p) (compiled-function-p (symbol-function fn))))) (setq fn (symbol-function fn))) - (let ((advertised (gethash (if (and (symbolp fn) (fboundp fn)) - ;; Could be a subr. - (symbol-function fn) - fn) - advertised-signature-table t))) + (let ((advertised (get-advertised-calling-convention + (if (and (symbolp fn) (fboundp fn)) + ;; Could be a subr. + (symbol-function fn) + fn)))) (cond ((listp advertised) (if macro-p @@ -1469,9 +1465,11 @@ when printing the error message." (defun byte-compile-arglist-signature-string (signature) (cond ((null (cdr signature)) - (format "%d+" (car signature))) + (format "%d or more" (car signature))) ((= (car signature) (cdr signature)) (format "%d" (car signature))) + ((= (1+ (car signature)) (cdr signature)) + (format "%d or %d" (car signature) (cdr signature))) (t (format "%d-%d" (car signature) (cdr signature))))) (defun byte-compile-function-warn (f nargs def) @@ -1884,6 +1882,9 @@ Files in subdirectories of DIRECTORY are processed also." (interactive "DByte force recompile (directory): ") (byte-recompile-directory directory nil t)) +(defvar byte-compile-ignore-files nil + "List of regexps for files to ignore during byte compilation.") + ;;;###autoload (defun byte-recompile-directory (directory &optional arg force follow-symlinks) "Recompile every `.el' file in DIRECTORY that needs recompilation. @@ -1940,14 +1941,22 @@ also be compiled." ;; This file is a subdirectory. Handle them differently. (or (null arg) (eq 0 arg) (y-or-n-p (concat "Check " source "? "))) - (setq directories (nconc directories (list source)))) + ;; Directory is requested to be ignored + (not (string-match-p + (regexp-opt byte-compile-ignore-files) + 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) ;; The next 2 tests avoid compiling lock files (file-readable-p source) (not (string-match "\\`\\.#" file)) (not (auto-save-file-name-p source)) - (not (member source (dir-locals--all-files directory)))) + (not (member source (dir-locals--all-files directory))) + ;; File is requested to be ignored + (not (string-match-p + (regexp-opt byte-compile-ignore-files) + source))) (progn (cl-incf (pcase (byte-recompile-file source force arg) ('no-byte-compile skip-count) @@ -2321,9 +2330,15 @@ With argument ARG, insert value in current buffer after the form." (setq case-fold-search nil)) (displaying-byte-compile-warnings (with-current-buffer inbuffer - (and byte-compile-current-file - (byte-compile-insert-header byte-compile-current-file - byte-compile--outbuffer)) + (when byte-compile-current-file + (byte-compile-insert-header byte-compile-current-file + byte-compile--outbuffer) + ;; Instruct native-comp to ignore this file. + (when (bound-and-true-p no-native-compile) + (with-current-buffer byte-compile--outbuffer + (insert + "(when (boundp 'comp--no-native-compile) + (puthash load-file-name t comp--no-native-compile))\n\n")))) (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 @@ -2561,7 +2576,7 @@ list that represents a doc string reference. ;; macroexpand-all. ;; (if (memq byte-optimize '(t source)) ;; (setq form (byte-optimize-form form for-effect))) - (cconv-closure-convert form)) + (cconv-closure-convert form byte-compile-bound-variables)) ;; byte-hunk-handlers cannot call this! (defun byte-compile-toplevel-file-form (top-level-form) @@ -3622,7 +3637,7 @@ lambda-expression." (byte-compile-out base-op tmp))) (defun byte-compile-dynamic-variable-bind (var) - "Generate code to bind the lexical variable VAR to the top-of-stack value." + "Generate code to bind the dynamic variable VAR to the top-of-stack value." (byte-compile-check-variable var 'let-bind) (push var byte-compile-bound-variables) (byte-compile-dynamic-variable-op 'byte-varbind var)) @@ -4659,13 +4674,6 @@ Return the offset in the form (VAR . OFFSET)." (byte-compile-form (cadr clause)) (byte-compile-push-constant nil))))) -(defun byte-compile-not-lexical-var-p (var) - (or (not (symbolp var)) - (special-variable-p var) - (memq var byte-compile-bound-variables) - (memq var '(nil t)) - (keywordp var))) - (defun byte-compile-bind (var init-lexenv) "Emit byte-codes to bind VAR and update `byte-compile--lexical-environment'. INIT-LEXENV should be a lexical-environment alist describing the @@ -4674,7 +4682,7 @@ Return non-nil if the TOS value was popped." ;; The mix of lexical and dynamic bindings mean that we may have to ;; juggle things on the stack, to move them to TOS for ;; dynamic binding. - (if (and lexical-binding (not (byte-compile-not-lexical-var-p var))) + (if (not (cconv--not-lexical-var-p var byte-compile-bound-variables)) ;; VAR is a simple stack-allocated lexical variable. (progn (push (assq var init-lexenv) byte-compile--lexical-environment) |