1 ;;;; This software is part of the SBCL system. See the README file for
4 ;;;; This software is derived from the CMU CL system, which was
5 ;;;; written at Carnegie Mellon University and released into the
6 ;;;; public domain. The software is in the public domain and is
7 ;;;; provided with absolutely no warranty. See the COPYING and CREDITS
8 ;;;; files for more information.
10 (in-package "SB!KERNEL")
12 (!defstruct-with-alternate-metaclass condition
13 :slot-names
(actual-initargs assigned-slots
)
14 :boa-constructor %make-condition-object
16 :metaclass-name condition-classoid
17 :metaclass-constructor make-condition-classoid
20 ;;; Define just enough condition-classoids to get TYPEP
21 ;;; to optimize into classoid-typep.
22 (macrolet ((def (name direct-supers
&rest inherits
)
23 `(eval-when (:compile-toplevel
:execute
)
24 ;; INHERITS is a list of symbols, unevaluated,
25 ;; excluding T which is assumed.
26 (%compiler-define-condition
27 ',name
',direct-supers
29 :classoid
(make-undefined-classoid name
)
30 :inherits
(map 'vector
#'find-layout
(cons t inherits
))
34 ;; These are grotesquely OAOO-violating, but on the bright side,
35 ;; compilation will fail if the subsequent real definition differs,
36 ;; so there's a built-in safety net.
37 ;; As has been suggested in 'cross-condition', a DEF!CONDITION macro
38 ;; might help, but still that's possibly not a complete solution,
39 ;; because DEBUG-CONDITION is defined in a file with the :NOT-HOST flag.
40 (def warning
(condition) condition
)
41 (def style-warning
(warning) condition warning
)
42 (def compiler-note
(condition) condition
)
43 (def parse-unknown-type
(condition) condition
)
44 (def parse-deprecated-type
(condition) condition
)
45 (def serious-condition
(condition) condition
)
46 (def error
(serious-condition) condition serious-condition
)
47 (def sb
!di
:debug-condition
(serious-condition) condition serious-condition
)
48 (def stream-error
(error) condition serious-condition error
)
49 (def reference-condition
(condition) condition
)