189 |
|
|
190 |
#+kcl |
#+kcl |
191 |
(progn |
(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) |
(define-condition internal-error ( error) |
206 |
#-(or clos pcl) |
#-(or clos pcl) |
207 |
((function-name nil)) |
((function-name nil)) |
222 |
(apply #'format stream (simple-condition-format-string condition) |
(apply #'format stream (simple-condition-format-string condition) |
223 |
(simple-condition-format-arguments condition))) |
(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 |
(define-condition internal-simple-error |
233 |
(internal-error #+(or clos pcl) simple-condition) |
(internal-error #+(or clos pcl) simple-condition) |
234 |
#-(or clos pcl) |
#-(or clos pcl) |
238 |
#-(or clos pcl)(:conc-name %%internal-simple-error-) |
#-(or clos pcl)(:conc-name %%internal-simple-error-) |
239 |
(:report internal-simple-error-printer)) |
(: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 |
(define-condition internal-type-error |
251 |
(#+(or clos pcl) internal-error type-error) |
(#+(or clos pcl) internal-error type-error) |
252 |
#-(or clos pcl) |
#-(or clos pcl) |