diff options
Diffstat (limited to 'lisp/emacs-lisp/bytecomp.el')
-rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 104 |
1 files changed, 54 insertions, 50 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 392f6ee83cd..7fd72dd7705 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -461,10 +461,13 @@ Return the compile-time value of FORM." (byte-compile-recurse-toplevel (cons 'progn body) (lambda (form) - (let ((compiled (byte-compile-top-level - (byte-compile-preprocess form)))) - (eval compiled lexical-binding) - compiled)))))) + ;; 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)))))) "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.") @@ -1361,6 +1364,33 @@ extra args." ;; Warn if the function or macro is being redefined with a different ;; number of arguments. (defun byte-compile-arglist-warn (name arglist macrop) + ;; This is the first definition. See if previous calls are compatible. + (let ((calls (assq name byte-compile-unresolved-functions)) + nums sig min max) + (when (and calls macrop) + (byte-compile-warn "macro `%s' defined too late" name)) + (setq byte-compile-unresolved-functions + (delq calls byte-compile-unresolved-functions)) + (setq calls (delq t calls)) ;Ignore higher-order uses of the function. + (when (cdr calls) + (when (and (symbolp name) + (eq (function-get name 'byte-optimizer) + 'byte-compile-inline-expand)) + (byte-compile-warn "defsubst `%s' was used before it was defined" + name)) + (setq sig (byte-compile-arglist-signature arglist) + nums (sort (copy-sequence (cdr calls)) (function <)) + min (car nums) + max (car (nreverse nums))) + (when (or (< min (car sig)) + (and (cdr sig) (> max (cdr sig)))) + (byte-compile-set-symbol-position name) + (byte-compile-warn + "%s being defined to take %s%s, but was previously called with %s" + name + (byte-compile-arglist-signature-string sig) + (if (equal sig '(1 . 1)) " arg" " args") + (byte-compile-arglist-signature-string (cons min max)))))) (let* ((old (byte-compile-fdefinition name macrop)) (initial (and macrop (cdr (assq name @@ -1369,52 +1399,26 @@ extra args." ;; to a defined function. (Bug#8646) (and initial (symbolp initial) (setq old (byte-compile-fdefinition initial nil))) - (if (and old (not (eq old t))) - (progn - (and (eq 'macro (car-safe old)) - (eq 'lambda (car-safe (cdr-safe old))) - (setq old (cdr old))) - (let ((sig1 (byte-compile-arglist-signature - (pcase old - (`(lambda ,args . ,_) args) - (`(closure ,_ ,args . ,_) args) - ((pred byte-code-function-p) (aref old 0)) - (t '(&rest def))))) - (sig2 (byte-compile-arglist-signature arglist))) - (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) - (byte-compile-set-symbol-position name) - (byte-compile-warn - "%s %s used to take %s %s, now takes %s" - (if macrop "macro" "function") - name - (byte-compile-arglist-signature-string sig1) - (if (equal sig1 '(1 . 1)) "argument" "arguments") - (byte-compile-arglist-signature-string sig2))))) - ;; This is the first definition. See if previous calls are compatible. - (let ((calls (assq name byte-compile-unresolved-functions)) - nums sig min max) - (setq byte-compile-unresolved-functions - (delq calls byte-compile-unresolved-functions)) - (setq calls (delq t calls)) ;Ignore higher-order uses of the function. - (when (cdr calls) - (when (and (symbolp name) - (eq (function-get name 'byte-optimizer) - 'byte-compile-inline-expand)) - (byte-compile-warn "defsubst `%s' was used before it was defined" - name)) - (setq sig (byte-compile-arglist-signature arglist) - nums (sort (copy-sequence (cdr calls)) (function <)) - min (car nums) - max (car (nreverse nums))) - (when (or (< min (car sig)) - (and (cdr sig) (> max (cdr sig)))) - (byte-compile-set-symbol-position name) - (byte-compile-warn - "%s being defined to take %s%s, but was previously called with %s" - name - (byte-compile-arglist-signature-string sig) - (if (equal sig '(1 . 1)) " arg" " args") - (byte-compile-arglist-signature-string (cons min max))))))))) + (when (and old (not (eq old t))) + (and (eq 'macro (car-safe old)) + (eq 'lambda (car-safe (cdr-safe old))) + (setq old (cdr old))) + (let ((sig1 (byte-compile-arglist-signature + (pcase old + (`(lambda ,args . ,_) args) + (`(closure ,_ ,args . ,_) args) + ((pred byte-code-function-p) (aref old 0)) + (t '(&rest def))))) + (sig2 (byte-compile-arglist-signature arglist))) + (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) + (byte-compile-set-symbol-position name) + (byte-compile-warn + "%s %s used to take %s %s, now takes %s" + (if macrop "macro" "function") + name + (byte-compile-arglist-signature-string sig1) + (if (equal sig1 '(1 . 1)) "argument" "arguments") + (byte-compile-arglist-signature-string sig2))))))) (defvar byte-compile-cl-functions nil "List of functions defined in CL.") |