1 |
|
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: "CONDITIONS"; Base: 10 -*- |
2 |
|
|
3 |
|
(IN-PACKAGE "CONDITIONS") |
4 |
|
|
5 |
|
(eval-when (compile load eval) |
6 |
|
(pushnew #+(or clos pcl) :clos-conditions #-(or clos pcl) :defstruct-conditions |
7 |
|
*features*) |
8 |
|
) |
9 |
|
|
10 |
|
(eval-when (compile load eval) |
11 |
|
(when (and (member :clos-conditions *features*) |
12 |
|
(member :defstruct-conditions *features*)) |
13 |
|
(dolist (sym '(simple-condition-format-string simple-condition-format-arguments |
14 |
|
type-error-datum type-error-expected-type |
15 |
|
case-failure-name case-failure-possibilities |
16 |
|
stream-error-stream file-error-pathname package-error-package |
17 |
|
cell-error-name arithmetic-error-operation |
18 |
|
internal-error-function-name)) |
19 |
|
(when (fboundp sym) (fmakunbound sym))) |
20 |
|
(setq *features* (remove :defstruct-conditions *features*))) |
21 |
|
) |
22 |
|
|
23 |
|
(DEFINE-CONDITION WARNING (CONDITION) |
24 |
|
()) |
25 |
|
|
26 |
|
(DEFINE-CONDITION SERIOUS-CONDITION (CONDITION) |
27 |
|
()) |
28 |
|
|
29 |
|
(DEFINE-CONDITION ERROR (SERIOUS-CONDITION) |
30 |
|
()) |
31 |
|
|
32 |
|
(DEFUN SIMPLE-CONDITION-PRINTER (CONDITION STREAM) |
33 |
|
(APPLY #'FORMAT STREAM (SIMPLE-CONDITION-FORMAT-STRING CONDITION) |
34 |
|
(SIMPLE-CONDITION-FORMAT-ARGUMENTS CONDITION))) |
35 |
|
|
36 |
|
(DEFINE-CONDITION SIMPLE-CONDITION (CONDITION) |
37 |
|
#-(or clos pcl) |
38 |
|
(FORMAT-STRING (FORMAT-ARGUMENTS '())) |
39 |
|
#+(or clos pcl) |
40 |
|
((FORMAT-STRING :type string |
41 |
|
:initarg :FORMAT-STRING |
42 |
|
:reader SIMPLE-CONDITION-FORMAT-STRING) |
43 |
|
(FORMAT-ARGUMENTS :initarg :FORMAT-ARGUMENTS |
44 |
|
:reader SIMPLE-CONDITION-FORMAT-ARGUMENTS |
45 |
|
:initform '())) |
46 |
|
#-(or clos pcl)(:CONC-NAME %%SIMPLE-CONDITION-) |
47 |
|
(:REPORT SIMPLE-CONDITION-PRINTER)) |
48 |
|
|
49 |
|
(DEFINE-CONDITION SIMPLE-WARNING (#+(or clos pcl) SIMPLE-CONDITION WARNING) |
50 |
|
#-(or clos pcl) |
51 |
|
(FORMAT-STRING (FORMAT-ARGUMENTS '())) |
52 |
|
#+(or clos pcl) |
53 |
|
() |
54 |
|
#-(or clos pcl)(:CONC-NAME %%SIMPLE-WARNING-) |
55 |
|
#-(or clos pcl)(:REPORT SIMPLE-CONDITION-PRINTER)) |
56 |
|
|
57 |
|
(DEFINE-CONDITION SIMPLE-ERROR (#+(or clos pcl) SIMPLE-CONDITION ERROR) |
58 |
|
#-(or clos pcl) |
59 |
|
(FORMAT-STRING (FORMAT-ARGUMENTS '())) |
60 |
|
#+(or clos pcl) |
61 |
|
() |
62 |
|
#-(or clos pcl)(:CONC-NAME %%SIMPLE-ERROR-) |
63 |
|
#-(or clos pcl)(:REPORT SIMPLE-CONDITION-PRINTER)) |
64 |
|
|
65 |
|
(DEFINE-CONDITION STORAGE-CONDITION (SERIOUS-CONDITION) ()) |
66 |
|
|
67 |
|
(DEFINE-CONDITION STACK-OVERFLOW (STORAGE-CONDITION) ()) |
68 |
|
|
69 |
|
(DEFINE-CONDITION STORAGE-EXHAUSTED (STORAGE-CONDITION) ()) |
70 |
|
|
71 |
|
(DEFINE-CONDITION TYPE-ERROR (ERROR) |
72 |
|
#-(or clos pcl) |
73 |
|
(DATUM EXPECTED-TYPE) |
74 |
|
#+(or clos pcl) |
75 |
|
((DATUM :initarg :DATUM |
76 |
|
:reader TYPE-ERROR-DATUM) |
77 |
|
(EXPECTED-TYPE :initarg :EXPECTED-TYPE |
78 |
|
:reader TYPE-ERROR-EXPECTED-TYPE)) |
79 |
|
(:report |
80 |
|
(lambda (condition stream) |
81 |
|
(format stream "~S is not of type ~S." |
82 |
|
(TYPE-ERROR-DATUM CONDITION) |
83 |
|
(TYPE-ERROR-EXPECTED-TYPE CONDITION))))) |
84 |
|
|
85 |
|
(DEFINE-CONDITION SIMPLE-TYPE-ERROR (#+(or clos pcl) SIMPLE-CONDITION TYPE-ERROR) |
86 |
|
#-(or clos pcl) |
87 |
|
(FORMAT-STRING (FORMAT-ARGUMENTS '())) |
88 |
|
#+(or clos pcl) |
89 |
|
() |
90 |
|
#-(or clos pcl)(:CONC-NAME %%SIMPLE-TYPE-ERROR-) |
91 |
|
#-(or clos pcl)(:REPORT SIMPLE-CONDITION-PRINTER)) |
92 |
|
|
93 |
|
(DEFINE-CONDITION CASE-FAILURE (TYPE-ERROR) |
94 |
|
#-(or clos pcl) |
95 |
|
(NAME POSSIBILITIES) |
96 |
|
#+(or clos pcl) |
97 |
|
((NAME :initarg :NAME |
98 |
|
:reader CASE-FAILURE-NAME) |
99 |
|
(POSSIBILITIES :initarg :POSSIBILITIES |
100 |
|
:reader CASE-FAILURE-POSSIBILITIES)) |
101 |
|
(:REPORT |
102 |
|
(LAMBDA (CONDITION STREAM) |
103 |
|
(FORMAT STREAM "~S fell through ~S expression.~%Wanted one of ~:S." |
104 |
|
(TYPE-ERROR-DATUM CONDITION) |
105 |
|
(CASE-FAILURE-NAME CONDITION) |
106 |
|
(CASE-FAILURE-POSSIBILITIES CONDITION))))) |
107 |
|
|
108 |
|
(DEFINE-CONDITION PROGRAM-ERROR (ERROR) |
109 |
|
()) |
110 |
|
|
111 |
|
(DEFINE-CONDITION CONTROL-ERROR (ERROR) |
112 |
|
()) |
113 |
|
|
114 |
|
(DEFINE-CONDITION PARSE-ERROR (ERROR) |
115 |
|
()) |
116 |
|
|
117 |
|
(DEFINE-CONDITION STREAM-ERROR (ERROR) |
118 |
|
#-(or clos pcl) |
119 |
|
(STREAM) |
120 |
|
#+(or clos pcl) |
121 |
|
((STREAM :initarg :STREAM |
122 |
|
:reader STREAM-ERROR-STREAM))) |
123 |
|
|
124 |
|
(DEFINE-CONDITION END-OF-FILE (STREAM-ERROR) |
125 |
|
() |
126 |
|
(:REPORT (LAMBDA (CONDITION STREAM) |
127 |
|
(FORMAT STREAM "Unexpected end of file on ~S." |
128 |
|
(STREAM-ERROR-STREAM CONDITION))))) |
129 |
|
|
130 |
|
(DEFINE-CONDITION FILE-ERROR (ERROR) |
131 |
|
#-(or clos pcl) |
132 |
|
(PATHNAME) |
133 |
|
#+(or clos pcl) |
134 |
|
((PATHNAME :initarg :PATHNAME |
135 |
|
:reader FILE-ERROR-PATHNAME))) |
136 |
|
|
137 |
|
(DEFINE-CONDITION PACKAGE-ERROR (ERROR) |
138 |
|
#-(or clos pcl) |
139 |
|
(PACKAGE) |
140 |
|
#+(or clos pcl) |
141 |
|
((PACKAGE :initarg :PACKAGE |
142 |
|
:reader PACKAGE-ERROR-PACKAGE) |
143 |
|
(MESSAGE :initarg :MESSAGE |
144 |
|
:reader PACKAGE-ERROR-MESSAGE)) |
145 |
|
(:report |
146 |
|
(lambda (condition stream) |
147 |
|
(format stream "A package error occurred on ~S: ~S." |
148 |
|
(PACKAGE-ERROR-PACKAGE CONDITION) |
149 |
|
(PACKAGE-ERROR-MESSAGE CONDITION))))) |
150 |
|
|
151 |
|
|
152 |
|
(DEFINE-CONDITION CELL-ERROR (ERROR) |
153 |
|
#-(or clos pcl) |
154 |
|
(NAME) |
155 |
|
#+(or clos pcl) |
156 |
|
((NAME :initarg :NAME |
157 |
|
:reader CELL-ERROR-NAME))) |
158 |
|
|
159 |
|
(DEFINE-CONDITION UNBOUND-VARIABLE (CELL-ERROR) |
160 |
|
() |
161 |
|
(:REPORT (LAMBDA (CONDITION STREAM) |
162 |
|
(FORMAT STREAM "The variable ~S is unbound." |
163 |
|
(CELL-ERROR-NAME CONDITION))))) |
164 |
|
|
165 |
|
(DEFINE-CONDITION UNDEFINED-FUNCTION (CELL-ERROR) |
166 |
|
() |
167 |
|
(:REPORT (LAMBDA (CONDITION STREAM) |
168 |
|
(FORMAT STREAM "The function ~S is undefined." |
169 |
|
(CELL-ERROR-NAME CONDITION))))) |
170 |
|
|
171 |
|
(DEFINE-CONDITION ARITHMETIC-ERROR (ERROR) |
172 |
|
#-(or clos pcl) |
173 |
|
(OPERATION OPERANDS) |
174 |
|
#+(or clos pcl) |
175 |
|
((OPERATION :initarg :OPERATION |
176 |
|
:reader ARITHMETIC-ERROR-OPERATION))) |
177 |
|
|
178 |
|
(DEFINE-CONDITION DIVISION-BY-ZERO (ARITHMETIC-ERROR) |
179 |
|
()) |
180 |
|
|
181 |
|
(DEFINE-CONDITION FLOATING-POINT-OVERFLOW (ARITHMETIC-ERROR) |
182 |
|
()) |
183 |
|
|
184 |
|
(DEFINE-CONDITION FLOATING-POINT-UNDERFLOW (ARITHMETIC-ERROR) |
185 |
|
()) |
186 |
|
|
187 |
|
(DEFINE-CONDITION ABORT-FAILURE (CONTROL-ERROR) () |
188 |
|
(:REPORT "Abort failed.")) |
189 |
|
|
190 |
|
#+kcl |
191 |
|
(progn |
192 |
|
(define-condition internal-warning ( warning) |
193 |
|
#-(or clos pcl) |
194 |
|
((function-name nil)) |
195 |
|
#+(or clos pcl) |
196 |
|
((function-name :initarg :function-name |
197 |
|
:reader internal-error-function-name |
198 |
|
:initform 'nil)) |
199 |
|
(:report (lambda (condition stream) |
200 |
|
(when (internal-error-function-name condition) |
201 |
|
(format stream "Warning in ~S [or a callee]: " |
202 |
|
(internal-error-function-name condition))) |
203 |
|
#+(or clos pcl)(call-next-method)))) |
204 |
|
|
205 |
|
(define-condition internal-error ( error) |
206 |
|
#-(or clos pcl) |
207 |
|
((function-name nil)) |
208 |
|
#+(or clos pcl) |
209 |
|
((function-name :initarg :function-name |
210 |
|
:reader internal-error-function-name |
211 |
|
:initform 'nil)) |
212 |
|
(:report (lambda (condition stream) |
213 |
|
(when (internal-error-function-name condition) |
214 |
|
(format stream "Error in ~S [or a callee]: " |
215 |
|
(internal-error-function-name condition))) |
216 |
|
#+(or clos pcl)(call-next-method)))) |
217 |
|
|
218 |
|
(defun internal-simple-error-printer (condition stream) |
219 |
|
(when (internal-error-function-name condition) |
220 |
|
(format stream "Error in ~S [or a callee]: " |
221 |
|
(internal-error-function-name condition))) |
222 |
|
(apply #'format stream (simple-condition-format-string condition) |
223 |
|
(simple-condition-format-arguments condition))) |
224 |
|
|
225 |
|
(defun internal-simple-warning-printer (condition stream) |
226 |
|
(when (internal-error-function-name condition) |
227 |
|
(format stream "Warning in ~S [or a callee]: " |
228 |
|
(internal-error-function-name condition))) |
229 |
|
(apply #'format stream (simple-condition-format-string condition) |
230 |
|
(simple-condition-format-arguments condition))) |
231 |
|
|
232 |
|
(define-condition internal-simple-error |
233 |
|
(internal-error #+(or clos pcl) simple-condition) |
234 |
|
#-(or clos pcl) |
235 |
|
((function-name nil) format-string (format-arguments '())) |
236 |
|
#+(or clos pcl) |
237 |
|
() |
238 |
|
#-(or clos pcl)(:conc-name %%internal-simple-error-) |
239 |
|
(:report internal-simple-error-printer)) |
240 |
|
|
241 |
|
(define-condition internal-simple-warning |
242 |
|
(internal-warning #+(or clos pcl) simple-condition) |
243 |
|
#-(or clos pcl) |
244 |
|
((function-name nil) format-string (format-arguments '())) |
245 |
|
#+(or clos pcl) |
246 |
|
() |
247 |
|
#-(or clos pcl)(:conc-name %%internal-simple-warning-) |
248 |
|
(:report internal-simple-warning-printer)) |
249 |
|
|
250 |
|
(define-condition internal-type-error |
251 |
|
(#+(or clos pcl) internal-error type-error) |
252 |
|
#-(or clos pcl) |
253 |
|
((function-name nil)) |
254 |
|
#+(or clos pcl) |
255 |
|
() |
256 |
|
#-(or clos pcl)(:conc-name %%internal-type-error-) |
257 |
|
#-(or clos pcl)(:report (lambda (condition stream) |
258 |
|
(when (internal-error-function-name condition) |
259 |
|
(format stream "Error in ~S [or a callee]: " |
260 |
|
(internal-error-function-name condition))) |
261 |
|
(format stream "~S is not of type ~S." |
262 |
|
(type-error-datum condition) |
263 |
|
(type-error-expected-type condition))))) |
264 |
|
|
265 |
|
(define-condition internal-package-error |
266 |
|
(#+(or clos pcl) internal-error package-error) |
267 |
|
#-(or clos pcl) |
268 |
|
((function-name nil)) |
269 |
|
#+(or clos pcl) |
270 |
|
() |
271 |
|
#-(or clos pcl)(:conc-name %%internal-package-error-) |
272 |
|
#-(or clos pcl)(:report (lambda (condition stream) |
273 |
|
(when (internal-error-function-name condition) |
274 |
|
(format stream "Error in ~S [or a callee]: " |
275 |
|
(internal-error-function-name condition))) |
276 |
|
(format stream "A package error occurred on ~S: ~S." |
277 |
|
(package-error-package condition) |
278 |
|
(package-error-message condition))))) |
279 |
|
|
280 |
|
(define-condition internal-simple-program-error |
281 |
|
(#+(or clos pcl) internal-simple-error program-error) |
282 |
|
#-(or clos pcl) |
283 |
|
((function-name nil) format-string (format-arguments '())) |
284 |
|
#+(or clos pcl) |
285 |
|
() |
286 |
|
#-(or clos pcl)(:conc-name %%internal-simple-program-error-) |
287 |
|
#-(or clos pcl)(:report internal-simple-error-printer)) |
288 |
|
|
289 |
|
(define-condition internal-simple-parse-error |
290 |
|
(#+(or clos pcl) internal-simple-error parse-error) |
291 |
|
#-(or clos pcl) |
292 |
|
((function-name nil) format-string (format-arguments '())) |
293 |
|
#+(or clos pcl) |
294 |
|
() |
295 |
|
#-(or clos pcl)(:conc-name %%internal-simple-parse-error-) |
296 |
|
#-(or clos pcl)(:report internal-simple-error-printer)) |
297 |
|
|
298 |
|
(define-condition internal-simple-control-error |
299 |
|
(#+(or clos pcl) internal-simple-error control-error) |
300 |
|
#-(or clos pcl) |
301 |
|
((function-name nil) format-string (format-arguments '())) |
302 |
|
#+(or clos pcl) |
303 |
|
() |
304 |
|
#-(or clos pcl)(:conc-name %%internal-simple-control-error-) |
305 |
|
#-(or clos pcl)(:report internal-simple-error-printer)) |
306 |
|
|
307 |
|
(define-condition internal-unbound-variable |
308 |
|
(#+(or clos pcl) internal-error unbound-variable) |
309 |
|
#-(or clos pcl) |
310 |
|
((function-name nil)) |
311 |
|
#+(or clos pcl) |
312 |
|
() |
313 |
|
#-(or clos pcl)(:conc-name %%internal-unbound-variable-) |
314 |
|
#-(or clos pcl)(:REPORT (LAMBDA (CONDITION STREAM) |
315 |
|
(when (internal-error-function-name condition) |
316 |
|
(format stream "Error in ~S [or a callee]: " |
317 |
|
(internal-error-function-name condition))) |
318 |
|
(FORMAT STREAM "The variable ~S is unbound." |
319 |
|
(CELL-ERROR-NAME CONDITION))))) |
320 |
|
|
321 |
|
(define-condition internal-undefined-function |
322 |
|
(#+(or clos pcl) internal-error undefined-function) |
323 |
|
#-(or clos pcl) |
324 |
|
((function-name nil)) |
325 |
|
#+(or clos pcl) |
326 |
|
() |
327 |
|
#-(or clos pcl)(:conc-name %%internal-undefined-function-) |
328 |
|
#-(or clos pcl)(:REPORT (LAMBDA (CONDITION STREAM) |
329 |
|
(when (internal-error-function-name condition) |
330 |
|
(format stream "Error in ~S [or a callee]: " |
331 |
|
(internal-error-function-name condition))) |
332 |
|
(FORMAT STREAM "The function ~S is undefined." |
333 |
|
(CELL-ERROR-NAME CONDITION))))) |
334 |
|
|
335 |
|
(define-condition internal-end-of-file |
336 |
|
(#+(or clos pcl) internal-error end-of-file) |
337 |
|
#-(or clos pcl) |
338 |
|
((function-name nil)) |
339 |
|
#+(or clos pcl) |
340 |
|
() |
341 |
|
#-(or clos pcl)(:conc-name %%internal-end-of-file-) |
342 |
|
#-(or clos pcl)(:REPORT (LAMBDA (CONDITION STREAM) |
343 |
|
(when (internal-error-function-name condition) |
344 |
|
(format stream "Error in ~S [or a callee]: " |
345 |
|
(internal-error-function-name condition))) |
346 |
|
(FORMAT STREAM "Unexpected end of file on ~S." |
347 |
|
(STREAM-ERROR-STREAM CONDITION))))) |
348 |
|
|
349 |
|
(define-condition internal-simple-file-error |
350 |
|
(#+(or clos pcl) internal-simple-error file-error) |
351 |
|
#-(or clos pcl) |
352 |
|
((function-name nil) format-string (format-arguments '())) |
353 |
|
#+(or clos pcl) |
354 |
|
() |
355 |
|
#-(or clos pcl)(:conc-name %%internal-simple-file-error-) |
356 |
|
#-(or clos pcl)(:report internal-simple-error-printer)) |
357 |
|
|
358 |
|
(define-condition internal-simple-stream-error |
359 |
|
(#+(or clos pcl) internal-simple-error stream-error) |
360 |
|
#-(or clos pcl) |
361 |
|
((function-name nil) format-string (format-arguments '())) |
362 |
|
#+(or clos pcl) |
363 |
|
() |
364 |
|
#-(or clos pcl)(:conc-name %%internal-simple-stream-error-) |
365 |
|
#-(or clos pcl)(:report internal-simple-error-printer)) |
366 |
|
|
367 |
|
#-(or pcl clos) |
368 |
|
(defun internal-error-function-name (condition) |
369 |
|
(etypecase condition |
370 |
|
(internal-error |
371 |
|
(%%internal-error-function-name condition)) |
372 |
|
(internal-simple-error |
373 |
|
(%%internal-simple-error-function-name condition)) |
374 |
|
(internal-type-error |
375 |
|
(%%internal-type-error-function-name condition)) |
376 |
|
(internal-simple-program-error |
377 |
|
(%%internal-simple-program-error-function-name condition)) |
378 |
|
(internal-simple-parse-error |
379 |
|
(%%internal-simple-parse-error-function-name condition)) |
380 |
|
(internal-simple-control-error |
381 |
|
(%%internal-simple-control-error-function-name condition)) |
382 |
|
(internal-unbound-variable |
383 |
|
(%%internal-unbound-variable-function-name condition)) |
384 |
|
(internal-undefined-function |
385 |
|
(%%internal-undefined-function-function-name condition)) |
386 |
|
(internal-end-of-file |
387 |
|
(%%internal-end-of-file-function-name condition)) |
388 |
|
(internal-simple-file-error |
389 |
|
(%%internal-simple-file-error-function-name condition)) |
390 |
|
(internal-simple-stream-error |
391 |
|
(%%internal-simple-stream-error-function-name condition)))) |
392 |
|
) |
393 |
|
|
394 |
|
#-(or clos pcl) |
395 |
|
(progn |
396 |
|
|
397 |
|
(DEFUN SIMPLE-CONDITION-FORMAT-STRING (CONDITION) |
398 |
|
(ETYPECASE CONDITION |
399 |
|
(SIMPLE-CONDITION (%%SIMPLE-CONDITION-FORMAT-STRING CONDITION)) |
400 |
|
(SIMPLE-WARNING (%%SIMPLE-WARNING-FORMAT-STRING CONDITION)) |
401 |
|
(SIMPLE-TYPE-ERROR (%%SIMPLE-TYPE-ERROR-FORMAT-STRING CONDITION)) |
402 |
|
(SIMPLE-ERROR (%%SIMPLE-ERROR-FORMAT-STRING CONDITION)) |
403 |
|
#+kcl(internal-simple-error |
404 |
|
(%%internal-simple-error-format-string condition)) |
405 |
|
#+kcl(internal-simple-program-error |
406 |
|
(%%internal-simple-program-error-format-string condition)) |
407 |
|
#+kcl(internal-simple-parse-error |
408 |
|
(%%internal-simple-parse-error-format-string condition)) |
409 |
|
#+kcl(internal-simple-control-error |
410 |
|
(%%internal-simple-control-error-format-string condition)) |
411 |
|
#+kcl(internal-simple-file-error |
412 |
|
(%%internal-simple-file-error-format-string condition)) |
413 |
|
#+kcl(internal-simple-stream-error |
414 |
|
(%%internal-simple-stream-error-format-string condition)))) |
415 |
|
|
416 |
|
(DEFUN SIMPLE-CONDITION-FORMAT-ARGUMENTS (CONDITION) |
417 |
|
(ETYPECASE CONDITION |
418 |
|
(SIMPLE-CONDITION (%%SIMPLE-CONDITION-FORMAT-ARGUMENTS CONDITION)) |
419 |
|
(SIMPLE-WARNING (%%SIMPLE-WARNING-FORMAT-ARGUMENTS CONDITION)) |
420 |
|
(SIMPLE-TYPE-ERROR (%%SIMPLE-TYPE-ERROR-FORMAT-ARGUMENTS CONDITION)) |
421 |
|
(SIMPLE-ERROR (%%SIMPLE-ERROR-FORMAT-ARGUMENTS CONDITION)) |
422 |
|
#+kcl(internal-simple-error |
423 |
|
(%%internal-simple-error-format-arguments condition)) |
424 |
|
#+kcl(internal-simple-program-error |
425 |
|
(%%internal-simple-program-error-format-arguments condition)) |
426 |
|
#+kcl(internal-simple-parse-error |
427 |
|
(%%internal-simple-parse-error-format-arguments condition)) |
428 |
|
#+kcl(internal-simple-control-error |
429 |
|
(%%internal-simple-control-error-format-arguments condition)) |
430 |
|
#+kcl(internal-simple-file-error |
431 |
|
(%%internal-simple-file-error-format-arguments condition)) |
432 |
|
#+kcl(internal-simple-stream-error |
433 |
|
(%%internal-simple-stream-error-format-arguments condition)))) |
434 |
|
|
435 |
|
(defun simple-condition-class-p (type) |
436 |
|
(member type '(SIMPLE-CONDITION SIMPLE-WARNING SIMPLE-TYPE-ERROR SIMPLE-ERROR |
437 |
|
#+kcl internal-simple-error |
438 |
|
#+kcl internal-simple-program-error |
439 |
|
#+kcl internal-simple-parse-error |
440 |
|
#+kcl internal-simple-control-error |
441 |
|
#+kcl internal-simple-file-error |
442 |
|
#+kcl internal-simple-stream-error))) |
443 |
|
) |
444 |
|
|
445 |
|
#+(or clos pcl) |
446 |
|
(progn |
447 |
|
(defvar *simple-condition-class* (find-class 'simple-condition)) |
448 |
|
|
449 |
|
(defun simple-condition-class-p (TYPE) |
450 |
|
(when (symbolp TYPE) |
451 |
|
(setq TYPE (find-class TYPE))) |
452 |
|
(and (typep TYPE 'standard-class) |
453 |
|
(member *simple-condition-class* |
454 |
|
(#+pcl pcl::class-precedence-list |
455 |
|
#-pcl clos::class-precedence-list |
456 |
|
type)))) |
457 |
|
) |
458 |
|
|