From 5d04a95274c9ddaebbcd6ddffc5d646e2c25598c Mon Sep 17 00:00:00 2001 From: Richard M Kreuter Date: Tue, 8 Jul 2008 21:31:50 +0000 Subject: [PATCH] 1.0.18.16: many STYLE-WARNING changes. * Add various subclasses of STYLE-WARNING in src/code/condition.lisp for most of the cases signaled around the system. (A few style warnings remain SIMPLE-STYLE-WARNINGS for now.) * Make STYLE-WARN be like WARN (take a condition class name and arguments). * Change over many callers of STYLE-WARN to supply names of new STYLE-WARNING classes and initargs for those conditions. * Set the default value of SB-EXT:*MUFFLED-WARNINGS* to a type that includes uninteresting redefinitions of functions and methods. --- TODO | 6 - package-data-list.lisp-expr | 24 +++ src/code/condition.lisp | 297 +++++++++++++++++++++++++++++++++++- src/code/defboot.lisp | 5 +- src/code/error.lisp | 16 +- src/code/foreign-load.lisp | 2 +- src/code/full-eval.lisp | 9 +- src/code/reader.lisp | 4 +- src/code/sharpm.lisp | 4 +- src/code/source-location.lisp | 7 +- src/compiler/defconstant.lisp | 6 +- src/compiler/early-c.lisp | 8 +- src/compiler/fndb.lisp | 4 +- src/compiler/knownfun.lisp | 3 +- src/compiler/parse-lambda-list.lisp | 1 + src/compiler/proclaim.lisp | 4 + src/pcl/boot.lisp | 9 +- version.lisp-expr | 2 +- 18 files changed, 369 insertions(+), 42 deletions(-) diff --git a/TODO b/TODO index fd2e0b4b9..15986e3af 100644 --- a/TODO +++ b/TODO @@ -146,12 +146,6 @@ MISC CLEANUPS * Some work on conditions emitted by the system ** eliminate COMPILER-WARN and COMPILER-STYLE-WARN, which were simply limited versions of WARN and STYLE-WARN. - ** make STYLE-WARN parallel WARN more closely (by accepting - a condition type, which should be a subtype of - STYLE-WARNING, and initargs, as well as a format - string and format arguments for SIMPLE-STYLE-WARNING. - (WARN can also be used to signal STYLE-WARNINGs, but - STYLE-WARN helps to document the code) ** eliminate use of INHIBIT-WARNINGS by code emitted by the system from user code. ** cause use of INHIBIT-WARNINGS to signal a STYLE-WARNING. diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr index 37513088e..308b6bf78 100644 --- a/package-data-list.lisp-expr +++ b/package-data-list.lisp-expr @@ -1713,6 +1713,30 @@ is a good idea, but see SB-SYS re. blurring of boundaries." "CONDITION-SLOT-NAME" "CONDITION-SLOT-READERS" "CONDITION-SLOT-WRITERS" + "REDEFINITION-WARNING" + "REDEFINITION-WITH-DEFUN" + "REDEFINITION-WITH-DEFGENERIC" + "REDEFINITION-WITH-DEFMETHOD" + "REDEFINITION-REPLACES-GENERIC-FUNCTION-P" + "REDEFINITION-REPLACES-COMPILED-FUNCTION-WITH-INTERPRETED-P" + "UNINTERESTING-ORDINARY-FUNCTION-REDEFINITION-P" + "UNINTERESTING-GENERIC-FUNCTION-REDEFINITION-P" + "UNINTERESTING-METHOD-REDEFINITION-P" + "UNINTERESTING-REDEFINITION" + "REDEFINITION-WITH-DEFTRANSFORM" + + "IGNORING-ASTERISKS-IN-VARIABLE-NAME" + "IGNORING-ASTERISKS-IN-LEXICAL-VARIABLE-NAME" + "IGNORING-ASTERISKS-IN-CONSTANT-VARIABLE-NAME" + "UNDEFINED-ALIEN" + #!+sb-eval + "LEXICAL-ENVIRONMENT-TOO-COMPLEX" + "CHARACTER-DECODING-ERROR-IN-COMMENT" + "DEPRECATED-EVAL-WHEN-SITUATIONS" + "PROCLAMATION-MISMATCH" + "TYPE-PROCLAMATION-MISMATCH" + "FTYPE-PROCLAMATION-MISMATCH" + "!COLD-INIT" "!UNINTERN-INIT-ONLY-STUFF" "!GLOBALDB-COLD-INIT" "!FDEFN-COLD-INIT" "!FOREIGN-COLD-INIT" "!FUNCTION-NAMES-COLD-INIT" diff --git a/src/code/condition.lisp b/src/code/condition.lisp index a512b023b..59afa4a4c 100644 --- a/src/code/condition.lisp +++ b/src/code/condition.lisp @@ -1275,10 +1275,305 @@ the values returned by the form as a list. No associated restarts.")) (:documentation "Condition signaled when STEP returns.")) ;;; A knob for muffling warnings, mostly for use while loading files. -(defvar *muffled-warnings* nil +(defvar *muffled-warnings* 'uninteresting-redefinition "A type that ought to specify a subtype of WARNING. Whenever a warning is signaled, if the warning if of this type, it will be muffled.") +;;; Various STYLE-WARNING signaled in the system. +;; For the moment, we're only getting into the details for function +;; redefinitions, but other redefinitions could be done later +;; (e.g. methods). +(define-condition redefinition-warning (style-warning) + ()) + +(define-condition function-redefinition-warning (redefinition-warning) + ((name :initarg :name :reader function-redefinition-warning-name) + (old :initarg :old :reader function-redefinition-warning-old-fdefinition) + ;; For DEFGENERIC and perhaps others, the redefinition + ;; destructively modifies the original, rather than storing a new + ;; object, so there's no NEW here, but only in subclasses. + )) + +(define-condition redefinition-with-defun (function-redefinition-warning) + ((new :initarg :new :reader redefinition-with-defun-new-fdefinition) + ;; KLUDGE: it would be nice to fix the unreasonably late + ;; back-patching of DEBUG-SOURCEs in the DEBUG-INFO during + ;; fasloading and just use the new fdefinition, but for the moment + ;; we'll compare the SOURCE-LOCATION created during DEFUN with the + ;; previous DEBUG-SOURCE. + (new-location :initarg :new-location + :reader redefinition-with-defun-new-location)) + (:report (lambda (warning stream) + (format stream "redefining ~S in DEFUN" + (function-redefinition-warning-name warning))))) + +(define-condition redefinition-with-defgeneric (function-redefinition-warning) + ((new-location :initarg :new-location + :reader redefinition-with-defgeneric-new-location)) + (:report (lambda (warning stream) + (format stream "redefining ~S in DEFGENERIC" + (function-redefinition-warning-name warning))))) + +(define-condition redefinition-with-defmethod (redefinition-warning) + ((gf :initarg :generic-function + :reader redefinition-with-defmethod-generic-function) + (qualifiers :initarg :qualifiers + :reader redefinition-with-defmethod-qualifiers) + (specializers :initarg :specializers + :reader redefinition-with-defmethod-specializers) + (new-location :initarg :new-location + :reader redefinition-with-defmethod-new-location) + (old-method :initarg :old-method + :reader redefinition-with-defmethod-old-method)) + (:report (lambda (warning stream) + (format stream "redefining ~S~{ ~S~} ~S in DEFMETHOD" + (redefinition-with-defmethod-generic-function warning) + (redefinition-with-defmethod-qualifiers warning) + (redefinition-with-defmethod-specializers warning))))) + +;; FIXME: see the FIXMEs in defmacro.lisp, then maybe instantiate this. +(define-condition redefinition-with-defmacro (function-redefinition-warning) + ()) + +;; Here are a few predicates for what people might find interesting +;; about redefinitions. + +;; DEFUN can replace a generic function with an ordinary function. +;; (Attempting to replace an ordinary function with a generic one +;; causes an error, though.) +(defun redefinition-replaces-generic-function-p (warning) + (and (typep warning 'redefinition-with-defun) + (typep (function-redefinition-warning-old-fdefinition warning) + 'generic-function))) + +(defun redefinition-replaces-compiled-function-with-interpreted-p (warning) + (and (typep warning 'redefinition-with-defun) + (compiled-function-p + (function-redefinition-warning-old-fdefinition warning)) + (not (compiled-function-p + (redefinition-with-defun-new-fdefinition warning))))) + +;; Most people seem to agree that re-running a DEFUN in a file is +;; completely uninteresting. +(defun uninteresting-ordinary-function-redefinition-p (warning) + ;; OAOO violation: this duplicates code in SB-INTROSPECT. + ;; Additionally, there are some functions that aren't + ;; funcallable-instances for which finding the source location is + ;; complicated (e.g. DEFSTRUCT-defined predicates and accessors), + ;; but I don't think they're defined with %DEFUN, so the warning + ;; isn't raised. + (flet ((fdefinition-file-namestring (fdefn) + #!+sb-eval + (when (typep fdefn 'sb!eval:interpreted-function) + (return-from fdefinition-file-namestring + (sb!c:definition-source-location-namestring + (sb!eval:interpreted-function-source-location fdefn)))) + ;; All the following accesses are guarded with conditionals + ;; because it's not clear whether any of the slots we're + ;; chasing down are guaranteed to be filled in. + (let* ((fdefn + ;; KLUDGE: although this looks like it only works + ;; for %SIMPLE-FUNs, in fact there's a pun such + ;; that %SIMPLE-FUN-SELF returns the simple-fun + ;; object for closures and + ;; funcallable-instances. -- CSR, circa 2005 + (sb!kernel:%simple-fun-self fdefn)) + (code (if fdefn (sb!kernel:fun-code-header fdefn))) + (debug-info (if code (sb!kernel:%code-debug-info code))) + (debug-source (if debug-info + (sb!c::debug-info-source debug-info))) + (namestring (if debug-source + (sb!c::debug-source-namestring debug-source)))) + namestring))) + (and + ;; There's garbage in various places when the first DEFUN runs in + ;; cold-init. + sb!kernel::*cold-init-complete-p* + (typep warning 'redefinition-with-defun) + (let ((old-fdefn + (function-redefinition-warning-old-fdefinition warning)) + (new-fdefn + (redefinition-with-defun-new-fdefinition warning))) + ;; Replacing a compiled function with a compiled function is + ;; clearly uninteresting, and we'll say arbitrarily that + ;; replacing an interpreted function with an interpreted + ;; function is uninteresting, too, but leave out the + ;; compiled-to-interpreted and interpreted-to-compiled cases. + (when (or (and (typep old-fdefn + '(or #!+sb-eval sb!eval:interpreted-function)) + (typep new-fdefn + '(or #!+sb-eval sb!eval:interpreted-function))) + (and (typep old-fdefn + '(and compiled-function + (not funcallable-instance))) + ;; Since this is a REDEFINITION-WITH-DEFUN, + ;; NEW-FDEFN can't be a FUNCALLABLE-INSTANCE. + (typep new-fdefn 'compiled-function))) + (let* ((old-namestring (fdefinition-file-namestring old-fdefn)) + (new-namestring + (or (fdefinition-file-namestring new-fdefn) + (let ((srcloc + (redefinition-with-defun-new-location warning))) + (if srcloc + (sb!c::definition-source-location-namestring + srcloc)))))) + (and old-namestring + new-namestring + (equal old-namestring new-namestring)))))))) + +(defun uninteresting-generic-function-redefinition-p (warning) + (and (typep warning 'redefinition-with-defgeneric) + (let* ((old-fdefn + (function-redefinition-warning-old-fdefinition warning)) + (old-location + (if (typep old-fdefn 'generic-function) + (sb!pcl::definition-source old-fdefn))) + (old-namestring + (if old-location + (sb!c:definition-source-location-namestring old-location))) + (new-location + (redefinition-with-defgeneric-new-location warning)) + (new-namestring + (if new-location + (sb!c:definition-source-location-namestring new-location)))) + (and old-namestring + new-namestring + (equal old-namestring new-namestring))))) + +(defun uninteresting-method-redefinition-p (warning) + (and (typep warning 'redefinition-with-defmethod) + (let* ((old-method (redefinition-with-defmethod-old-method warning)) + (old-location (sb!pcl::definition-source old-method)) + (old-namestring (if old-location + (sb!c:definition-source-location-namestring + old-location))) + (new-location (redefinition-with-defmethod-new-location warning)) + (new-namestring (if new-location + (sb!c:definition-source-location-namestring + new-location)))) + (and new-namestring + old-namestring + (equal new-namestring old-namestring))))) + +(deftype uninteresting-redefinition () + '(or (satisfies uninteresting-ordinary-function-redefinition-p) + (satisfies uninteresting-generic-function-redefinition-p) + (satisfies uninteresting-method-redefinition-p))) + +(define-condition redefinition-with-deftransform (redefinition-warning) + ((transform :initarg :transform + :reader redefinition-with-deftransform-transform)) + (:report (lambda (warning stream) + (format stream "Overwriting ~S" + (redefinition-with-deftransform-transform warning))))) + +;;; Various other STYLE-WARNINGS +(define-condition ignoring-asterisks-in-variable-name + (style-warning simple-condition) + () + (:report (lambda (warning stream) + (format stream "~@?, even though the name follows~@ +the usual naming convention (names like *FOO*) for special variables" + (simple-condition-format-control warning) + (simple-condition-format-arguments warning))))) + +(define-condition ignoring-asterisks-in-lexical-variable-name + (ignoring-asterisks-in-variable-name) + ()) + +(define-condition ignoring-asterisks-in-constant-variable-name + (ignoring-asterisks-in-variable-name) + ()) + +(define-condition undefined-alien (style-warning) + ((symbol :initarg :symbol :reader undefined-alien-symbol)) + (:report (lambda (warning stream) + (format stream "Undefined alien: ~S" + (undefined-alien-symbol warning))))) + +#!+sb-eval +(define-condition lexical-environment-too-complex (style-warning) + ((form :initarg :form :reader lexical-environment-too-complex-form) + (lexenv :initarg :lexenv :reader lexical-environment-too-complex-lexenv)) + (:report (lambda (warning stream) + (format stream + "~@" + (lexical-environment-too-complex-form warning) + (lexical-environment-too-complex-lexenv warning))))) + +;; Although this has -ERROR- in the name, it's just a STYLE-WARNING. +(define-condition character-decoding-error-in-comment (style-warning) + ((stream :initarg :stream :reader decoding-error-in-comment-stream) + (position :initarg :position :reader decoding-error-in-comment-position)) + (:report (lambda (warning stream) + (format stream + "Character decoding error in a ~A-comment at ~ + position ~A reading source stream ~A, ~ + resyncing." + (decoding-error-in-comment-macro warning) + (decoding-error-in-comment-position warning) + (decoding-error-in-comment-stream warning))))) + +(define-condition character-decoding-error-in-macro-char-comment + (character-decoding-error-in-comment) + ((char :initform #\; :initarg :char + :reader character-decoding-error-in-macro-char-comment-char))) + +(define-condition character-decoding-error-in-dispatch-macro-char-comment + (character-decoding-error-in-comment) + ;; ANSI doesn't give a way for a reader function invoked by a + ;; dispatch macro character to determine which dispatch character + ;; was used, so if a user wants to signal one of these from a custom + ;; comment reader, he'll have to supply the :DISP-CHAR himself. + ((disp-char :initform #\# :initarg :disp-char + :reader character-decoding-error-in-macro-char-comment-disp-char) + (sub-char :initarg :sub-char + :reader character-decoding-error-in-macro-char-comment-sub-char))) + +(defun decoding-error-in-comment-macro (warning) + (etypecase warning + (character-decoding-error-in-macro-char-comment + (character-decoding-error-in-macro-char-comment-char warning)) + (character-decoding-error-in-dispatch-macro-char-comment + (format + nil "~C~C" + (character-decoding-error-in-macro-char-comment-disp-char warning) + (character-decoding-error-in-macro-char-comment-sub-char warning))))) + +(define-condition deprecated-eval-when-situations (style-warning) + ((situations :initarg :situations + :reader deprecated-eval-when-situations-situations)) + (:report (lambda (warning stream) + (format stream "using deprecated EVAL-WHEN situation names~{ ~S~}" + (deprecated-eval-when-situations-situations warning))))) + +(define-condition proclamation-mismatch (style-warning) + ((name :initarg :name :reader proclamation-mismatch-name) + (old :initarg :old :reader proclamation-mismatch-old) + (new :initarg :new :reader proclamation-mismatch-new))) + +(define-condition type-proclamation-mismatch (proclamation-mismatch) + () + (:report (lambda (warning stream) + (format stream + "The new TYPE proclamation~% ~S for ~S does not ~ + match the old TYPE proclamation ~S" + (proclamation-mismatch-new warning) + (proclamation-mismatch-name warning) + (proclamation-mismatch-old warning))))) + +(define-condition ftype-proclamation-mismatch (proclamation-mismatch) + () + (:report (lambda (warning stream) + (format stream + "The new FTYPE proclamation~% ~S for ~S does not ~ + match the old FTYPE proclamation ~S" + (proclamation-mismatch-new warning) + (proclamation-mismatch-name warning) + (proclamation-mismatch-old warning))))) + ;;;; restart definitions (define-condition abort-failure (control-error) () diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp index 38199fa02..ddd6355f9 100644 --- a/src/code/defboot.lisp +++ b/src/code/defboot.lisp @@ -212,14 +212,15 @@ evaluated as a PROGN." #-sb-xc-host (defun %defun (name def doc inline-lambda source-location) - (declare (ignore source-location)) (declare (type function def)) (declare (type (or null simple-string) doc)) (aver (legal-fun-name-p name)) ; should've been checked by DEFMACRO DEFUN (sb!c:%compiler-defun name inline-lambda nil) (when (fboundp name) (/show0 "redefining NAME in %DEFUN") - (style-warn "redefining ~S in DEFUN" name)) + (style-warn 'sb!kernel::redefinition-with-defun :name name + :old (fdefinition name) :new def + :new-location source-location)) (setf (sb!xc:fdefinition name) def) (sb!c::note-name-defined name :function) diff --git a/src/code/error.lisp b/src/code/error.lisp index 9078873a3..f989aef7f 100644 --- a/src/code/error.lisp +++ b/src/code/error.lisp @@ -14,13 +14,19 @@ (in-package "SB!KERNEL") ;;; not sure this is the right place, but where else? -(defun style-warn (format-control &rest format-arguments) +(defun style-warn (datum &rest arguments) (/show0 "entering STYLE-WARN") (/show format-control format-arguments) - (with-sane-io-syntax - (warn 'simple-style-warning - :format-control format-control - :format-arguments format-arguments))) + (if (stringp datum) + (with-sane-io-syntax + (warn 'simple-style-warning + :format-control datum + :format-arguments arguments)) + ;; Maybe FIXME: check that the DATUM is a STYLE-WARNING or a + ;; specifier for a subtype of STYLE-WARNING? (I had trouble + ;; getting through cold-init with that check enabled, though.) + ;; -- RMK, 20080701. + (apply #'warn datum arguments))) ;;; a utility for SIGNAL, ERROR, CERROR, WARN, COMPILER-NOTIFY and ;;; INVOKE-DEBUGGER: Parse the hairy argument conventions into a diff --git a/src/code/foreign-load.lisp b/src/code/foreign-load.lisp index 7aece9f54..bf693ef73 100644 --- a/src/code/foreign-load.lisp +++ b/src/code/foreign-load.lisp @@ -175,7 +175,7 @@ is never in the linkage-table." (error 'undefined-alien-error :name symbol)) #!+linkage-table ((not addr) - (style-warn "Undefined alien: ~S" symbol) + (style-warn 'sb!kernel:undefined-alien :symbol symbol) (setf (gethash symbol undefineds) t) (remhash symbol symbols) (if datap diff --git a/src/code/full-eval.lisp b/src/code/full-eval.lisp index 83c1122db..c93a320e0 100644 --- a/src/code/full-eval.lisp +++ b/src/code/full-eval.lisp @@ -1200,11 +1200,6 @@ (%eval form env)) (compiler-environment-too-complex-error (condition) (declare (ignore condition)) - ;; FIXME: this could be a really annoying warning. It should - ;; have its own class. - (sb!int:style-warn - "~@" - form lexenv) + (sb!int:style-warn 'sb!kernel:lexical-environment-too-complex + :form form :lexenv lexenv) (sb!int:simple-eval-in-lexenv form lexenv))))) diff --git a/src/code/reader.lisp b/src/code/reader.lisp index 94d5ca74c..2eb433ae4 100644 --- a/src/code/reader.lisp +++ b/src/code/reader.lisp @@ -544,7 +544,9 @@ variables to allow for nested and thread safe reading." ((character-decoding-error #'(lambda (decoding-error) (declare (ignorable decoding-error)) - (style-warn "Character decoding error in a ;-comment at position ~A reading source file ~A, resyncing." (file-position stream) stream) + (style-warn + 'sb!kernel::character-decoding-error-in-macro-char-comment + :position (file-position stream) :stream stream) (invoke-restart 'attempt-resync)))) (let ((stream (in-synonym-of stream))) (if (ansi-stream-p stream) diff --git a/src/code/sharpm.lisp b/src/code/sharpm.lisp index dfd32d282..af7994f17 100644 --- a/src/code/sharpm.lisp +++ b/src/code/sharpm.lisp @@ -378,7 +378,9 @@ ((character-decoding-error #'(lambda (decoding-error) (declare (ignorable decoding-error)) - (style-warn "Character decoding error in a #|-comment at position ~A reading source file ~A, resyncing." (file-position stream) stream) + (style-warn + 'sb!kernel::character-decoding-error-in-dispatch-macro-char-comment + :sub-char sub-char :position (file-position stream) :stream stream) (invoke-restart 'attempt-resync)))) (let ((stream (in-synonym-of stream))) (if (ansi-stream-p stream) diff --git a/src/code/source-location.lisp b/src/code/source-location.lisp index d281ccfa1..9cb1a9a25 100644 --- a/src/code/source-location.lisp +++ b/src/code/source-location.lisp @@ -50,11 +50,8 @@ #!+sb-source-locations (define-compiler-macro source-location (&environment env) - #+sb-xc-host (declare (ignore env)) - #-sb-xc-host - (unless (policy env (and (> space 1) - (> space debug))) - (make-definition-source-location))) + (declare (ignore env)) + #-sb-xc-host (make-definition-source-location)) (/show0 "/Processing source location thunks") #!+sb-source-locations diff --git a/src/compiler/defconstant.lisp b/src/compiler/defconstant.lisp index 0b6f42309..9cc011cb0 100644 --- a/src/compiler/defconstant.lisp +++ b/src/compiler/defconstant.lisp @@ -24,9 +24,9 @@ (unless (symbolp name) (error "The constant name is not a symbol: ~S" name)) (when (looks-like-name-of-special-var-p name) - (style-warn "defining ~S as a constant, even though the name follows~@ -the usual naming convention (names like *FOO*) for special variables" - name)) + (style-warn 'sb!kernel:ignoring-asterisks-in-constant-variable-name + :format-control "defining ~S as a constant" + :format-arguments (list name))) (sb!c:with-source-location (source-location) (setf (info :source-location :constant name) source-location)) (let ((kind (info :variable :kind name))) diff --git a/src/compiler/early-c.lisp b/src/compiler/early-c.lisp index 3be5dcf68..b6d0803a0 100644 --- a/src/compiler/early-c.lisp +++ b/src/compiler/early-c.lisp @@ -164,9 +164,11 @@ ;; and then we happen to compile bar.lisp before foo.lisp. (when (looks-like-name-of-special-var-p symbol) ;; FIXME: should be COMPILER-STYLE-WARNING? - (style-warn "using the lexical binding of the symbol ~S, not the~@ -dynamic binding, even though the symbol name follows the usual naming~@ -convention (names like *FOO*) for special variables" symbol)) + (style-warn 'sb!kernel:ignoring-asterisks-in-lexical-variable-name + :format-control + "using the lexical binding of the symbol ~S, not the~@ + dynamic binding" + :format-arguments (list symbol))) (values)) (def!struct (debug-name-marker (:make-load-form-fun dump-debug-name-marker) diff --git a/src/compiler/fndb.lisp b/src/compiler/fndb.lisp index a2624830c..f657293f7 100644 --- a/src/compiler/fndb.lisp +++ b/src/compiler/fndb.lisp @@ -1557,11 +1557,11 @@ (flushable)) (defknown compiler-error (t &rest t) nil ()) -(defknown (compiler-warn compiler-style-warn) (string &rest t) (values) ()) +(defknown (compiler-warn compiler-style-warn) (t &rest t) (values) ()) (defknown (compiler-notify maybe-compiler-notify) ((or string symbol) &rest t) (values) ()) -(defknown style-warn (string &rest t) null ()) +(defknown style-warn (t &rest t) null ()) ;;;; atomic ops (defknown %compare-and-swap-svref (simple-vector index t t) t diff --git a/src/compiler/knownfun.lisp b/src/compiler/knownfun.lisp index 078b9f103..863dbb395 100644 --- a/src/compiler/knownfun.lisp +++ b/src/compiler/knownfun.lisp @@ -182,7 +182,8 @@ (eq (transform-important x) important))) (fun-info-transforms info)))) (cond (old - (style-warn "Overwriting ~S" old) + (style-warn 'sb!kernel:redefinition-with-deftransform + :transform old) (setf (transform-function old) fun (transform-note old) note)) (t diff --git a/src/compiler/parse-lambda-list.lisp b/src/compiler/parse-lambda-list.lisp index 7f60223f2..5a3eb2415 100644 --- a/src/compiler/parse-lambda-list.lisp +++ b/src/compiler/parse-lambda-list.lisp @@ -126,6 +126,7 @@ (let ((name (symbol-name arg))) (when (and (plusp (length name)) (char= (char name 0) #\&)) + ;; Should this be COMPILER-STYLE-WARN? (style-warn "suspicious variable in lambda list: ~S." arg)))) (case state diff --git a/src/compiler/proclaim.lisp b/src/compiler/proclaim.lisp index 93de83517..c2159167f 100644 --- a/src/compiler/proclaim.lisp +++ b/src/compiler/proclaim.lisp @@ -187,6 +187,8 @@ (when (eq (info :variable :where-from name) :declared) (let ((old-type (info :variable :type name))) (when (type/= type old-type) + ;; FIXME: changing to TYPE-PROCLAMATION-MISMATCH + ;; broke late-proclaim.lisp. (style-warn "The new TYPE proclamation~% ~S~@ for ~S does not match the old TYPE~@ proclamation ~S" @@ -205,6 +207,8 @@ (when (eq (info :function :where-from name) :declared) (let ((old-type (info :function :type name))) (when (type/= ctype old-type) + ;; FIXME: changing to FTYPE-PROCLAMATION-MISMATCH + ;; broke late-proclaim.lisp. (style-warn "new FTYPE proclamation~@ ~S~@ diff --git a/src/pcl/boot.lisp b/src/pcl/boot.lisp index 47e270a9d..e71a3bb98 100644 --- a/src/pcl/boot.lisp +++ b/src/pcl/boot.lisp @@ -252,8 +252,9 @@ bootstrapping. (defun load-defgeneric (fun-name lambda-list source-location &rest initargs) (when (fboundp fun-name) - (style-warn "redefining ~S in DEFGENERIC" fun-name) (let ((fun (fdefinition fun-name))) + (warn 'sb-kernel:redefinition-with-defgeneric :name fun-name + :old fun :new-location source-location) (when (generic-function-p fun) (loop for method in (generic-function-initial-methods fun) do (remove-method fun method)) @@ -1572,8 +1573,10 @@ bootstrapping. (generic-function-methods gf) (find-method gf qualifiers specializers nil)))) (when method - (style-warn "redefining ~S~{ ~S~} ~S in DEFMETHOD" - gf-spec qualifiers specializers)))) + (style-warn 'sb-kernel:redefinition-with-defmethod + :generic-function gf-spec :old-method method + :qualifiers qualifiers :specializers specializers + :new-location source-location)))) (let ((method (apply #'add-named-method gf-spec qualifiers specializers lambda-list :definition-source source-location diff --git a/version.lisp-expr b/version.lisp-expr index 37b553795..eeef0bfa1 100644 --- a/version.lisp-expr +++ b/version.lisp-expr @@ -17,4 +17,4 @@ ;;; checkins which aren't released. (And occasionally for internal ;;; versions, especially for internal versions off the main CVS ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".) -"1.0.18.15" +"1.0.18.16" -- 2.11.4.GIT