Mercurial > emacs
comparison lisp/emacs-lisp/bytecomp.el @ 46136:79f132657570
(byte-compile-warning-types):
Rename cl-func to cl-functions. Enable it by default.
(byte-compile-file-form-eval-boundary):
Turn off cl-functions warnings if the file loads cl.
(byte-compile-initial-macro-environment): For eval-and-compile,
use byte-compile-eval-before-compile to eval.
(byte-compile-eval-before-compile): New function to turn off
cl-functions when appropriate, for eval-and-compile.
(byte-compile-warnings): Add cl-func option.
(byte-compile-cl-warn): New function.
(byte-compile-form): Use it, to warn about calling cl functions.
author | Richard M. Stallman <rms@gnu.org> |
---|---|
date | Tue, 02 Jul 2002 18:48:34 +0000 |
parents | 9c0b15b35ce2 |
children | 00b0a792b2ff |
comparison
equal
deleted
inserted
replaced
46135:742f54d0aedb | 46136:79f132657570 |
---|---|
8 ;; Maintainer: FSF | 8 ;; Maintainer: FSF |
9 ;; Keywords: lisp | 9 ;; Keywords: lisp |
10 | 10 |
11 ;;; This version incorporates changes up to version 2.10 of the | 11 ;;; This version incorporates changes up to version 2.10 of the |
12 ;;; Zawinski-Furuseth compiler. | 12 ;;; Zawinski-Furuseth compiler. |
13 (defconst byte-compile-version "$Revision: 2.100 $") | 13 (defconst byte-compile-version "$Revision: 2.101 $") |
14 | 14 |
15 ;; This file is part of GNU Emacs. | 15 ;; This file is part of GNU Emacs. |
16 | 16 |
17 ;; GNU Emacs is free software; you can redistribute it and/or modify | 17 ;; GNU Emacs is free software; you can redistribute it and/or modify |
18 ;; it under the terms of the GNU General Public License as published by | 18 ;; it under the terms of the GNU General Public License as published by |
325 "*If true, the byte-compiler reports warnings with `error'." | 325 "*If true, the byte-compiler reports warnings with `error'." |
326 :group 'bytecomp | 326 :group 'bytecomp |
327 :type 'boolean) | 327 :type 'boolean) |
328 | 328 |
329 (defconst byte-compile-warning-types | 329 (defconst byte-compile-warning-types |
330 '(redefine callargs free-vars unresolved obsolete noruntime)) | 330 '(redefine callargs free-vars unresolved obsolete noruntime cl-functions) |
331 "The list of warning types used when `byte-compile-warnings' is t.") | |
331 (defcustom byte-compile-warnings t | 332 (defcustom byte-compile-warnings t |
332 "*List of warnings that the byte-compiler should issue (t for all). | 333 "*List of warnings that the byte-compiler should issue (t for all). |
334 | |
333 Elements of the list may be be: | 335 Elements of the list may be be: |
334 | 336 |
335 free-vars references to variables not in the current lexical scope. | 337 free-vars references to variables not in the current lexical scope. |
336 unresolved calls to unknown functions. | 338 unresolved calls to unknown functions. |
337 callargs lambda calls with args that don't match the definition. | 339 callargs lambda calls with args that don't match the definition. |
338 redefine function cell redefined from a macro to a lambda or vice | 340 redefine function cell redefined from a macro to a lambda or vice |
339 versa, or redefined to take a different number of arguments. | 341 versa, or redefined to take a different number of arguments. |
340 obsolete obsolete variables and functions." | 342 obsolete obsolete variables and functions. |
343 noruntime functions that may not be defined at runtime (typically | |
344 defined only under `eval-when-compile'). | |
345 cl-functions calls to runtime functions from the CL package (as | |
346 distinguished from macros and aliases)." | |
341 :group 'bytecomp | 347 :group 'bytecomp |
342 :type '(choice (const :tag "All" t) | 348 :type `(choice (const :tag "All" t) |
343 (set :menu-tag "Some" | 349 (set :menu-tag "Some" |
344 (const free-vars) (const unresolved) | 350 (const free-vars) (const unresolved) |
345 (const callargs) (const redefined) | 351 (const callargs) (const redefine) |
346 (const obsolete) (const noruntime)))) | 352 (const obsolete) (const noruntime) (const cl-functions)))) |
347 | 353 |
348 (defcustom byte-compile-generate-call-tree nil | 354 (defcustom byte-compile-generate-call-tree nil |
349 "*Non-nil means collect call-graph information when compiling. | 355 "*Non-nil means collect call-graph information when compiling. |
350 This records functions were called and from where. | 356 This records functions were called and from where. |
351 If the value is t, compilation displays the call graph when it finishes. | 357 If the value is t, compilation displays the call graph when it finishes. |
409 (eval-when-compile . (lambda (&rest body) | 415 (eval-when-compile . (lambda (&rest body) |
410 (list 'quote | 416 (list 'quote |
411 (byte-compile-eval (byte-compile-top-level | 417 (byte-compile-eval (byte-compile-top-level |
412 (cons 'progn body)))))) | 418 (cons 'progn body)))))) |
413 (eval-and-compile . (lambda (&rest body) | 419 (eval-and-compile . (lambda (&rest body) |
414 (eval (cons 'progn body)) | 420 (byte-compile-eval-before-compile (cons 'progn body)) |
415 (cons 'progn body)))) | 421 (cons 'progn body)))) |
416 "The default macro-environment passed to macroexpand by the compiler. | 422 "The default macro-environment passed to macroexpand by the compiler. |
417 Placing a macro here will cause a macro to have different semantics when | 423 Placing a macro here will cause a macro to have different semantics when |
418 expanded by the compiler as when expanded by the interpreter.") | 424 expanded by the compiler as when expanded by the interpreter.") |
419 | 425 |
788 (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig))) | 794 (while (and hist-nil-new (not (eq hist-nil-new hist-nil-orig))) |
789 (let ((s (pop hist-nil-new))) | 795 (let ((s (pop hist-nil-new))) |
790 (when (symbolp s) | 796 (when (symbolp s) |
791 (put s 'byte-compile-noruntime t))))))))) | 797 (put s 'byte-compile-noruntime t))))))))) |
792 | 798 |
799 (defun byte-compile-eval-before-compile (form) | |
800 "Evaluate FORM for `eval-and-compile'." | |
801 (let ((hist-nil-orig current-load-list)) | |
802 (prog1 (eval form) | |
803 ;; (eval-and-compile (require 'cl) turns off warnings for cl functions. | |
804 (let ((tem current-load-list)) | |
805 (while (not (eq tem hist-nil-orig)) | |
806 (when (equal (car tem) '(require . cl)) | |
807 (setq byte-compile-warnings | |
808 (remq 'cl-functions byte-compile-warnings))) | |
809 (setq tem (cdr tem))))))) | |
793 | 810 |
794 ;;; byte compiler messages | 811 ;;; byte compiler messages |
795 | 812 |
796 (defvar byte-compile-current-form nil) | 813 (defvar byte-compile-current-form nil) |
797 (defvar byte-compile-dest-file nil) | 814 (defvar byte-compile-dest-file nil) |
1172 (byte-compile-arglist-signature-string (cons min max)))) | 1189 (byte-compile-arglist-signature-string (cons min max)))) |
1173 | 1190 |
1174 (setq byte-compile-unresolved-functions | 1191 (setq byte-compile-unresolved-functions |
1175 (delq calls byte-compile-unresolved-functions))))) | 1192 (delq calls byte-compile-unresolved-functions))))) |
1176 ))) | 1193 ))) |
1194 | |
1195 (defun byte-compile-cl-warn (form) | |
1196 "Warn if FORM is a call of a function from the CL package." | |
1197 (let* ((func (car-safe form)) | |
1198 (library | |
1199 (if func | |
1200 (cond ((eq (car-safe func) 'autoload) | |
1201 (nth 1 func)) | |
1202 ((symbol-file func)))))) | |
1203 (if (and library | |
1204 (string-match "^cl\\>" library) | |
1205 ;; Aliases which won't have been expended at this point. | |
1206 ;; These aren't all aliases of subrs, so not trivial to | |
1207 ;; avoid hardwiring the list. | |
1208 (not (memq func | |
1209 '(cl-block-wrapper cl-block-throw values values-list | |
1210 multiple-value-list multiple-value-call nth-value | |
1211 copy-seq first second rest endp cl-member)))) | |
1212 (byte-compile-warn "Function `%s' from cl package called at runtime" | |
1213 func))) | |
1214 form) | |
1177 | 1215 |
1178 (defun byte-compile-print-syms (str1 strn syms) | 1216 (defun byte-compile-print-syms (str1 strn syms) |
1179 (when syms | 1217 (when syms |
1180 (byte-compile-set-symbol-position (car syms) t)) | 1218 (byte-compile-set-symbol-position (car syms) t)) |
1181 (cond ((and (cdr syms) (not noninteractive)) | 1219 (cond ((and (cdr syms) (not noninteractive)) |
1968 (cons (nth 1 (nth 1 form)) byte-compile-bound-variables))) | 2006 (cons (nth 1 (nth 1 form)) byte-compile-bound-variables))) |
1969 form) | 2007 form) |
1970 | 2008 |
1971 (put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) | 2009 (put 'require 'byte-hunk-handler 'byte-compile-file-form-eval-boundary) |
1972 (defun byte-compile-file-form-eval-boundary (form) | 2010 (defun byte-compile-file-form-eval-boundary (form) |
1973 (eval form) | 2011 (let ((old-load-list current-load-list)) |
2012 (eval form) | |
2013 ;; (require 'cl) turns off warnings for cl functions. | |
2014 (let ((tem current-load-list)) | |
2015 (while (not (eq tem old-load-list)) | |
2016 (when (equal (car tem) '(require . cl)) | |
2017 (setq byte-compile-warnings | |
2018 (remq 'cl-functions byte-compile-warnings))) | |
2019 (setq tem (cdr tem))))) | |
1974 (byte-compile-keep-pending form 'byte-compile-normal-call)) | 2020 (byte-compile-keep-pending form 'byte-compile-normal-call)) |
1975 | 2021 |
1976 (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) | 2022 (put 'progn 'byte-hunk-handler 'byte-compile-file-form-progn) |
1977 (put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn) | 2023 (put 'prog1 'byte-hunk-handler 'byte-compile-file-form-progn) |
1978 (put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn) | 2024 (put 'prog2 'byte-hunk-handler 'byte-compile-file-form-progn) |
2519 byte-compile-compatibility)) | 2565 byte-compile-compatibility)) |
2520 (not (get (get fn 'byte-opcode) 'emacs19-opcode)))) | 2566 (not (get (get fn 'byte-opcode) 'emacs19-opcode)))) |
2521 (funcall handler form) | 2567 (funcall handler form) |
2522 (if (memq 'callargs byte-compile-warnings) | 2568 (if (memq 'callargs byte-compile-warnings) |
2523 (byte-compile-callargs-warn form)) | 2569 (byte-compile-callargs-warn form)) |
2524 (byte-compile-normal-call form)))) | 2570 (byte-compile-normal-call form)) |
2571 (if (memq 'cl-functions byte-compile-warnings) | |
2572 (byte-compile-cl-warn form)))) | |
2525 ((and (or (byte-code-function-p (car form)) | 2573 ((and (or (byte-code-function-p (car form)) |
2526 (eq (car-safe (car form)) 'lambda)) | 2574 (eq (car-safe (car form)) 'lambda)) |
2527 ;; if the form comes out the same way it went in, that's | 2575 ;; if the form comes out the same way it went in, that's |
2528 ;; because it was malformed, and we couldn't unfold it. | 2576 ;; because it was malformed, and we couldn't unfold it. |
2529 (not (eq form (setq form (byte-compile-unfold-lambda form))))) | 2577 (not (eq form (setq form (byte-compile-unfold-lambda form))))) |