0.8.0.74:

	Conditionize COMPILER-NOTE
	... s/COMPILER-NOTE/COMPILER-NOTIFY/ for the function
	... a couple of exports in package-data-list
	(also move a DECLAIM from the start of a MACROLET)

diff --git a/NEWS b/NEWS
index 9effeae..82970ef 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1781,6 +1781,14 @@ changes in sbcl-0.8.1 relative to sbcl-0.8.0:
     functions defined in the same file. This also permits the system
     to warn on static type mismatches and function
     redefinition.  (Currently it does not work with high DEBUG level.)
     functions defined in the same file. This also permits the system
     to warn on static type mismatches and function
     redefinition.  (Currently it does not work with high DEBUG level.)

+  * when issuing notes, the compiler now signals a condition of type
+    SB-EXT:COMPILER-NOTE, and provides an associated MUFFLE-WARNING
+    restart for use in user handlers.  It is expected that the
+    COMPILER-NOTE condition will eventually become a condition
+    supertype to a hierarchy of note types, which will then be
+    handleable in a similar fashion; other than
+    SB-INT:SIMPLE-COMPILER-NOTE, an implementation detail, no such
+    note subtypes yet exist.

   * changes in type checking closed the following bugs:
     ** type checking of unused values (192b, 194d, 203);
     ** template selection based on unsafe type assertions (192c, 236);
   * changes in type checking closed the following bugs:
     ** type checking of unused values (192b, 194d, 203);
     ** template selection based on unsafe type assertions (192c, 236);

diff --git a/package-data-list.lisp-expr b/package-data-list.lisp-expr
index 193f46e..b2cc21a 100644 (file)
--- a/package-data-list.lisp-expr
+++ b/package-data-list.lisp-expr
@@ -213,6 +213,8 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
               "COMPILE-IN-LEXENV"
              "COMPILE-LAMBDA-FOR-DEFUN"
               "%COMPILER-DEFUN" "COMPILER-ERROR"
               "COMPILE-IN-LEXENV"
              "COMPILE-LAMBDA-FOR-DEFUN"
               "%COMPILER-DEFUN" "COMPILER-ERROR"

+             "COMPILER-NOTIFY"
+             "COMPILER-STYLE-WARN" "COMPILER-WARN"

               "COMPONENT" "COMPONENT-HEADER-LENGTH"
               "COMPONENT-INFO" "COMPONENT-LIVE-TN" "COMPUTE-FUN"
               "COMPUTE-OLD-NFP" "COPY-MORE-ARG"
               "COMPONENT" "COMPONENT-HEADER-LENGTH"
               "COMPONENT-INFO" "COMPONENT-LIVE-TN" "COMPUTE-FUN"
               "COMPUTE-OLD-NFP" "COPY-MORE-ARG"

@@ -248,7 +250,7 @@ of SBCL which maintained the CMU-CL-style split into two packages.)"
               "MAKE-OTHER-IMMEDIATE-TYPE" "MAKE-RANDOM-TN"
               "MAKE-REPRESENTATION-TN" "MAKE-RESTRICTED-TN" "MAKE-SC-OFFSET"
               "MAKE-STACK-POINTER-TN" "MAKE-TN-REF" "MAKE-UNWIND-BLOCK"
               "MAKE-OTHER-IMMEDIATE-TYPE" "MAKE-RANDOM-TN"
               "MAKE-REPRESENTATION-TN" "MAKE-RESTRICTED-TN" "MAKE-SC-OFFSET"
               "MAKE-STACK-POINTER-TN" "MAKE-TN-REF" "MAKE-UNWIND-BLOCK"

-             "MAKE-WIRED-TN" "MAYBE-COMPILER-NOTE"
+             "MAKE-WIRED-TN" "MAYBE-COMPILER-NOTIFY"

              "MAYBE-INLINE-SYNTACTIC-CLOSURE"
               "META-PRIMITIVE-TYPE-OR-LOSE"
               "META-SB-OR-LOSE" "META-SC-NUMBER-OR-LOSE" "META-SC-OR-LOSE"
              "MAYBE-INLINE-SYNTACTIC-CLOSURE"
               "META-PRIMITIVE-TYPE-OR-LOSE"
               "META-SB-OR-LOSE" "META-SC-NUMBER-OR-LOSE" "META-SC-OR-LOSE"

@@ -548,6 +550,10 @@ like *STACK-TOP-HINT* and unsupported stuff like *TRACED-FUN-LIST*."
             "DEFCONSTANT-UNEQL" "DEFCONSTANT-UNEQL-NAME"
             "DEFCONSTANT-UNEQL-NEW-VALUE" "DEFCONSTANT-UNEQL-OLD-VALUE"
 
             "DEFCONSTANT-UNEQL" "DEFCONSTANT-UNEQL-NAME"
             "DEFCONSTANT-UNEQL-NEW-VALUE" "DEFCONSTANT-UNEQL-OLD-VALUE"
 

+            ;; conditions that can be handled to reduce compiler
+            ;; verbosity
+            "COMPILER-NOTE"
+

             ;; FIXME: This name doesn't match the DEFFOO - vs. -
             ;; DEFINE-FOO convention used in the ANSI spec, and so
             ;; was deprecated in sbcl-0.pre7, ca. 2001-12-12. After
             ;; FIXME: This name doesn't match the DEFFOO - vs. -
             ;; DEFINE-FOO convention used in the ANSI spec, and so
             ;; was deprecated in sbcl-0.pre7, ca. 2001-12-12. After

@@ -704,7 +710,7 @@ retained, possibly temporariliy, because it might be used internally."
              "SIMPLE-PROGRAM-ERROR" "SIMPLE-STREAM-ERROR"
              "SIMPLE-STYLE-WARNING"
             "SPECIAL-FORM-FUNCTION"
              "SIMPLE-PROGRAM-ERROR" "SIMPLE-STREAM-ERROR"
              "SIMPLE-STYLE-WARNING"
             "SPECIAL-FORM-FUNCTION"

-             "STYLE-WARN"
+             "STYLE-WARN" "SIMPLE-COMPILER-NOTE"

             
              ;; bootstrapping magic, to make things happen both in
              ;; the cross-compilation host compiler's environment and
             
              ;; bootstrapping magic, to make things happen both in
              ;; the cross-compilation host compiler's environment and

diff --git a/src/code/defboot.lisp b/src/code/defboot.lisp
index 45d064c..440fe2d 100644 (file)
--- a/src/code/defboot.lisp
+++ b/src/code/defboot.lisp
@@ -169,7 +169,7 @@
              (or (sb!c:maybe-inline-syntactic-closure lambda env)
                  (progn
                    (#+sb-xc-host warn
              (or (sb!c:maybe-inline-syntactic-closure lambda env)
                  (progn
                    (#+sb-xc-host warn

-                    #-sb-xc-host sb!c:maybe-compiler-note
+                    #-sb-xc-host sb!c:maybe-compiler-notify

                     "lexical environment too hairy, can't inline DEFUN ~S"
                     name)
                    nil)))))
                     "lexical environment too hairy, can't inline DEFUN ~S"
                     name)
                    nil)))))

diff --git a/src/code/defstruct.lisp b/src/code/defstruct.lisp
index ae83f97..feec05a 100644 (file)
--- a/src/code/defstruct.lisp
+++ b/src/code/defstruct.lisp
@@ -49,7 +49,7 @@
           ;; slow, so if anyone cares about performance of
           ;; non-toplevel DEFSTRUCTs, it should be rewritten to be
           ;; cleverer. -- WHN 2002-10-23
           ;; slow, so if anyone cares about performance of
           ;; non-toplevel DEFSTRUCTs, it should be rewritten to be
           ;; cleverer. -- WHN 2002-10-23

-          (sb!c::compiler-note
+          (sb!c:compiler-notify

            "implementation limitation: ~
              Non-toplevel DEFSTRUCT constructors are slow.")
           (with-unique-names (layout)
            "implementation limitation: ~
              Non-toplevel DEFSTRUCT constructors are slow.")
           (with-unique-names (layout)

diff --git a/src/compiler/checkgen.lisp b/src/compiler/checkgen.lisp
index d3d8a17..9d13c97 100644 (file)
--- a/src/compiler/checkgen.lisp
+++ b/src/compiler/checkgen.lisp
@@ -487,7 +487,7 @@
             (:too-hairy
              (let ((*compiler-error-context* cast))
                (when (policy cast (>= safety inhibit-warnings))
             (:too-hairy
              (let ((*compiler-error-context* cast))
                (when (policy cast (>= safety inhibit-warnings))

-                 (compiler-note
+                 (compiler-notify

                   "type assertion too complex to check:~% ~S."
                   (type-specifier (coerce-to-values (cast-asserted-type cast))))))
              (setf (cast-type-to-check cast) *wild-type*)
                   "type assertion too complex to check:~% ~S."
                   (type-specifier (coerce-to-values (cast-asserted-type cast))))))
              (setf (cast-type-to-check cast) *wild-type*)

diff --git a/src/compiler/ctype.lisp b/src/compiler/ctype.lisp
index c4dc579..93aeb42 100644 (file)
--- a/src/compiler/ctype.lisp
+++ b/src/compiler/ctype.lisp
@@ -418,7 +418,7 @@
                                          #'types-equal-or-intersect)
                                         (*lossage-fun*
                                          #'compiler-style-warn)
                                          #'types-equal-or-intersect)
                                         (*lossage-fun*
                                          #'compiler-style-warn)

-                                        (*unwinnage-fun* #'compiler-note))
+                                        (*unwinnage-fun* #'compiler-notify))

   (let* ((*lossage-detected* nil)
         (*unwinnage-detected* nil)
         (required (fun-type-required type))
   (let* ((*lossage-detected* nil)
         (*unwinnage-detected* nil)
         (required (fun-type-required type))

@@ -766,7 +766,7 @@
     (when (eq where :declared)
       (setf (leaf-type fun) type)
       (assert-definition-type fun type
     (when (eq where :declared)
       (setf (leaf-type fun) type)
       (assert-definition-type fun type

-                              :unwinnage-fun #'compiler-note
+                              :unwinnage-fun #'compiler-notify

                               :where "proclamation"))))
 \f
 ;;;; FIXME: Move to some other file.
                               :where "proclamation"))))
 \f
 ;;;; FIXME: Move to some other file.

diff --git a/src/compiler/float-tran.lisp b/src/compiler/float-tran.lisp
index f4f65bf..9ddb5aa 100644 (file)
--- a/src/compiler/float-tran.lisp
+++ b/src/compiler/float-tran.lisp
@@ -426,7 +426,7 @@
                                 `(coerce (,',prim-quick (coerce x 'double-float))
                                   'single-float))
                                (t
                                 `(coerce (,',prim-quick (coerce x 'double-float))
                                   'single-float))
                                (t

-                                (compiler-note
+                                (compiler-notify

                                  "unable to avoid inline argument range check~@
                                   because the argument range (~S) was not within 2^64"
                                  (type-specifier (continuation-type x)))
                                  "unable to avoid inline argument range check~@
                                   because the argument range (~S) was not within 2^64"
                                  (type-specifier (continuation-type x)))

@@ -439,7 +439,7 @@
                                                             (#.(expt 2d0 64)))))
                                `(,',prim-quick x))
                               (t
                                                             (#.(expt 2d0 64)))))
                                `(,',prim-quick x))
                               (t

-                               (compiler-note
+                               (compiler-notify

                                 "unable to avoid inline argument range check~@
                                  because the argument range (~S) was not within 2^64"
                                 (type-specifier (continuation-type x)))
                                 "unable to avoid inline argument range check~@
                                  because the argument range (~S) was not within 2^64"
                                 (type-specifier (continuation-type x)))

@@ -560,11 +560,11 @@
     ;; Check that the ARG bounds are correctly canonicalized.
     (when (and arg-lo (floatp arg-lo-val) (zerop arg-lo-val) (consp arg-lo)
               (minusp (float-sign arg-lo-val)))
     ;; Check that the ARG bounds are correctly canonicalized.
     (when (and arg-lo (floatp arg-lo-val) (zerop arg-lo-val) (consp arg-lo)
               (minusp (float-sign arg-lo-val)))

-      (compiler-note "float zero bound ~S not correctly canonicalized?" arg-lo)
+      (compiler-notify "float zero bound ~S not correctly canonicalized?" arg-lo)

       (setq arg-lo '(0e0) arg-lo-val 0e0))
     (when (and arg-hi (zerop arg-hi-val) (floatp arg-hi-val) (consp arg-hi)
               (plusp (float-sign arg-hi-val)))
       (setq arg-lo '(0e0) arg-lo-val 0e0))
     (when (and arg-hi (zerop arg-hi-val) (floatp arg-hi-val) (consp arg-hi)
               (plusp (float-sign arg-hi-val)))

-      (compiler-note "float zero bound ~S not correctly canonicalized?" arg-hi)
+      (compiler-notify "float zero bound ~S not correctly canonicalized?" arg-hi)

       (setq arg-hi `(,(ecase *read-default-float-format*
                        (double-float (load-time-value (make-unportable-float :double-float-negative-zero)))
                        #!+long-float
       (setq arg-hi `(,(ecase *read-default-float-format*
                        (double-float (load-time-value (make-unportable-float :double-float-negative-zero)))
                        #!+long-float

diff --git a/src/compiler/gtn.lisp b/src/compiler/gtn.lisp
index 4a3352f..571d82c 100644 (file)
--- a/src/compiler/gtn.lisp
+++ b/src/compiler/gtn.lisp
@@ -137,7 +137,7 @@
                     inhibit-warnings))
       (dolist (fun funs
                   (let ((*compiler-error-context* (lambda-bind (first funs))))
                     inhibit-warnings))
       (dolist (fun funs
                   (let ((*compiler-error-context* (lambda-bind (first funs))))

-                    (compiler-note
+                    (compiler-notify

                      "Return value count mismatch prevents known return ~
                       from these functions:~
                       ~{~%  ~A~}"
                      "Return value count mismatch prevents known return ~
                       from these functions:~
                       ~{~%  ~A~}"

@@ -150,7 +150,7 @@
                (declare (ignore ignore))
                (when (eq count :unknown)
                  (let ((*compiler-error-context* (lambda-bind fun)))
                (declare (ignore ignore))
                (when (eq count :unknown)
                  (let ((*compiler-error-context* (lambda-bind fun)))

-                   (compiler-note
+                   (compiler-notify

                     "Return type not fixed values, so can't use known return ~
                      convention:~%  ~S"
                     (type-specifier rtype)))
                     "Return type not fixed values, so can't use known return ~
                      convention:~%  ~S"
                     (type-specifier rtype)))

diff --git a/src/compiler/ir1final.lisp b/src/compiler/ir1final.lisp
index b4a1dbb..3fa8bd3 100644 (file)
--- a/src/compiler/ir1final.lisp
+++ b/src/compiler/ir1final.lisp
@@ -27,8 +27,8 @@
              (note (transform-note (car failure))))
          (cond
           ((consp what)
              (note (transform-note (car failure))))
          (cond
           ((consp what)

-           (compiler-note "~@<unable to ~2I~_~A ~I~_because: ~2I~_~?~:>"
-                          note (first what) (rest what)))
+           (compiler-notify "~@<unable to ~2I~_~A ~I~_because: ~2I~_~?~:>"
+                            note (first what) (rest what)))

           ((valid-fun-use node what
                           :argument-test #'types-equal-or-intersect
                           :result-test #'values-types-equal-or-intersect)
           ((valid-fun-use node what
                           :argument-test #'types-equal-or-intersect
                           :result-test #'values-types-equal-or-intersect)

@@ -39,10 +39,10 @@
                (valid-fun-use node what
                               :unwinnage-fun #'give-grief
                               :lossage-fun #'give-grief))
                (valid-fun-use node what
                               :unwinnage-fun #'give-grief
                               :lossage-fun #'give-grief))

-             (compiler-note "~@<unable to ~
-                              ~2I~_~A ~
-                              ~I~_due to type uncertainty: ~
-                             ~2I~_~{~?~^~@:_~}~:>"
+             (compiler-notify "~@<unable to ~
+                                ~2I~_~A ~
+                                ~I~_due to type uncertainty: ~
+                               ~2I~_~{~?~^~@:_~}~:>"

                             note (messages))))
           ;; As best I can guess, it's OK to fall off the end here
           ;; because if it's not a VALID-FUNCTION-USE, the user
                             note (messages))))
           ;; As best I can guess, it's OK to fall off the end here
           ;; because if it's not a VALID-FUNCTION-USE, the user

diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 08c20ad..0cac21d 100644 (file)
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -935,7 +935,7 @@
                        ;; issue a full WARNING if the call
                        ;; violates a DECLAIM FTYPE.
                        :lossage-fun #'compiler-style-warn
                        ;; issue a full WARNING if the call
                        ;; violates a DECLAIM FTYPE.
                        :lossage-fun #'compiler-style-warn

-                       :unwinnage-fun #'compiler-note)
+                       :unwinnage-fun #'compiler-notify)

         (assert-call-type call type)
         (maybe-terminate-block call ir1-converting-not-optimizing-p)
         (recognize-known-call call ir1-converting-not-optimizing-p))
         (assert-call-type call type)
         (maybe-terminate-block call ir1-converting-not-optimizing-p)
         (recognize-known-call call ir1-converting-not-optimizing-p))

diff --git a/src/compiler/ir1report.lisp b/src/compiler/ir1report.lisp
index 4ef2d65..4c1f514 100644 (file)
--- a/src/compiler/ir1report.lisp
+++ b/src/compiler/ir1report.lisp
@@ -415,33 +415,52 @@
                              format-args)))
   (values))
 
                              format-args)))
   (values))
 

-;;; COMPILER-NOTE is vaguely like COMPILER-ERROR and the other
-;;; condition-signalling functions, but it just writes some output
-;;; instead of signalling. (In CMU CL, it did signal a condition, but
-;;; this didn't seem to work all that well; it was weird to have
-;;; COMPILE-FILE return with WARNINGS-P set when the only problem was
-;;; that the compiler couldn't figure out how to compile something as
-;;; efficiently as it liked.)
-(defun compiler-note (format-string &rest format-args)
+;;; The act of signalling one of these beasts must not cause WARNINGSP
+;;; (or FAILUREP) to be set from COMPILE or COMPILE-FILE, so we can't
+;;; inherit from WARNING or STYLE-WARNING.
+;;;
+;;; FIXME: the handling of compiler-notes could be unified with
+;;; warnings and style-warnings (see the various handler functions
+;;; below).
+(define-condition compiler-note (condition) ())
+(define-condition simple-compiler-note (simple-condition compiler-note) ())
+
+(defun compiler-notify (format-string &rest format-args)
+  ;; FORMAT-STRING and FORMAT-ARGS might well end up turning into
+  ;; DATUM and REST, and COERCE-TO-CONDITION will be used.

   (unless (if *compiler-error-context*
              (policy *compiler-error-context* (= inhibit-warnings 3))
              (policy *lexenv* (= inhibit-warnings 3)))
   (unless (if *compiler-error-context*
              (policy *compiler-error-context* (= inhibit-warnings 3))
              (policy *lexenv* (= inhibit-warnings 3)))

+    (restart-case
+       (signal (make-condition 'simple-compiler-note
+                               :format-string format-string
+                               :format-arguments format-args))
+      (muffle-warning ()
+       (return-from compiler-notify (values))))

     (incf *compiler-note-count*)
     (print-compiler-message (format nil "note: ~A" format-string)
                            format-args))
   (values))
 
 ;;; Issue a note when we might or might not be in the compiler.
     (incf *compiler-note-count*)
     (print-compiler-message (format nil "note: ~A" format-string)
                            format-args))
   (values))
 
 ;;; Issue a note when we might or might not be in the compiler.

-(defun maybe-compiler-note (&rest rest)
+(defun maybe-compiler-notify (&rest rest)

   (if (boundp '*lexenv*) ; if we're in the compiler
   (if (boundp '*lexenv*) ; if we're in the compiler

-      (apply #'compiler-note rest)
-      (let ((stream *error-output*))
-       (pprint-logical-block (stream nil :per-line-prefix ";")
-         
-         (format stream " note: ~3I~_")
-         (pprint-logical-block (stream nil)
-           (apply #'format stream rest)))
-       (fresh-line stream)))) ; (outside logical block, no per-line-prefix)
+      (apply #'compiler-notify rest)
+      (progn
+       (restart-case
+           (signal (make-condition 'simple-compiler-note
+                                   :format-string (car rest)
+                                   :format-arguments (cdr rest)))
+         (muffle-warning ()
+           (return-from maybe-compiler-notify (values))))
+       (let ((stream *error-output*))
+         (pprint-logical-block (stream nil :per-line-prefix ";")
+           (format stream " note: ~3I~_")
+           (pprint-logical-block (stream nil)
+             (apply #'format stream rest)))
+         ;; (outside logical block, no per-line-prefix)
+         (fresh-line stream))
+       (values))))

 
 ;;; The politically correct way to print out progress messages and
 ;;; such like. We clear the current error context so that we know that
 
 ;;; The politically correct way to print out progress messages and
 ;;; such like. We clear the current error context so that we know that

diff --git a/src/compiler/ir1tran-lambda.lisp b/src/compiler/ir1tran-lambda.lisp
index be94415..8ed6283 100644 (file)
--- a/src/compiler/ir1tran-lambda.lisp
+++ b/src/compiler/ir1tran-lambda.lisp
@@ -995,7 +995,7 @@
      ;; compilation unit, so we can't do that. -- WHN 2001-02-11
      :lossage-fun #'compiler-style-warn
      :unwinnage-fun (cond (info #'compiler-style-warn)
      ;; compilation unit, so we can't do that. -- WHN 2001-02-11
      :lossage-fun #'compiler-style-warn
      :unwinnage-fun (cond (info #'compiler-style-warn)

-                         (for-real #'compiler-note)
+                         (for-real #'compiler-notify)

                          (t nil))
      :really-assert
      (and for-real
                          (t nil))
      :really-assert
      (and for-real

diff --git a/src/compiler/ir1tran.lisp b/src/compiler/ir1tran.lisp
index 542dfe0..3242c40 100644 (file)
--- a/src/compiler/ir1tran.lisp
+++ b/src/compiler/ir1tran.lisp
@@ -431,6 +431,8 @@
 \f
 ;;;; IR1-CONVERT, macroexpansion and special form dispatching
 
 \f
 ;;;; IR1-CONVERT, macroexpansion and special form dispatching
 

+(declaim (ftype (sfunction (continuation continuation t) (values))
+               ir1-convert))

 (macrolet (;; Bind *COMPILER-ERROR-BAILOUT* to a function that throws
           ;; out of the body and converts a proxy form instead.
           (ir1-error-bailout ((start
 (macrolet (;; Bind *COMPILER-ERROR-BAILOUT* to a function that throws
           ;; out of the body and converts a proxy form instead.
           (ir1-error-bailout ((start

@@ -461,7 +463,6 @@
   ;; the creation using backquote of forms that contain leaf
   ;; references, without having to introduce dummy names into the
   ;; namespace.
   ;; the creation using backquote of forms that contain leaf
   ;; references, without having to introduce dummy names into the
   ;; namespace.

-  (declaim (ftype (sfunction (continuation continuation t) (values)) ir1-convert))

   (defun ir1-convert (start cont form)
     (ir1-error-bailout (start cont form)
       (let ((*current-path* (or (gethash form *source-paths*)
   (defun ir1-convert (start cont form)
     (ir1-error-bailout (start cont form)
       (let ((*current-path* (or (gethash form *source-paths*)

@@ -701,7 +702,7 @@
                      ;; WHN 19990412
                      #+(and cmu sb-xc-host)
                      (warning (lambda (c)
                      ;; WHN 19990412
                      #+(and cmu sb-xc-host)
                      (warning (lambda (c)

-                                (compiler-note
+                                (compiler-notify

                                  "~@<~A~:@_~
                                   ~A~:@_~
                                   ~@<(KLUDGE: That was a non-STYLE WARNING. ~
                                  "~@<~A~:@_~
                                   ~A~:@_~
                                   ~@<(KLUDGE: That was a non-STYLE WARNING. ~

@@ -794,12 +795,12 @@
        (let ((transform (info :function
                               :source-transform
                               (leaf-source-name var))))
        (let ((transform (info :function
                               :source-transform
                               (leaf-source-name var))))

-         (if transform
-             (multiple-value-bind (result pass) (funcall transform form)
-               (if pass
-                   (ir1-convert-maybe-predicate start cont form var)
+          (if transform
+              (multiple-value-bind (result pass) (funcall transform form)
+                (if pass
+                    (ir1-convert-maybe-predicate start cont form var)

                    (ir1-convert start cont result)))
                    (ir1-convert start cont result)))

-             (ir1-convert-maybe-predicate start cont form var))))))
+              (ir1-convert-maybe-predicate start cont form var))))))

 
 ;;; If the function has the PREDICATE attribute, and the CONT's DEST
 ;;; isn't an IF, then we convert (IF <form> T NIL), ensuring that a
 
 ;;; If the function has the PREDICATE attribute, and the CONT's DEST
 ;;; isn't an IF, then we convert (IF <form> T NIL), ensuring that a

@@ -970,7 +971,7 @@
           (found
            (setf (leaf-type found) type)
            (assert-definition-type found type
           (found
            (setf (leaf-type found) type)
            (assert-definition-type found type

-                                   :unwinnage-fun #'compiler-note
+                                   :unwinnage-fun #'compiler-notify

                                    :where "FTYPE declaration"))
           (t
            (res (cons (find-lexically-apparent-fun
                                    :where "FTYPE declaration"))
           (t
            (res (cons (find-lexically-apparent-fun

@@ -1046,9 +1047,9 @@
              (etypecase found
                (functional
                 (when (policy *lexenv* (>= speed inhibit-warnings))
              (etypecase found
                (functional
                 (when (policy *lexenv* (>= speed inhibit-warnings))

-                  (compiler-note "ignoring ~A declaration not at ~
-                                  definition of local function:~%  ~S"
-                                 sense name)))
+                  (compiler-notify "ignoring ~A declaration not at ~
+                                    definition of local function:~%  ~S"
+                                   sense name)))

                (global-var
                 (push (cons name (make-new-inlinep found sense))
                       new-fenv)))))))
                (global-var
                 (push (cons name (make-new-inlinep found sense))
                       new-fenv)))))))

@@ -1140,7 +1141,7 @@
                                   "in VALUES declaration"))))
       (dynamic-extent
        (when (policy *lexenv* (> speed inhibit-warnings))
                                   "in VALUES declaration"))))
       (dynamic-extent
        (when (policy *lexenv* (> speed inhibit-warnings))

-        (compiler-note
+        (compiler-notify

          "compiler limitation: ~
         ~%  There's no special support for DYNAMIC-EXTENT (so it's ignored)."))
        res)
          "compiler limitation: ~
         ~%  There's no special support for DYNAMIC-EXTENT (so it's ignored)."))
        res)

diff --git a/src/compiler/ir1util.lisp b/src/compiler/ir1util.lisp
index 0a9d898..02797be 100644 (file)
--- a/src/compiler/ir1util.lisp
+++ b/src/compiler/ir1util.lisp
@@ -862,8 +862,8 @@
                (return-block (and return (node-block return))))
          (unless (leaf-ever-used clambda)
            (let ((*compiler-error-context* bind))
                (return-block (and return (node-block return))))
          (unless (leaf-ever-used clambda)
            (let ((*compiler-error-context* bind))

-             (compiler-note "deleting unused function~:[.~;~:*~%  ~S~]"
-                            (leaf-debug-name clambda))))
+             (compiler-notify "deleting unused function~:[.~;~:*~%  ~S~]"
+                              (leaf-debug-name clambda))))

           (unless (block-delete-p bind-block)
             (unlink-blocks (component-head component) bind-block))
          (when (and return-block (not (block-delete-p return-block)))
           (unless (block-delete-p bind-block)
             (unlink-blocks (component-head component) bind-block))
          (when (and return-block (not (block-delete-p return-block)))

@@ -1240,7 +1240,7 @@
                                          0)))
            (unless (return-p node)
              (let ((*compiler-error-context* node))
                                          0)))
            (unless (return-p node)
              (let ((*compiler-error-context* node))

-               (compiler-note "deleting unreachable code")))
+               (compiler-notify "deleting unreachable code")))

            (return))))))
   (values))
 
            (return))))))
   (values))
 

@@ -1594,10 +1594,10 @@
           ;; compiler to be able to use WITH-COMPILATION-UNIT on
           ;; arbitrarily huge blocks of code. -- WHN)
           (let ((*compiler-error-context* node))
           ;; compiler to be able to use WITH-COMPILATION-UNIT on
           ;; arbitrarily huge blocks of code. -- WHN)
           (let ((*compiler-error-context* node))

-            (compiler-note "*INLINE-EXPANSION-LIMIT* (~W) was exceeded, ~
-                            probably trying to~%  ~
-                            inline a recursive function."
-                           *inline-expansion-limit*))
+            (compiler-notify "*INLINE-EXPANSION-LIMIT* (~W) was exceeded, ~
+                              probably trying to~%  ~
+                              inline a recursive function."
+                             *inline-expansion-limit*))

           nil)
          (t t))))
 \f
           nil)
          (t t))))
 \f

@@ -1695,7 +1695,7 @@
             (policy (or node *lexenv*)
                     (= inhibit-warnings 0)))
     (let ((*compiler-error-context* node))
             (policy (or node *lexenv*)
                     (= inhibit-warnings 0)))
     (let ((*compiler-error-context* node))

-      (compiler-note (event-info-description info))))
+      (compiler-notify (event-info-description info))))

 
   (let ((action (event-info-action info)))
     (when action (funcall action node))))
 
   (let ((action (event-info-action info)))
     (when action (funcall action node))))

diff --git a/src/compiler/locall.lisp b/src/compiler/locall.lisp
index d4ce370..be089db 100644 (file)
--- a/src/compiler/locall.lisp
+++ b/src/compiler/locall.lisp
@@ -347,9 +347,9 @@
                                       original-functional)))))))
        (cond (losing-local-functional
               (let ((*compiler-error-context* call))
                                       original-functional)))))))
        (cond (losing-local-functional
               (let ((*compiler-error-context* call))

-                (compiler-note "couldn't inline expand because expansion ~
-                                calls this LET-converted local function:~
-                                ~%  ~S"
+                (compiler-notify "couldn't inline expand because expansion ~
+                                  calls this LET-converted local function:~
+                                  ~%  ~S"

                                (leaf-debug-name losing-local-functional)))
               original-functional)
              (t
                                (leaf-debug-name losing-local-functional)))
               original-functional)
              (t

@@ -602,7 +602,7 @@
          (let ((cont (first key)))
            (unless (constant-continuation-p cont)
              (when flame
          (let ((cont (first key)))
            (unless (constant-continuation-p cont)
              (when flame

-               (compiler-note "non-constant keyword in keyword call"))
+               (compiler-notify "non-constant keyword in keyword call"))

              (setf (basic-combination-kind call) :error)
              (return-from convert-more-call))
 
              (setf (basic-combination-kind call) :error)
              (return-from convert-more-call))
 

@@ -616,7 +616,7 @@
                          (setq allow-found t
                                allowp (continuation-value val)))
                         (t (when flame
                          (setq allow-found t
                                allowp (continuation-value val)))
                         (t (when flame

-                             (compiler-note "non-constant :ALLOW-OTHER-KEYS value"))
+                             (compiler-notify "non-constant :ALLOW-OTHER-KEYS value"))

                            (setf (basic-combination-kind call) :error)
                            (return-from convert-more-call)))))
              (dolist (var (key-vars)
                            (setf (basic-combination-kind call) :error)
                            (return-from convert-more-call)))))
              (dolist (var (key-vars)

diff --git a/src/compiler/ltn.lisp b/src/compiler/ltn.lisp
index 3929851..826b8e3 100644 (file)
--- a/src/compiler/ltn.lisp
+++ b/src/compiler/ltn.lisp
@@ -669,7 +669,7 @@
 ;;; known type.
 ;;;
 ;;; We go to some trouble to make the whole multi-line output into a
 ;;; known type.
 ;;;
 ;;; We go to some trouble to make the whole multi-line output into a

-;;; single call to COMPILER-NOTE so that repeat messages are
+;;; single call to COMPILER-NOTIFY so that repeat messages are

 ;;; suppressed, etc.
 (defun note-rejected-templates (call ltn-policy template)
   (declare (type combination call) (type ltn-policy ltn-policy)
 ;;; suppressed, etc.
 (defun note-rejected-templates (call ltn-policy template)
   (declare (type combination call) (type ltn-policy ltn-policy)

@@ -727,16 +727,16 @@
              (count 1))))
 
        (let ((*compiler-error-context* call))
              (count 1))))
 
        (let ((*compiler-error-context* call))

-         (compiler-note "~{~?~^~&~6T~}"
-                        (if template
-                            `("forced to do ~A (cost ~W)"
-                              (,(or (template-note template)
-                                    (template-name template))
-                               ,(template-cost template))
-                              . ,(messages))
-                            `("forced to do full call"
-                              nil
-                              . ,(messages))))))))
+         (compiler-notify "~{~?~^~&~6T~}"
+                          (if template
+                              `("forced to do ~A (cost ~W)"
+                                (,(or (template-note template)
+                                      (template-name template))
+                                 ,(template-cost template))
+                                . ,(messages))
+                              `("forced to do full call"
+                                nil
+                                . ,(messages))))))))

   (values))
 
 ;;; If a function has a special-case annotation method use that,
   (values))
 
 ;;; If a function has a special-case annotation method use that,

diff --git a/src/compiler/represent.lisp b/src/compiler/represent.lisp
index f8151f2..ec70efa 100644 (file)
--- a/src/compiler/represent.lisp
+++ b/src/compiler/represent.lisp
@@ -370,15 +370,15 @@
                                                (vop-args op-vop)
                                                (vop-results op-vop)))
                               (error "couldn't find op? bug!")))))
                                                (vop-args op-vop)
                                                (vop-results op-vop)))
                               (error "couldn't find op? bug!")))))

-            (compiler-note
+            (compiler-notify

              "doing ~A (cost ~W)~:[~2*~; ~:[to~;from~] ~S~], for:~%~6T~
               the ~:R ~:[result~;argument~] of ~A"
              note cost name arg-p name
              pos arg-p op-note)))
          (t
              "doing ~A (cost ~W)~:[~2*~; ~:[to~;from~] ~S~], for:~%~6T~
               the ~:R ~:[result~;argument~] of ~A"
              note cost name arg-p name
              pos arg-p op-note)))
          (t

-          (compiler-note "doing ~A (cost ~W)~@[ from ~S~]~@[ to ~S~]"
-                         note cost (get-operand-name op-tn t)
-                         (get-operand-name dest-tn nil)))))
+          (compiler-notify "doing ~A (cost ~W)~@[ from ~S~]~@[ to ~S~]"
+                           note cost (get-operand-name op-tn t)
+                           (get-operand-name dest-tn nil)))))

   (values))
 
 ;;; Find a move VOP to move from the operand OP-TN to some other
   (values))
 
 ;;; Find a move VOP to move from the operand OP-TN to some other

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 82a5fa7..0d6d07f 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -569,7 +569,7 @@
                                (specifier-type 'function)))
                (when (policy *compiler-error-context*
                              (> speed inhibit-warnings))
                                (specifier-type 'function)))
                (when (policy *compiler-error-context*
                              (> speed inhibit-warnings))

-                 (compiler-note
+                 (compiler-notify

                   "~S may not be a function, so must coerce at run-time."
                   n-fun))
                (once-only ((n-fun `(if (functionp ,n-fun)
                   "~S may not be a function, so must coerce at run-time."
                   n-fun))
                (once-only ((n-fun `(if (functionp ,n-fun)

diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index 2ec8bc6..b473f7f 100644 (file)
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -220,8 +220,8 @@
   (let ((spec (hairy-type-specifier type)))
     (cond ((unknown-type-p type)
           (when (policy *lexenv* (> speed inhibit-warnings))
   (let ((spec (hairy-type-specifier type)))
     (cond ((unknown-type-p type)
           (when (policy *lexenv* (> speed inhibit-warnings))

-            (compiler-note "can't open-code test of unknown type ~S"
-                           (type-specifier type)))
+            (compiler-notify "can't open-code test of unknown type ~S"
+                             (type-specifier type)))

           `(%typep ,object ',spec))
          (t
           (ecase (first spec)
           `(%typep ,object ',spec))
          (t
           (ecase (first spec)

diff --git a/version.lisp-expr b/version.lisp-expr
index 42f97f2..f2fecc3 100644 (file)
--- 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".)
 ;;; 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".)

-"0.8.0.73"
+"0.8.0.74"