diff --git a/compiler/ir1final.lisp b/compiler/ir1final.lisp index f5f945e8005e29a735a8e6c717dd19fcc5e76e20..1086f57d1d05ac9eb0155ceaa946531996433cd9 100644 --- a/compiler/ir1final.lisp +++ b/compiler/ir1final.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1final.lisp,v 1.23 2003/03/24 11:36:08 gerd Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1final.lisp,v 1.24 2004/12/06 17:03:56 rtoy Rel $") ;;; ;;; ********************************************************************** ;;; @@ -34,8 +34,8 @@ (note (transform-note (car failure)))) (cond ((consp what) - (compiler-note "Unable to ~A because:~%~6T~?" - note (first what) (rest what))) + (efficiency-note "Unable to ~A because:~%~6T~?" + note (first what) (rest what))) ((valid-function-use node what :argument-test #'types-intersect :result-test #'values-types-intersect) @@ -47,9 +47,9 @@ :warning-function #'frob :error-function #'frob)) - (compiler-note "Unable to ~A due to type uncertainty:~@ + (efficiency-note "Unable to ~A due to type uncertainty:~@ ~{~6T~?~^~&~}" - note (messages)))))))))) + note (messages)))))))))) ;;; FINALIZE-XEP-DEFINITION -- Internal diff --git a/compiler/ir1util.lisp b/compiler/ir1util.lisp index 90618cd29c8f6d8074ba495dfcca57440f8069aa..07f63ab8630e4bbac9d7484702e320e2f9bbec7d 100644 --- a/compiler/ir1util.lisp +++ b/compiler/ir1util.lisp @@ -5,7 +5,7 @@ ;;; Carnegie Mellon University, and has been placed in the public domain. ;;; (ext:file-comment - "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.107 2004/10/26 13:31:38 rtoy Exp $") + "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/ir1util.lisp,v 1.108 2004/12/06 17:03:56 rtoy Exp $") ;;; ;;; ********************************************************************** ;;; @@ -2181,6 +2181,15 @@ these can be NIL if unavailable or inapplicable.") :format-arguments format-args)) (values)) +(defun efficiency-note (format-string &rest format-args) + (declare (string format-string)) + (unless (if *compiler-error-context* + (policy *compiler-error-context* (>= brevity 2.5)) + (policy nil (>= brevity 2.5))) + (warn 'simple-style-warning :format-control format-string + :format-arguments format-args)) + (values)) + ;;;; Undefined warnings: