Remove duplicate implementations of (setf aref/sbit/bit).

[sbcl.git] / src / code / condition.lisp

diff --git a/src/code/condition.lisp b/src/code/condition.lisp
index 89ae144..c2c2a39 100644 (file)
--- a/src/code/condition.lisp
+++ b/src/code/condition.lisp
@@ -446,8 +446,6 @@
                        (dolist (initarg (condition-slot-initargs slot) nil)
                          (when (functionp (third (assoc initarg e-def-initargs)))
                            (return t))))
-               ;; TODO temp
-               (assert (not (member slot (condition-classoid-hairy-slots class))))
                (push slot (condition-classoid-hairy-slots class)))))))
       (when (boundp '*define-condition-hooks*)
         (dolist (fun *define-condition-hooks*)
@@ -625,7 +623,9 @@
              (type-error-expected-type condition)))))
 
 (def!method print-object ((condition type-error) stream)
-  (if *print-escape*
+  (if (and *print-escape*
+           (slot-boundp condition 'expected-type)
+           (slot-boundp condition 'datum))
       (flet ((maybe-string (thing)
                (ignore-errors
                  (write-to-string thing :lines 1 :readably nil :array nil :pretty t))))
@@ -696,9 +696,10 @@
 (define-condition undefined-function (cell-error) ()
   (:report
    (lambda (condition stream)
-     (format stream
-             "The function ~/sb-impl::print-symbol-with-prefix/ is undefined."
-             (cell-error-name condition)))))
+     (let ((*package* (find-package :keyword)))
+       (format stream
+               "The function ~S is undefined."
+               (cell-error-name condition))))))
 
 (define-condition special-form-function (undefined-function) ()
   (:report
@@ -977,9 +978,9 @@
   ((name :initarg :name :reader implicit-generic-function-name))
   (:report
    (lambda (condition stream)
-     (let ((*package* (find-package :keyword)))
-       (format stream "~@<Implicitly creating new generic function ~S.~:@>"
-               (implicit-generic-function-name condition))))))
+     (format stream "~@<Implicitly creating new generic function ~
+                     ~/sb-impl::print-symbol-with-prefix/.~:@>"
+             (implicit-generic-function-name condition)))))
 
 (define-condition extension-failure (reference-condition simple-error)
   ())
@@ -1052,8 +1053,11 @@ SB-EXT:PACKAGE-LOCKED-ERROR-SYMBOL."))
 (define-condition undefined-alien-function-error (undefined-alien-error) ()
   (:report
    (lambda (condition stream)
-     (declare (ignore condition))
-     (format stream "Attempt to call an undefined alien function."))))
+     (if (and (slot-boundp condition 'name)
+              (cell-error-name condition))
+         (format stream "The alien function ~s is undefined."
+                 (cell-error-name condition))
+         (format stream "Attempt to call an undefined alien function.")))))
 
 \f
 ;;;; various other (not specified by ANSI) CONDITIONs
@@ -1393,13 +1397,14 @@ handled by any other handler, it will be muffled.")
   (let ((new (function-redefinition-warning-new-function warning))
         (source-location (redefinition-warning-new-location warning)))
     (or
-     ;; Compiled->Interpreted is interesting.
+     ;; compiled->interpreted is interesting.
      (and (typep old 'compiled-function)
           (typep new '(not compiled-function)))
-     ;; FIN->Regular is interesting.
-     (and (typep old 'funcallable-instance)
+     ;; fin->regular is interesting except for interpreted->compiled.
+     (and (typep old '(and funcallable-instance
+                           #!+sb-eval (not sb!eval:interpreted-function)))
           (typep new '(not funcallable-instance)))
-     ;; Different file or unknown location is interesting.
+     ;; different file or unknown location is interesting.
      (let* ((old-namestring (function-file-namestring old))
             (new-namestring
              (or (function-file-namestring new)