0.8.6.40:

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

diff --git a/src/code/error.lisp b/src/code/error.lisp
index 25ef8e3..163c0e3 100644 (file)
--- a/src/code/error.lisp
+++ b/src/code/error.lisp
@@ -23,7 +23,34 @@
        :format-control format-control
        :format-arguments format-arguments))
 
        :format-control format-control
        :format-arguments format-arguments))
 

-(define-condition sb!kernel:layout-invalid (type-error)
+;;; a utility for SIGNAL, ERROR, CERROR, WARN, COMPILER-NOTIFY and
+;;; INVOKE-DEBUGGER: Parse the hairy argument conventions into a
+;;; single argument that's directly usable by all the other routines.
+(defun coerce-to-condition (datum arguments default-type fun-name)
+  (cond ((typep datum 'condition)
+        (if arguments
+            (cerror "Ignore the additional arguments."
+                    'simple-type-error
+                    :datum arguments
+                    :expected-type 'null
+                    :format-control "You may not supply additional arguments ~
+                                    when giving ~S to ~S."
+                    :format-arguments (list datum fun-name)))
+        datum)
+       ((symbolp datum) ; roughly, (SUBTYPEP DATUM 'CONDITION)
+        (apply #'make-condition datum arguments))
+       ((or (stringp datum) (functionp datum))
+        (make-condition default-type
+                        :format-control datum
+                        :format-arguments arguments))
+       (t
+        (error 'simple-type-error
+               :datum datum
+               :expected-type '(or symbol string)
+               :format-control "bad argument to ~S: ~S"
+               :format-arguments (list fun-name datum)))))
+
+(define-condition layout-invalid (type-error)

   ()
   (:report
    (lambda (condition stream)
   ()
   (:report
    (lambda (condition stream)

@@ -31,7 +58,7 @@
             "~@<invalid structure layout: ~
               ~2I~_A test for class ~4I~_~S ~
               ~2I~_was passed the obsolete instance ~4I~_~S~:>"
             "~@<invalid structure layout: ~
               ~2I~_A test for class ~4I~_~S ~
               ~2I~_was passed the obsolete instance ~4I~_~S~:>"

-            (sb!kernel:class-proper-name (type-error-expected-type condition))
+            (classoid-proper-name (type-error-expected-type condition))

             (type-error-datum condition)))))
 
 (define-condition case-failure (type-error)
             (type-error-datum condition)))))
 
 (define-condition case-failure (type-error)

@@ -49,16 +76,13 @@
 (define-condition simple-file-error    (simple-condition file-error)    ())
 (define-condition simple-program-error (simple-condition program-error) ())
 (define-condition simple-stream-error  (simple-condition stream-error)  ())
 (define-condition simple-file-error    (simple-condition file-error)    ())
 (define-condition simple-program-error (simple-condition program-error) ())
 (define-condition simple-stream-error  (simple-condition stream-error)  ())

-
-;;; This condition is signalled whenever we make a UNKNOWN-TYPE so that
-;;; compiler warnings can be emitted as appropriate.
-(define-condition parse-unknown-type (condition)
-  ((specifier :reader parse-unknown-type-specifier :initarg :specifier)))
+(define-condition simple-parse-error   (simple-condition parse-error)   ())

 
 (define-condition control-stack-exhausted (storage-condition)
   ()
   (:report
     (lambda (condition stream)
 
 (define-condition control-stack-exhausted (storage-condition)
   ()
   (:report
     (lambda (condition stream)

+      (declare (ignore condition))

       (format stream
              "Control stack exhausted (no more space for function call frames).  This is probably due to heavily nested or infinitely recursive function calls, or a tail call that SBCL cannot or has not optimized away."))))
 
       (format stream
              "Control stack exhausted (no more space for function call frames).  This is probably due to heavily nested or infinitely recursive function calls, or a tail call that SBCL cannot or has not optimized away."))))