;;; The current code doesn't seem to quite match that.
(def!method print-object ((x condition) stream)
(if *print-escape*
- (print-unreadable-object (x stream :type t :identity t))
+ (if (and (typep x 'simple-condition) (slot-boundp x 'format-control))
+ (print-unreadable-object (x stream :type t :identity t)
+ (format stream "~S" (simple-condition-format-control x)))
+ (print-unreadable-object (x stream :type t :identity t)))
;; KLUDGE: A comment from CMU CL here said
;; 7/13/98 BUG? CPL is not sorted and results here depend on order of
;; superclasses in define-condition call!
',(all-writers)
(sb!c:source-location)))))))
\f
-;;;; DESCRIBE on CONDITIONs
-
-;;; a function to be used as the guts of DESCRIBE-OBJECT (CONDITION T)
-;;; eventually (once we get CLOS up and running so that we can define
-;;; methods)
-(defun describe-condition (condition stream)
- (format stream
- "~&~@<~S ~_is a ~S. ~_Its slot values are ~_~S.~:>~%"
- condition
- (type-of condition)
- (concatenate 'list
- (condition-actual-initargs condition)
- (condition-assigned-slots condition))))
-\f
;;;; various CONDITIONs specified by ANSI
(define-condition serious-condition (condition) ())
(define-condition type-warning (reference-condition simple-warning)
()
(:default-initargs :references (list '(:sbcl :node "Handling of Types"))))
+(define-condition type-style-warning (reference-condition simple-style-warning)
+ ()
+ (:default-initargs :references (list '(:sbcl :node "Handling of Types"))))
(define-condition local-argument-mismatch (reference-condition simple-warning)
()
(:default-initargs :references `((:ansi-cl :section (2 1 1 2))
(:ansi-cl :glossary "standard readtable"))))
+(define-condition standard-pprint-dispatch-table-modified-error
+ (reference-condition error)
+ ((operation :initarg :operation
+ :reader standard-pprint-dispatch-table-modified-operation))
+ (:report (lambda (condition stream)
+ (format stream "~S would modify the standard pprint dispatch table."
+ (standard-pprint-dispatch-table-modified-operation
+ condition))))
+ (:default-initargs
+ :references `((:ansi-cl :glossary "standard pprint dispatch table"))))
+
(define-condition timeout (serious-condition)
((seconds :initarg :seconds :initform nil :reader timeout-seconds))
(:report (lambda (condition stream)