0.7.13.7:
[sbcl.git] / src / code / error.lisp
1 ;;;; SBCL-specific parts of the condition system, i.e. parts which
2 ;;;; don't duplicate/clobber functionality already provided by the
3 ;;;; cross-compilation host Common Lisp
4
5 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; more information.
7 ;;;;
8 ;;;; This software is derived from the CMU CL system, which was
9 ;;;; written at Carnegie Mellon University and released into the
10 ;;;; public domain. The software is in the public domain and is
11 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
12 ;;;; files for more information.
13
14 (in-package "SB!KERNEL")
15
16 (define-condition simple-style-warning (simple-condition style-warning) ())
17
18 ;;; not sure this is the right place, but where else?
19 (defun style-warn (format-control &rest format-arguments)
20   (/show0 "entering STYLE-WARN")
21   (/show format-control format-arguments)
22   (warn 'simple-style-warning
23         :format-control format-control
24         :format-arguments format-arguments))
25
26 (define-condition sb!kernel:layout-invalid (type-error)
27   ()
28   (:report
29    (lambda (condition stream)
30      (format stream
31              "~@<invalid structure layout: ~
32               ~2I~_A test for class ~4I~_~S ~
33               ~2I~_was passed the obsolete instance ~4I~_~S~:>"
34              (sb!kernel:class-proper-name (type-error-expected-type condition))
35              (type-error-datum condition)))))
36
37 (define-condition case-failure (type-error)
38   ((name :reader case-failure-name :initarg :name)
39    (possibilities :reader case-failure-possibilities :initarg :possibilities))
40   (:report
41     (lambda (condition stream)
42       (format stream "~@<~S fell through ~S expression. ~
43                       ~:_Wanted one of ~:S.~:>"
44               (type-error-datum condition)
45               (case-failure-name condition)
46               (case-failure-possibilities condition)))))
47
48 (define-condition simple-control-error (simple-condition control-error) ())
49 (define-condition simple-file-error    (simple-condition file-error)    ())
50 (define-condition simple-program-error (simple-condition program-error) ())
51 (define-condition simple-stream-error  (simple-condition stream-error)  ())
52 (define-condition simple-parse-error   (simple-condition parse-error)   ())
53
54 ;;; This condition is signalled whenever we make a UNKNOWN-TYPE so that
55 ;;; compiler warnings can be emitted as appropriate.
56 (define-condition parse-unknown-type (condition)
57   ((specifier :reader parse-unknown-type-specifier :initarg :specifier)))
58
59 (define-condition control-stack-exhausted (storage-condition)
60   ()
61   (:report
62     (lambda (condition stream)
63       (declare (ignore condition))
64       (format stream
65              "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."))))
66