/scheme/ikarus.conditions.sls
Unknown | 1706 lines | 1463 code | 243 blank | 0 comment | 0 complexity | c75a209a44bdcc6423a81a8adbf06a27 MD5 | raw file
Possible License(s): BSD-3-Clause, GPL-3.0
Large files files are truncated, but you can click here to view the full file
1;;;Ikarus Scheme -- A compiler for R6RS Scheme.
2;;;Copyright (C) 2006,2007,2008 Abdulaziz Ghuloum
3;;;Modified by Marco Maggi <marco.maggi-ipsu@poste.it>
4;;;
5;;;This program is free software: you can redistribute it and/or modify it under the
6;;;terms of the GNU General Public License version 3 as published by the Free
7;;;Software Foundation.
8;;;
9;;;This program is distributed in the hope that it will be useful, but WITHOUT ANY
10;;;WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
11;;;PARTICULAR PURPOSE. See the GNU General Public License for more details.
12;;;
13;;;You should have received a copy of the GNU General Public License along with this
14;;;program. If not, see <http://www.gnu.org/licenses/>.
15
16
17#!vicare
18(library (ikarus conditions)
19 (export
20 define-core-condition-type
21
22 condition? compound-condition? condition-and-rtd?
23 simple-condition?
24 list-of-conditions?
25 list-of-simple-conditions?
26 simple-conditions condition-predicate
27 condition condition-accessor print-condition
28
29 raise-non-continuable-standard-condition
30
31 make-message-condition message-condition?
32 condition-message make-warning warning?
33 make-serious-condition serious-condition? make-error
34 error? make-violation violation? make-assertion-violation
35 assertion-violation? make-irritants-condition
36 irritants-condition? condition-irritants
37 make-who-condition who-condition? condition-who
38 make-non-continuable-violation non-continuable-violation?
39 make-implementation-restriction-violation
40 implementation-restriction-violation?
41 make-lexical-violation lexical-violation?
42 make-syntax-violation syntax-violation?
43 syntax-violation-form syntax-violation-subform
44 make-undefined-violation undefined-violation?
45 make-i/o-error i/o-error? make-i/o-read-error
46 i/o-read-error? make-i/o-write-error i/o-write-error?
47 make-i/o-invalid-position-error
48 i/o-invalid-position-error? i/o-error-position
49 make-i/o-filename-error i/o-filename-error?
50 i/o-error-filename make-i/o-file-protection-error
51 i/o-file-protection-error? make-i/o-file-is-read-only-error
52 i/o-file-is-read-only-error?
53 make-i/o-file-already-exists-error
54 i/o-file-already-exists-error?
55 make-i/o-file-does-not-exist-error
56 i/o-file-does-not-exist-error? make-i/o-port-error
57 i/o-port-error? i/o-error-port make-i/o-decoding-error
58 i/o-decoding-error? make-i/o-encoding-error
59 i/o-encoding-error? i/o-encoding-error-char
60 no-infinities-violation? make-no-infinities-violation
61 no-nans-violation? make-no-nans-violation
62 interrupted-condition? make-interrupted-condition
63 make-source-position-condition source-position-condition?
64 source-position-port-id
65 source-position-byte source-position-character
66 source-position-line source-position-column
67
68 &condition &message &warning
69 &serious &error &violation
70 &assertion &irritants &who
71 &non-continuable &implementation-restriction
72 &lexical &syntax &undefined
73 &i/o &i/o-read &i/o-write
74 &i/o-invalid-position &i/o-filename &i/o-file-protection
75 &i/o-file-is-read-only &i/o-file-already-exists
76 &i/o-file-does-not-exist &i/o-port &i/o-decoding
77 &i/o-encoding &no-infinities
78 &no-nans &interrupted &source-position
79
80 &condition-rtd &condition-rcd &message-rtd &message-rcd
81 &warning-rtd &warning-rcd &serious-rtd &serious-rcd
82 &error-rtd &error-rcd &violation-rtd &violation-rcd
83 &assertion-rtd &assertion-rcd &irritants-rtd
84 &irritants-rcd &who-rtd &who-rcd &non-continuable-rtd
85 &non-continuable-rcd &implementation-restriction-rtd
86 &implementation-restriction-rcd &lexical-rtd &lexical-rcd
87 &syntax-rtd &syntax-rcd &undefined-rtd &undefined-rcd
88 &i/o-rtd &i/o-rcd &i/o-read-rtd &i/o-read-rcd
89 &i/o-write-rtd &i/o-write-rcd &i/o-invalid-position-rtd
90 &i/o-invalid-position-rcd &i/o-filename-rtd
91 &i/o-filename-rcd &i/o-file-protection-rtd
92 &i/o-file-protection-rcd &i/o-file-is-read-only-rtd
93 &i/o-file-is-read-only-rcd &i/o-file-already-exists-rtd
94 &i/o-file-already-exists-rcd &i/o-file-does-not-exist-rtd
95 &i/o-file-does-not-exist-rcd &i/o-port-rtd &i/o-port-rcd
96 &i/o-decoding-rtd &i/o-decoding-rcd &i/o-encoding-rtd
97 &i/o-encoding-rcd &no-infinities-rtd &no-infinities-rcd
98 &no-nans-rtd &no-nans-rcd
99 &interrupted-rtd &interrupted-rcd
100 &source-position-rtd &source-position-rcd
101
102 ;;&i/o-eagain
103 make-i/o-eagain i/o-eagain-error?
104 &i/o-eagain-rtd &i/o-eagain-rcd
105
106 ;;&errno
107 &errno-rtd &errno-rcd
108 make-errno-condition errno-condition? condition-errno
109 ;;&h_errno
110 &h_errno-rtd &h_errno-rcd
111 make-h_errno-condition h_errno-condition? condition-h_errno
112
113 ;; &i/o-wrong-fasl-header-error
114 &i/o-wrong-fasl-header-error-rtd &i/o-wrong-fasl-header-error-rcd
115 make-i/o-wrong-fasl-header-error
116 i/o-wrong-fasl-header-error?
117
118 ;;&out-of-memory-error
119 &out-of-memory-error-rtd &out-of-memory-error-rcd
120 make-out-of-memory-error out-of-memory-error?
121
122 ;;&failed-expression
123 &failed-expression-rtd
124 &failed-expression-rcd
125 make-failed-expression-condition
126 failed-expression-condition?
127 condition-failed-expression
128
129 ;;&one-based-return-value-index
130 &one-based-return-value-index-rtd
131 &one-based-return-value-index-rcd
132 make-one-based-return-value-index-condition
133 one-based-return-value-index-condition?
134 condition-one-based-return-value-index
135
136 ;;&procedure-precondition-violation
137 &procedure-precondition-violation-rtd
138 &procedure-precondition-violation-rcd
139 make-procedure-precondition-violation
140 procedure-precondition-violation?
141
142 ;;&procedure-postcondition-violation
143 &procedure-postcondition-violation-rtd
144 &procedure-postcondition-violation-rcd
145 make-procedure-postcondition-violation
146 procedure-postcondition-violation?
147
148 ;;&procedure-argument-violation
149 &procedure-argument-violation-rtd
150 &procedure-argument-violation-rcd
151 make-procedure-argument-violation
152 procedure-argument-violation?
153 procedure-argument-violation
154
155 ;;&procedure-signature-argument-violation
156 &procedure-signature-argument-violation-rtd
157 &procedure-signature-argument-violation-rcd
158 make-procedure-signature-argument-violation
159 procedure-signature-argument-violation?
160 procedure-signature-argument-violation.one-based-argument-index
161 procedure-signature-argument-violation.failed-expression
162 procedure-signature-argument-violation.offending-value
163 procedure-signature-argument-violation
164
165 ;;&procedure-signature-return-value-violation
166 &procedure-signature-return-value-violation-rtd
167 &procedure-signature-return-value-violation-rcd
168 make-procedure-signature-return-value-violation
169 procedure-signature-return-value-violation?
170 procedure-signature-return-value-violation.one-based-return-value-index
171 procedure-signature-return-value-violation.failed-expression
172 procedure-signature-return-value-violation.offending-value
173 procedure-signature-return-value-violation
174
175 ;;&procedure-arguments-consistency-violation
176 &procedure-arguments-consistency-violation-rtd
177 &procedure-arguments-consistency-violation-rcd
178 make-procedure-arguments-consistency-violation
179 procedure-arguments-consistency-violation?
180 procedure-arguments-consistency-violation
181 procedure-arguments-consistency-violation/failed-expression
182
183 ;;&expression-return-value-violation
184 &expression-return-value-violation-rtd
185 &expression-return-value-violation-rcd
186 make-expression-return-value-violation
187 expression-return-value-violation?
188 expression-return-value-violation
189
190 ;;&non-reinstatable
191 &non-reinstatable-rtd
192 &non-reinstatable-rcd
193 make-non-reinstatable-violation
194 non-reinstatable-violation?
195 non-reinstatable-violation
196
197 ;; late binding errors
198 &late-binding-error-rtd
199 &late-binding-error-rcd
200 make-late-binding-error
201 late-binding-error?
202
203 &method-late-binding-error-rtd
204 &method-late-binding-error-rcd
205 make-method-late-binding-error
206 method-late-binding-error?
207
208 &overloaded-function-late-binding-error-rtd
209 &overloaded-function-late-binding-error-rcd
210 make-overloaded-function-late-binding-error
211 overloaded-function-late-binding-error?
212 overloaded-function-late-binding-error.overloaded-function-descriptor
213
214 &interface-method-late-binding-error-rtd
215 &interface-method-late-binding-error-rcd
216 make-interface-method-late-binding-error
217 interface-method-late-binding-error?
218 interface-method-late-binding-error.interface-uid
219 interface-method-late-binding-error.method-name
220 interface-method-late-binding-error.subject
221 interface-method-late-binding-error.type-descriptor
222
223 ;; string encoding and decoding
224 ;;&string-encoding
225 &string-encoding-rtd
226 &string-encoding-rcd
227 make-string-encoding-error
228 string-encoding-error?
229
230 ;;&string-decoding
231 &string-decoding-rtd
232 &string-decoding-rcd
233 make-string-decoding-error
234 string-decoding-error?
235
236;;;
237
238 ;;&utf8-string-encoding
239 &utf8-string-encoding-rtd
240 &utf8-string-encoding-rcd
241 make-utf8-string-encoding-error
242 utf8-string-encoding-error?
243
244 ;;&utf16-string-encoding
245 &utf16-string-encoding-rtd
246 &utf16-string-encoding-rcd
247 make-utf16-string-encoding-error
248 utf16-string-encoding-error?
249
250 ;;&utf32-string-encoding
251 &utf32-string-encoding-rtd
252 &utf32-string-encoding-rcd
253 make-utf32-string-encoding-error
254 utf32-string-encoding-error?
255
256 ;;&utf8-string-decoding
257 &utf8-string-decoding-rtd
258 &utf8-string-decoding-rcd
259 make-utf8-string-decoding-error
260 utf8-string-decoding-error?
261
262 ;;&utf16-string-decoding
263 &utf16-string-decoding-rtd
264 &utf16-string-decoding-rcd
265 make-utf16-string-decoding-error
266 utf16-string-decoding-error?
267
268 ;;&utf32-string-decoding
269 &utf32-string-decoding-rtd
270 &utf32-string-decoding-rcd
271 make-utf32-string-decoding-error
272 utf32-string-decoding-error?
273
274;;;
275
276 ;;&utf8-string-decoding-invalid-octet
277 &utf8-string-decoding-invalid-octet-rtd
278 &utf8-string-decoding-invalid-octet-rcd
279 make-utf8-string-decoding-invalid-octet
280 utf8-string-decoding-invalid-octet?
281 utf8-string-decoding-invalid-octet.bytevector
282 utf8-string-decoding-invalid-octet.index
283 utf8-string-decoding-invalid-octet.octets
284
285 ;;&utf8-string-decoding-invalid-2-tuple
286 &utf8-string-decoding-invalid-2-tuple-rtd
287 &utf8-string-decoding-invalid-2-tuple-rcd
288 make-utf8-string-decoding-invalid-2-tuple
289 utf8-string-decoding-invalid-2-tuple?
290 utf8-string-decoding-invalid-2-tuple.bytevector
291 utf8-string-decoding-invalid-2-tuple.index
292 utf8-string-decoding-invalid-2-tuple.octets
293
294 ;;&utf8-string-decoding-invalid-3-tuple
295 &utf8-string-decoding-invalid-3-tuple-rtd
296 &utf8-string-decoding-invalid-3-tuple-rcd
297 make-utf8-string-decoding-invalid-3-tuple
298 utf8-string-decoding-invalid-3-tuple?
299 utf8-string-decoding-invalid-3-tuple.bytevector
300 utf8-string-decoding-invalid-3-tuple.index
301 utf8-string-decoding-invalid-3-tuple.octets
302
303 ;;&utf8-string-decoding-invalid-4-tuple
304 &utf8-string-decoding-invalid-4-tuple-rtd
305 &utf8-string-decoding-invalid-4-tuple-rcd
306 make-utf8-string-decoding-invalid-4-tuple
307 utf8-string-decoding-invalid-4-tuple?
308 utf8-string-decoding-invalid-4-tuple.bytevector
309 utf8-string-decoding-invalid-4-tuple.index
310 utf8-string-decoding-invalid-4-tuple.octets
311
312 ;;&utf8-string-decoding-incomplete-2-tuple
313 &utf8-string-decoding-incomplete-2-tuple-rtd
314 &utf8-string-decoding-incomplete-2-tuple-rcd
315 make-utf8-string-decoding-incomplete-2-tuple
316 utf8-string-decoding-incomplete-2-tuple?
317 utf8-string-decoding-incomplete-2-tuple.bytevector
318 utf8-string-decoding-incomplete-2-tuple.index
319 utf8-string-decoding-incomplete-2-tuple.octets
320
321 ;;&utf8-string-decoding-incomplete-3-tuple
322 &utf8-string-decoding-incomplete-3-tuple-rtd
323 &utf8-string-decoding-incomplete-3-tuple-rcd
324 make-utf8-string-decoding-incomplete-3-tuple
325 utf8-string-decoding-incomplete-3-tuple?
326 utf8-string-decoding-incomplete-3-tuple.bytevector
327 utf8-string-decoding-incomplete-3-tuple.index
328 utf8-string-decoding-incomplete-3-tuple.octets
329
330 ;;&utf8-string-decoding-incomplete-4-tuple
331 &utf8-string-decoding-incomplete-4-tuple-rtd
332 &utf8-string-decoding-incomplete-4-tuple-rcd
333 make-utf8-string-decoding-incomplete-4-tuple
334 utf8-string-decoding-incomplete-4-tuple?
335 utf8-string-decoding-incomplete-4-tuple.bytevector
336 utf8-string-decoding-incomplete-4-tuple.index
337 utf8-string-decoding-incomplete-4-tuple.octets
338
339;;;
340
341 ;;&utf16-string-decoding-invalid-first-word
342 &utf16-string-decoding-invalid-first-word-rtd
343 &utf16-string-decoding-invalid-first-word-rcd
344 make-utf16-string-decoding-invalid-first-word
345 utf16-string-decoding-invalid-first-word?
346 utf16-string-decoding-invalid-first-word.bytevector
347 utf16-string-decoding-invalid-first-word.index
348 utf16-string-decoding-invalid-first-word.word
349
350 ;;&utf16-string-decoding-invalid-second-word
351 &utf16-string-decoding-invalid-second-word-rtd
352 &utf16-string-decoding-invalid-second-word-rcd
353 make-utf16-string-decoding-invalid-second-word
354 utf16-string-decoding-invalid-second-word?
355 utf16-string-decoding-invalid-second-word.bytevector
356 utf16-string-decoding-invalid-second-word.index
357 utf16-string-decoding-invalid-second-word.first-word
358 utf16-string-decoding-invalid-second-word.second-word
359
360 ;;&utf16-string-decoding-missing-second-word
361 &utf16-string-decoding-missing-second-word-rtd
362 &utf16-string-decoding-missing-second-word-rcd
363 make-utf16-string-decoding-missing-second-word
364 utf16-string-decoding-missing-second-word?
365 utf16-string-decoding-missing-second-word.bytevector
366 utf16-string-decoding-missing-second-word.index
367 utf16-string-decoding-missing-second-word.word
368
369 ;;&utf16-string-decoding-standalone-octet
370 &utf16-string-decoding-standalone-octet-rtd
371 &utf16-string-decoding-standalone-octet-rcd
372 make-utf16-string-decoding-standalone-octet
373 utf16-string-decoding-standalone-octet?
374 utf16-string-decoding-standalone-octet.bytevector
375 utf16-string-decoding-standalone-octet.index
376 utf16-string-decoding-standalone-octet.octet
377
378;;;
379
380 ;;&utf32-string-decoding-invalid-word
381 &utf32-string-decoding-invalid-word-rtd
382 &utf32-string-decoding-invalid-word-rcd
383 make-utf32-string-decoding-invalid-word
384 utf32-string-decoding-invalid-word?
385 utf32-string-decoding-invalid-word.bytevector
386 utf32-string-decoding-invalid-word.index
387 utf32-string-decoding-invalid-word.word
388
389 ;;&utf32-string-decoding-orphan-octets
390 &utf32-string-decoding-orphan-octets-rtd
391 &utf32-string-decoding-orphan-octets-rcd
392 make-utf32-string-decoding-orphan-octets
393 utf32-string-decoding-orphan-octets?
394 utf32-string-decoding-orphan-octets.bytevector
395 utf32-string-decoding-orphan-octets.index
396 utf32-string-decoding-orphan-octets.octets
397
398 ;; macros
399 preconditions
400
401 ;; for internal use only
402 $condition-predicate $condition-accessor
403 make-simple-condition %raise-out-of-memory)
404 (import (except (vicare)
405 ;;We use an internal macro definition to define condition types in
406 ;;this library.
407 define-condition-type
408
409 condition? compound-condition? condition-and-rtd?
410 simple-condition?
411 list-of-conditions?
412 list-of-simple-conditions?
413 simple-conditions
414 condition condition-predicate condition-accessor
415 print-condition
416
417 raise-non-continuable-standard-condition
418
419 &condition &message &warning &serious &error &violation
420 &assertion &irritants &who &non-continuable
421 &implementation-restriction &lexical &syntax &undefined
422 &i/o &i/o-read &i/o-write &i/o-invalid-position
423 &i/o-filename &i/o-file-protection &i/o-file-is-read-only
424 &i/o-file-already-exists &i/o-file-does-not-exist
425 &i/o-port &i/o-decoding &i/o-encoding &no-infinities
426 &no-nans
427
428 make-message-condition message-condition?
429 condition-message make-warning warning?
430 make-serious-condition serious-condition? make-error
431 error? make-violation violation? make-assertion-violation
432 assertion-violation? make-irritants-condition
433 irritants-condition? condition-irritants
434 make-who-condition who-condition? condition-who
435 make-non-continuable-violation non-continuable-violation?
436 make-implementation-restriction-violation
437 implementation-restriction-violation?
438 make-lexical-violation lexical-violation?
439 make-syntax-violation syntax-violation?
440 syntax-violation-form syntax-violation-subform
441 make-undefined-violation undefined-violation?
442 make-i/o-error i/o-error? make-i/o-read-error
443 i/o-read-error? make-i/o-write-error i/o-write-error?
444 make-i/o-invalid-position-error
445 i/o-invalid-position-error? i/o-error-position
446 make-i/o-filename-error i/o-filename-error?
447 i/o-error-filename make-i/o-file-protection-error
448 i/o-file-protection-error? make-i/o-file-is-read-only-error
449 i/o-file-is-read-only-error?
450 make-i/o-file-already-exists-error
451 i/o-file-already-exists-error?
452 make-i/o-file-does-not-exist-error
453 i/o-file-does-not-exist-error? make-i/o-port-error
454 i/o-port-error? i/o-error-port make-i/o-decoding-error
455 i/o-decoding-error? make-i/o-encoding-error
456 i/o-encoding-error? i/o-encoding-error-char
457 no-infinities-violation? make-no-infinities-violation
458 no-nans-violation? make-no-nans-violation
459
460 &i/o-eagain make-i/o-eagain i/o-eagain-error?
461 &i/o-eagain-rtd &i/o-eagain-rcd
462
463 &errno &errno-rtd &errno-rcd
464 make-errno-condition errno-condition?
465 condition-errno
466
467 &h_errno &h_errno-rtd &h_errno-rcd
468 make-h_errno-condition h_errno-condition?
469 condition-h_errno
470
471 &i/o-wrong-fasl-header-error-rtd &i/o-wrong-fasl-header-error-rcd
472 &i/o-wrong-fasl-header-error
473 make-i/o-wrong-fasl-header-error
474 i/o-wrong-fasl-header-error?
475
476 &out-of-memory-error-rtd &out-of-memory-error-rcd
477 &out-of-memory-error
478 make-out-of-memory-error out-of-memory-error?
479
480 &interrupted &interrupted-rtd &interrupted-rcd
481 interrupted-condition? make-interrupted-condition
482
483 &source-position &source-position-rtd &source-position-rcd
484 make-source-position-condition source-position-condition?
485 source-position-port-id
486 source-position-byte source-position-character
487 source-position-line source-position-column
488
489 &failed-expression
490 &failed-expression-rtd
491 &failed-expression-rcd
492 make-failed-expression-condition
493 failed-expression-condition?
494 condition-failed-expression
495
496 &one-based-return-value-index
497 &one-based-return-value-index-rtd
498 &one-based-return-value-index-rcd
499 make-one-based-return-value-index-condition
500 one-based-return-value-index-condition?
501 condition-one-based-return-value-index
502
503 &procedure-precondition-violation
504 &procedure-precondition-violation-rtd
505 &procedure-precondition-violation-rcd
506 make-procedure-precondition-violation
507 procedure-precondition-violation?
508
509 &procedure-postcondition-violation
510 &procedure-postcondition-violation-rtd
511 &procedure-postcondition-violation-rcd
512 make-procedure-postcondition-violation
513 procedure-postcondition-violation?
514
515 &procedure-argument-violation
516 &procedure-argument-violation-rtd
517 &procedure-argument-violation-rcd
518 make-procedure-argument-violation
519 procedure-argument-violation?
520 procedure-argument-violation
521
522 &procedure-signature-argument-violation
523 &procedure-signature-argument-violation-rtd
524 &procedure-signature-argument-violation-rcd
525 make-procedure-signature-argument-violation
526 procedure-signature-argument-violation?
527 procedure-signature-argument-violation.one-based-argument-index
528 procedure-signature-argument-violation.failed-expression
529 procedure-signature-argument-violation.offending-value
530 procedure-signature-argument-violation
531
532 &procedure-signature-return-value-violation
533 &procedure-signature-return-value-violation-rtd
534 &procedure-signature-return-value-violation-rcd
535 make-procedure-signature-return-value-violation
536 procedure-signature-return-value-violation?
537 procedure-signature-return-value-violation.one-based-return-value-index
538 procedure-signature-return-value-violation.failed-expression
539 procedure-signature-return-value-violation.offending-value
540 procedure-signature-return-value-violation
541
542 &procedure-arguments-consistency-violation
543 &procedure-arguments-consistency-violation-rtd
544 &procedure-arguments-consistency-violation-rcd
545 make-procedure-arguments-consistency-violation
546 procedure-arguments-consistency-violation?
547 procedure-arguments-consistency-violation
548 procedure-arguments-consistency-violation/failed-expression
549
550 &expression-return-value-violation
551 &expression-return-value-violation-rtd
552 &expression-return-value-violation-rcd
553 make-expression-return-value-violation
554 expression-return-value-violation?
555 expression-return-value-violation
556
557 &non-reinstatable
558 &non-reinstatable-rtd
559 &non-reinstatable-rcd
560 make-non-reinstatable-violation
561 non-reinstatable-violation?
562 non-reinstatable-violation
563
564 &late-binding-error-rtd
565 &late-binding-error-rcd
566 &late-binding-error
567 make-late-binding-error
568 late-binding-error?
569
570 &method-late-binding-error-rtd
571 &method-late-binding-error-rcd
572 &method-late-binding-error
573 make-method-late-binding-error
574 method-late-binding-error?
575
576 &overloaded-function-late-binding-error-rtd
577 &overloaded-function-late-binding-error-rcd
578 &overloaded-function-late-binding-error
579 make-overloaded-function-late-binding-error
580 overloaded-function-late-binding-error?
581 overloaded-function-late-binding-error.overloaded-function-descriptor
582
583 &interface-method-late-binding-error-rtd
584 &interface-method-late-binding-error-rcd
585 &interface-method-late-binding-error
586 make-interface-method-late-binding-error
587 interface-method-late-binding-error?
588 interface-method-late-binding-error.interface-uid
589 interface-method-late-binding-error.method-name
590 interface-method-late-binding-error.subject
591 interface-method-late-binding-error.type-descriptor
592
593 ;; string encoding and decoding
594 &string-encoding
595 &string-encoding-rtd
596 &string-encoding-rcd
597 make-string-encoding-error
598 string-encoding-error?
599
600 &string-decoding
601 &string-decoding-rtd
602 &string-decoding-rcd
603 make-string-decoding-error
604 string-decoding-error?
605
606 &utf8-string-encoding
607 &utf8-string-encoding-rtd
608 &utf8-string-encoding-rcd
609 make-utf8-string-encoding-error
610 utf8-string-encoding-error?
611
612 &utf16-string-encoding
613 &utf16-string-encoding-rtd
614 &utf16-string-encoding-rcd
615 make-utf16-string-encoding-error
616 utf16-string-encoding-error?
617
618 &utf32-string-encoding
619 &utf32-string-encoding-rtd
620 &utf32-string-encoding-rcd
621 make-utf32-string-encoding-error
622 utf32-string-encoding-error?
623
624 &utf8-string-decoding
625 &utf8-string-decoding-rtd
626 &utf8-string-decoding-rcd
627 make-utf8-string-decoding-error
628 utf8-string-decoding-error?
629
630 &utf16-string-decoding
631 &utf16-string-decoding-rtd
632 &utf16-string-decoding-rcd
633 make-utf16-string-decoding-error
634 utf16-string-decoding-error?
635
636 &utf32-string-decoding
637 &utf32-string-decoding-rtd
638 &utf32-string-decoding-rcd
639 make-utf32-string-decoding-error
640 utf32-string-decoding-error?
641
642 &utf8-string-decoding-invalid-octet
643 &utf8-string-decoding-invalid-octet-rtd
644 &utf8-string-decoding-invalid-octet-rcd
645 make-utf8-string-decoding-invalid-octet
646 utf8-string-decoding-invalid-octet?
647 utf8-string-decoding-invalid-octet.bytevector
648 utf8-string-decoding-invalid-octet.index
649 utf8-string-decoding-invalid-octet.octets
650
651 &utf8-string-decoding-invalid-2-tuple
652 &utf8-string-decoding-invalid-2-tuple-rtd
653 &utf8-string-decoding-invalid-2-tuple-rcd
654 make-utf8-string-decoding-invalid-2-tuple
655 utf8-string-decoding-invalid-2-tuple?
656 utf8-string-decoding-invalid-2-tuple.bytevector
657 utf8-string-decoding-invalid-2-tuple.index
658 utf8-string-decoding-invalid-2-tuple.octets
659
660 &utf8-string-decoding-invalid-3-tuple
661 &utf8-string-decoding-invalid-3-tuple-rtd
662 &utf8-string-decoding-invalid-3-tuple-rcd
663 make-utf8-string-decoding-invalid-3-tuple
664 utf8-string-decoding-invalid-3-tuple?
665 utf8-string-decoding-invalid-3-tuple.bytevector
666 utf8-string-decoding-invalid-3-tuple.index
667 utf8-string-decoding-invalid-3-tuple.octets
668
669 &utf8-string-decoding-invalid-4-tuple
670 &utf8-string-decoding-invalid-4-tuple-rtd
671 &utf8-string-decoding-invalid-4-tuple-rcd
672 make-utf8-string-decoding-invalid-4-tuple
673 utf8-string-decoding-invalid-4-tuple?
674 utf8-string-decoding-invalid-4-tuple.bytevector
675 utf8-string-decoding-invalid-4-tuple.index
676 utf8-string-decoding-invalid-4-tuple.octets
677
678 &utf8-string-decoding-incomplete-2-tuple
679 &utf8-string-decoding-incomplete-2-tuple-rtd
680 &utf8-string-decoding-incomplete-2-tuple-rcd
681 make-utf8-string-decoding-incomplete-2-tuple
682 utf8-string-decoding-incomplete-2-tuple?
683 utf8-string-decoding-incomplete-2-tuple.bytevector
684 utf8-string-decoding-incomplete-2-tuple.index
685 utf8-string-decoding-incomplete-2-tuple.octets
686
687 &utf8-string-decoding-incomplete-3-tuple
688 &utf8-string-decoding-incomplete-3-tuple-rtd
689 &utf8-string-decoding-incomplete-3-tuple-rcd
690 make-utf8-string-decoding-incomplete-3-tuple
691 utf8-string-decoding-incomplete-3-tuple?
692 utf8-string-decoding-incomplete-3-tuple.bytevector
693 utf8-string-decoding-incomplete-3-tuple.index
694 utf8-string-decoding-incomplete-3-tuple.octets
695
696 &utf8-string-decoding-incomplete-4-tuple
697 &utf8-string-decoding-incomplete-4-tuple-rtd
698 &utf8-string-decoding-incomplete-4-tuple-rcd
699 make-utf8-string-decoding-incomplete-4-tuple
700 utf8-string-decoding-incomplete-4-tuple?
701 utf8-string-decoding-incomplete-4-tuple.bytevector
702 utf8-string-decoding-incomplete-4-tuple.index
703 utf8-string-decoding-incomplete-4-tuple.octets
704
705
706 &utf16-string-decoding-invalid-first-word
707 &utf16-string-decoding-invalid-first-word-rtd
708 &utf16-string-decoding-invalid-first-word-rcd
709 make-utf16-string-decoding-invalid-first-word
710 utf16-string-decoding-invalid-first-word?
711 utf16-string-decoding-invalid-first-word.bytevector
712 utf16-string-decoding-invalid-first-word.index
713 utf16-string-decoding-invalid-first-word.word
714
715 &utf16-string-decoding-invalid-second-word
716 &utf16-string-decoding-invalid-second-word-rtd
717 &utf16-string-decoding-invalid-second-word-rcd
718 make-utf16-string-decoding-invalid-second-word
719 utf16-string-decoding-invalid-second-word?
720 utf16-string-decoding-invalid-second-word.bytevector
721 utf16-string-decoding-invalid-second-word.index
722 utf16-string-decoding-invalid-second-word.first-word
723 utf16-string-decoding-invalid-second-word.second-word
724
725 &utf16-string-decoding-missing-second-word
726 &utf16-string-decoding-missing-second-word-rtd
727 &utf16-string-decoding-missing-second-word-rcd
728 make-utf16-string-decoding-missing-second-word
729 utf16-string-decoding-missing-second-word?
730 utf16-string-decoding-missing-second-word.bytevector
731 utf16-string-decoding-missing-second-word.index
732 utf16-string-decoding-missing-second-word.word
733
734 &utf16-string-decoding-standalone-octet
735 &utf16-string-decoding-standalone-octet-rtd
736 &utf16-string-decoding-standalone-octet-rcd
737 make-utf16-string-decoding-standalone-octet
738 utf16-string-decoding-standalone-octet?
739 utf16-string-decoding-standalone-octet.bytevector
740 utf16-string-decoding-standalone-octet.index
741 utf16-string-decoding-standalone-octet.octet
742
743 &utf32-string-decoding-invalid-word
744 &utf32-string-decoding-invalid-word-rtd
745 &utf32-string-decoding-invalid-word-rcd
746 make-utf32-string-decoding-invalid-word
747 utf32-string-decoding-invalid-word?
748 utf32-string-decoding-invalid-word.bytevector
749 utf32-string-decoding-invalid-word.index
750 utf32-string-decoding-invalid-word.word
751
752 &utf32-string-decoding-orphan-octets
753 &utf32-string-decoding-orphan-octets-rtd
754 &utf32-string-decoding-orphan-octets-rcd
755 make-utf32-string-decoding-orphan-octets
756 utf32-string-decoding-orphan-octets?
757 utf32-string-decoding-orphan-octets.bytevector
758 utf32-string-decoding-orphan-octets.index
759 utf32-string-decoding-orphan-octets.octets
760 )
761 (only (ikarus records procedural)
762 $make-record-type-descriptor
763 $make-record-type-descriptor-ex
764 $make-record-constructor-descriptor
765 $record-and-rtd?
766 $record-constructor
767 $rtd-subtype?
768 $record-accessor/index)
769 (vicare system $structs)
770 (prefix (only (ikarus records procedural)
771 record-type-method-retriever-set!)
772 records::)
773 (only (vicare language-extensions syntaxes)
774 define-list-of-type-predicate))
775
776
777(define-syntax define-condition-type-syntax
778 ;;This syntax is used by DEFINE-CORE-CONDITION-TYPE. It defines the syntactic
779 ;;binding for the type name of condition-object types, so that it is possible to
780 ;;use the name to access the RTD and CTD of the record-type. Example:
781 ;;
782 ;; (define-core-condition-type &demo
783 ;; &condition
784 ;; make-demo-condition condition-decmo?)
785 ;;
786 ;; (&demo rtd) ==> &demo-rtd
787 ;; (&demo rcd) ==> &demo-ctd
788 ;;
789 (syntax-rules ()
790 ((_ ?type-name ?rtd ?rcd)
791 (define-syntax ?type-name
792 (lambda (stx)
793 (syntax-case stx ()
794 ((_ ?command)
795 (identifier? #'?command)
796 (case (syntax->datum #'?command)
797 ((rtd) #'?rtd)
798 ((rcd) #'?rcd)
799 (else
800 (syntax-violation (quote ?type-name)
801 "invalid command for core condition-object type name" stx #'?command))))
802 (_
803 (syntax-violation (quote ?type-name) "invalid use of core condition-object type name" stx #f))))))
804 ))
805
806
807(define-syntax (define-core-condition-type stx)
808 ;;This macro is used in this library to define condition object types.
809 ;;
810 ;;NOTE Remember that this macro is *not* the one exported by the boot image. The
811 ;;transformer of the keyword binding DEFINE-CONDITION-TYPE exported by the boot
812 ;;image is integrated in the expander.
813 ;;
814 (define (main input-form.stx)
815 (syntax-case input-form.stx ()
816 ((?kwd ?name ?parent-name ?constructor ?predicate (?field ?accessor) ...)
817 (and (identifier? #'?name)
818 (identifier? #'?parent-name)
819 (identifier? #'?constructor)
820 (identifier? #'?predicate)
821 (andmap identifier? #'(?field ...))
822 (andmap identifier? #'(?accessor ...)))
823 (with-syntax
824 ((UID (mkname "vicare:core-type:" #'?name ""))
825 (GENERATIVE? #f)
826 (RTD (mkname "" #'?name "-rtd"))
827 (RCD (mkname "" #'?name "-rcd"))
828 ((ACCESSOR-IDX ...) (iota 0 #'(?accessor ...)))
829 (SEALED? #f)
830 (OPAQUE? #f)
831 (METHOD-RETRIEVER (if (null? (syntax->datum #'(?field ...)))
832 #f
833 #'(lambda (name)
834 (case name
835 ((?field) ?accessor)
836 ...
837 (else #f))))))
838 ;;We use the records procedural layer and the unsafe functions to make it
839 ;;easier to rotate the boot images.
840 #'(begin ;;module (RTD RCD ?constructor ?predicate ?accessor ...)
841 (define RTD
842 ($make-record-type-descriptor-ex (quote ?name) (?parent-name rtd)
843 (quote UID) GENERATIVE? SEALED? OPAQUE?
844 '#((immutable ?field) ...) '#((#f . ?field) ...)
845 #f ;destructor
846 #f ;printer
847 #f ;equality-predicate
848 #f ;comparison-procedure
849 #f ;hash-function
850 METHOD-RETRIEVER
851 METHOD-RETRIEVER ;method-retriever-private
852 #f ;implemented-interfaces
853 ))
854 (define RCD
855 ($make-record-constructor-descriptor RTD (?parent-name rcd) #f))
856 (define ?constructor
857 ($record-constructor RCD))
858 (define ?predicate
859 ($condition-predicate RTD))
860 (define ?accessor
861 ($condition-accessor RTD ($record-accessor/index RTD ACCESSOR-IDX (quote ?accessor)) (quote ?accessor)))
862 ...
863 ;;We define this syntactic binding with the only purpose of using it to
864 ;;access the syntactic bindings RTD and RCD in the lexical context of
865 ;;the definition.
866 (define-condition-type-syntax ?name RTD RCD)
867 )))
868 ))
869
870 (define (mkname prefix name suffix)
871 (datum->syntax name (string->symbol (string-append prefix (symbol->string (syntax->datum name)) suffix))))
872
873 (define (iota idx stx)
874 (syntax-case stx ()
875 (() '())
876 ((?x . ?x*)
877 (cons idx (iota (fxadd1 idx) #'?x*)))))
878
879 ;; (receive-and-return (out)
880 ;; (main stx)
881 ;; (debug-print 'ikarus.conditions (syntax->datum out)))
882 (main stx))
883
884
885;;;; arguments validation
886
887(define (simple-condition-rtd-subtype? obj)
888 (and (record-type-descriptor? obj)
889 ($rtd-subtype? obj &condition-rtd)))
890
891(define-list-of-type-predicate list-of-conditions? condition?)
892(define-list-of-type-predicate list-of-simple-conditions? simple-condition?)
893
894(define-syntax-rule ($record-of-type ?obj ?rtd)
895 (and ($struct? ?obj)
896 ($record-and-rtd? ?obj ?rtd)))
897
898(define (who-condition-value? obj)
899 (or (not obj)
900 (symbol? obj)
901 (string? obj)))
902
903
904;;;; data types and some predicates
905
906;;NOTE We could use the records syntactic layer as shown below, but instead we use
907;;the procedural layer to allow boot image initialisation (without crashes due to
908;;not-yet-initialised core primitives).
909;;
910;; (begin
911;; (define-record-type (&condition make-simple-condition simple-condition?)
912;; (nongenerative))
913;; (define &condition-rtd
914;; (record-type-descriptor &condition))
915;; (define &condition-rcd
916;; (record-constructor-descriptor &condition))
917;; (define-record-type compound-condition
918;; (nongenerative)
919;; (fields (immutable components))
920;; (sealed #t)
921;; (opaque #f))
922;; #| end of BEGIN |# )
923
924(begin
925 (define &condition-rtd
926 ($make-record-type-descriptor '&condition #f 'vicare:conditions:&condition #f #f '#() '#()))
927 (define &condition-rcd
928 ($make-record-constructor-descriptor &condition-rtd #f #f))
929 (define make-simple-condition
930 ($record-constructor &condition-rcd))
931 (define (simple-condition? X)
932 ($record-of-type X &condition-rtd))
933 ;;We define this syntactic binding with the only purpose of using it to access the
934 ;;syntactic bindings &CONDITION-RTD and &CONDITION-RCD in the lexical context of
935 ;;the definition.
936 (define-condition-type-syntax &condition &condition-rtd &condition-rcd)
937 #| end of BEGIN |# )
938
939(begin
940 (define compound-condition-rtd
941 ($make-record-type-descriptor 'compound-condition #f 'vicare:conditions:compound-condition #t #f
942 '#((immutable . components)) '#((#f . components))))
943 (define compound-condition-rcd
944 ($make-record-constructor-descriptor compound-condition-rtd #f #f))
945 (define make-compound-condition
946 ($record-constructor compound-condition-rcd))
947 (define (compound-condition? X)
948 ($record-of-type X compound-condition-rtd))
949 ;; (define compound-condition-components
950 ;; (record-accessor compound-condition-rtd 0))
951 (define ($compound-condition-components cnd)
952 ($struct-ref cnd 0))
953 ;;We define this syntactic binding with the only purpose of using it to access the
954 ;;syntactic bindings &COMPOUND-CONDITION-RTD and &COMPOUND-CONDITION-RCD in the
955 ;;lexical context of the definition.
956 (define-condition-type-syntax &compound-condition &compound-condition-rtd &compound-condition-rcd)
957 #| end of BEGIN |# )
958
959;;; --------------------------------------------------------------------
960
961(define (condition? x)
962 ;;Defined by R6RS. Return #t if X is a (simple or compound) condition, otherwise
963 ;;return #f.
964 ;;
965 (or (simple-condition? x)
966 (compound-condition? x)))
967
968(define* (condition-and-rtd? obj {rtd simple-condition-rtd-subtype?})
969 (cond ((compound-condition? obj)
970 (let loop ((ls ($compound-condition-components obj)))
971 (and (pair? ls)
972 (or ($record-of-type (car ls) rtd)
973 (loop (cdr ls))))))
974 ((simple-condition? obj)
975 ($record-of-type obj rtd))
976 (else #f)))
977
978
979(case-define* condition
980 ;;Defined by R6RS. Return a condition object with the components of the condition
981 ;;arguments as its components, in the same order. The returned condition is
982 ;;compound if the total number of components is zero or greater than one.
983 ;;Otherwise, it may be compound or simple.
984 ;;
985 (()
986 (make-compound-condition '()))
987 (({x condition?})
988 x)
989 (x*
990 (let ((ls (let recur ((x* x*))
991 (if (pair? x*)
992 (cond ((simple-condition? (car x*))
993 (cons (car x*) (recur (cdr x*))))
994 ((compound-condition? (car x*))
995 (append (simple-conditions (car x*)) (recur (cdr x*))))
996 (else
997 (procedure-argument-violation 'condition
998 "expected condition object as argument" (car x*))))
999 '()))))
1000 (cond ((null? ls)
1001 (make-compound-condition '()))
1002 ((null? (cdr ls))
1003 (car ls))
1004 (else
1005 (make-compound-condition ls))))))
1006
1007(define* (simple-conditions x)
1008 ;;Defined by R6RS. Return a list of the components of X, in the same order as they
1009 ;;appeared in the construction of X. The returned list is immutable. If the
1010 ;;returned list is modified, the effect on X is unspecified.
1011 ;;
1012 ;;NOTE Because CONDITION decomposes its arguments into simple conditions,
1013 ;;SIMPLE-CONDITIONS always returns a ``flattened'' list of simple conditions.
1014 ;;
1015 (cond ((compound-condition? x)
1016 ($compound-condition-components x))
1017 ((simple-condition? x)
1018 (list x))
1019 (else
1020 (procedure-argument-violation __who__
1021 "expected condition object as argument"
1022 x))))
1023
1024
1025(define* (condition-predicate {rtd simple-condition-rtd-subtype?})
1026 ;;Defined by R6RS. RTD must be a record-type descriptor of a subtype of
1027 ;;"&condition". The CONDITION-PREDICATE procedure returns a procedure that takes
1028 ;;one argument. This procedure returns #t if its argument is a condition of the
1029 ;;condition type represented by RTD, i.e., if it is either a simple condition of
1030 ;;that record type (or one of its subtypes) or a compound conditition with such a
1031 ;;simple condition as one of its components, and #f otherwise.
1032 ;;
1033 ($condition-predicate rtd))
1034
1035(define ($condition-predicate rtd)
1036 (lambda (X)
1037 (or (and (compound-condition? X)
1038 (let loop ((ls ($compound-condition-components X)))
1039 (and (pair? ls)
1040 (or ($record-of-type (car ls) rtd)
1041 (loop (cdr ls))))))
1042 ($record-of-type X rtd))))
1043
1044(case-define* condition-accessor
1045 ;;Defined by R6RS. RTD must be a record-type descriptor of a subtype of
1046 ;;"&condition". PROC should accept one argument, a record of the record type of
1047 ;;RTD.
1048 ;;
1049 ;;The CONDITION-ACCESSOR procedure returns a procedure that accepts a single
1050 ;;argument, which must be a condition of the type represented by RTD. This
1051 ;;procedure extracts the first component of the condition of the type represented
1052 ;;by RTD, and returns the result of applying PROC to that component.
1053 ;;
1054 (({rtd simple-condition-rtd-subtype?} {proc procedure?})
1055 ($condition-accessor rtd proc 'anonymous-condition-accessor))
1056 (({rtd simple-condition-rtd-subtype?} {proc procedure?} {accessor-who (or not symbol?)})
1057 ($condition-accessor rtd proc accessor-who)))
1058
1059(define ($condition-accessor rtd proc accessor-who)
1060 (lambda (X)
1061 (define (%error)
1062 (procedure-arguments-consistency-violation accessor-who "not a condition of correct type" X rtd))
1063 (cond ((compound-condition? X)
1064 (let loop ((ls ($compound-condition-components X)))
1065 (cond ((pair? ls)
1066 (if ($record-of-type (car ls) rtd)
1067 (proc (car ls))
1068 (loop (cdr ls))))
1069 (else
1070 (%error)))))
1071 (($record-of-type X rtd)
1072 (proc X))
1073 (else
1074 (%error)))))
1075
1076
1077;;;; raising exceptions
1078
1079(case-define* raise-non-continuable-standard-condition
1080 ;;NOTE Remember that the order in which we concatenate simple condition objects in
1081 ;;compound condition objects is important: it is the order in which the simple
1082 ;;objects will be shown to the user, when an exception is raised and goes
1083 ;;uncatched.
1084 ((who {message string?} {irritants list?})
1085 (let ((C (condition (make-message-condition message)
1086 (make-irritants-condition irritants))))
1087 (raise (if who
1088 (if (or (symbol? who)
1089 (string? who))
1090 (condition (make-who-condition who) C)
1091 (procedure-signature-argument-violation __who__
1092 "invalid value for &who" 1 '(or (symbol? who) (string? who)) who))
1093 C))))
1094 ((who {message string?} {irritants list?} {cnd condition?})
1095 (let ((C (condition (make-message-condition message)
1096 cnd
1097 (make-irritants-condition irritants))))
1098 (raise (if who
1099 (if (or (symbol? who)
1100 (string? who))
1101 (condition (make-who-condition who) C)
1102 (procedure-signature-argument-violation __who__
1103 "invalid value for &who" 1 '(or (symbol? who) (string? who)) who))
1104 C)))))
1105
1106
1107;;;; R6RS condition types
1108
1109(define-core-condition-type &message &condition
1110 make-message-condition message-condition?
1111 (message condition-message))
1112
1113(define-core-condition-type &warning &condition
1114 make-warning warning?)
1115
1116(define-core-condition-type &serious &condition
1117 make-serious-condition serious-condition?)
1118
1119(define-core-condition-type &error &serious
1120 make-error error?)
1121
1122(define-core-condition-type &violation &serious
1123 make-violation violation?)
1124
1125(define-core-condition-type &assertion &violation
1126 make-assertion-violation assertion-violation?)
1127
1128(define-core-condition-type &irritants &condition
1129 make-irritants-condition irritants-condition?
1130 (irritants condition-irritants))
1131
1132(define-core-condition-type &who &condition
1133 %make-who-condition who-condition?
1134 (who condition-who))
1135
1136(define* (make-who-condition {who who-condition-value?})
1137 (%make-who-condition who))
1138
1139(define-core-condition-type &non-continuable &violation
1140 make-non-continuable-violation non-continuable-violation?)
1141
1142(define-core-condition-type &implementation-restriction &violation
1143 make-implementation-restriction-violation
1144 implementation-restriction-violation?)
1145
1146(define-core-condition-type &lexical &violation
1147 make-lexical-violation lexical-violation?)
1148
1149(define-core-condition-type &syntax &violation
1150 make-syntax-violation syntax-violation?
1151 (form syntax-violation-form)
1152 (subform syntax-violation-subform))
1153
1154(define-core-condition-type &undefined &violation
1155 make-undefined-violation undefined-violation?)
1156
1157(define-core-condition-type &i/o &error
1158 make-i/o-error i/o-error?)
1159
1160(define-core-condition-type &i/o-read &i/o
1161 make-i/o-read-error i/o-read-error?)
1162
1163(define-core-condition-type &i/o-write &i/o
1164 make-i/o-write-error i/o-write-error?)
1165
1166(define-core-condition-type &i/o-invalid-position &i/o
1167 make-i/o-invalid-position-error i/o-invalid-position-error?
1168 (position i/o-error-position))
1169
1170(define-core-condition-type &i/o-filename &i/o
1171 make-i/o-filename-error i/o-filename-error?
1172 (filename i/o-error-filename))
1173
1174(define-core-condition-type &i/o-file-protection &i/o-filename
1175 make-i/o-file-protection-error i/o-file-protection-error?)
1176
1177(define-core-condition-type &i/o-file-is-read-only &i/o-file-protection
1178 make-i/o-file-is-read-only-error i/o-file-is-read-only-error?)
1179
1180(define-core-condition-type &i/o-file-already-exists &i/o-filename
1181 make-i/o-file-already-exists-error i/o-file-already-exists-error?)
1182
1183(define-core-condition-type &i/o-file-does-not-exist &i/o-filename
1184 make-i/o-file-does-not-exist-error i/o-file-does-not-exist-error?)
1185
1186(define-core-condition-type &i/o-port &i/o
1187 make-i/o-port-error i/o-port-error?
1188 (port i/o-error-port))
1189
1190(define-core-condition-type &i/o-decoding &i/o-port
1191 make-i/o-decoding-error i/o-decoding-error?)
1192
1193(define-core-condition-type &i/o-encoding &i/o-port
1194 make-i/o-encoding-error i/o-encoding-error?
1195 (char i/o-encoding-error-char))
1196
1197(define-core-condition-type &no-infinities &implementation-restriction
1198 make-no-infinities-violation no-infinities-violation?)
1199
1200(define-core-condition-type &no-nans &implementation-restriction
1201 make-no-nans-violation no-nans-violation?)
1202
1203;;; --------------------------------------------------------------------
1204;;; Ikarus specific condition types
1205
1206(define-core-condition-type &interrupted &serious
1207 make-interrupted-condition interrupted-condition?)
1208
1209(define-core-condition-type &source-position &condition
1210 make-source-position-condition source-position-condition?
1211 (port-id source-position-port-id)
1212 (byte source-position-byte)
1213 (character source-position-character)
1214 (line source-position-line)
1215 (column source-position-column))
1216
1217
1218;;; Vicare specific condition types
1219
1220(define-core-condition-type &i/o-eagain
1221 &i/o
1222 make-i/o-eagain i/o-eagain-error?)
1223
1224(define-core-condition-type &errno
1225 &condition
1226 make-errno-condition errno-condition?
1227 (code condition-errno))
1228
1229(define-core-condition-type &h_errno
1230 &condition
1231 make-h_errno-condition h_errno-condition?
1232 (code condition-h_errno))
1233
1234(define-core-condition-type &i/o-wrong-fasl-header-error
1235 &i/o
1236 make-i/o-wrong-fasl-header-error
1237 i/o-wrong-fasl-header-error?)
1238
1239;;; --------------------------------------------------------------------
1240
1241(define-core-condition-type &out-of-memory-error
1242 &error
1243 make-out-of-memory-error
1244 out-of-memory-error?)
1245
1246(define (%raise-out-of-memory who)
1247 (raise
1248 (condition (make-who-condition who)
1249 (make-message-condition "failed raw memory allocation")
1250 (make-out-of-memory-error))))
1251
1252;;; --------------------------------------------------------------------
1253
1254(define-core-condition-type &failed-expression
1255 &condition
1256 make-failed-expression-condition
1257 failed-expression-condition?
1258 (failed-expression condition-failed-expression))
1259
1260;;; --------------------------------------------------------------------
1261
1262(define-core-condition-type &one-based-return-value-index
1263 &condition
1264 make-one-based-return-value-index-condition
1265 one-based-return-value-index-condition?
1266 (index condition-one-based-return-value-index))
1267
1268;;; --------------------------------------------------------------------
1269
1270(define-core-condition-type &procedure-precondition-violation
1271 &assertion
1272 make-procedure-precondition-violation
1273 procedure-precondition-violation?)
1274
1275;;; --------------------------------------------------------------------
1276
1277(define-core-condition-type &procedure-postcondition-violation
1278 &assertion
1279 make-procedure-postcondition-violation
1280 procedure-postcondition-violation?)
1281
1282;;; --------------------------------------------------------------------
1283
1284(define-core-condition-type &procedure-argument-violation
1285 &procedure-precondition-violation
1286 make-procedure-argument-violation procedure-argument-violation?)
1287
1288(define (procedure-argument-violation who message . irritants)
1289 (raise-non-continuable-standard-condition who
1290 message irritants (make-procedure-argument-violation)))
1291
1292;;; --------------------------------------------------------------------
1293
1294(define-core-condition-type &procedure-signature-argument-violation
1295 &procedure-argument-violation
1296 make-procedure-signature-argument-violation procedure-signature-argument-violation?
1297 ;;One-base index of the offending operand.
1298 (one-based-argument-index procedure-signature-argument-violation.one-based-argument-index)
1299 ;;Symbolic expression representing the predicate used to validate the operand.
1300 (failed-expression procedure-signature-argument-violation.failed-expression)
1301 ;;The actual operand.
1302 (offending-value procedure-signature-argument-violation.offending-value))
1303
1304(define (procedure-signature-argument-violation who message operand-index failed-expression offending-value)
1305 (raise-non-continuable-standard-condition who
1306 message (list offending-value)
1307 (make-procedure-signature-argument-violation operand-index failed-expression offending-value)))
1308
1309;;; --------------------------------------------------------------------
1310
1311(define-core-condition-type &procedure-signature-return-value-violation
1312 &procedure-postcondition-violation
1313 make-procedure-signature-return-value-violation procedure-signature-return-value-violation?
1314 ;;One-base index of the offending return value in the tuple of values returned by
1315 ;;the expression.
1316 (one-based-return-value-index procedure-signature-return-value-violation.one-based-return-value-index)
1317 ;;Symbolic expression representing the predicate used to validate the return value.
1318 (failed-expression procedure-signature-return-value-violation.failed-expression)
1319 ;;The actual value returned by the expression.
1320 (offending-value procedure-signature-return-value-violation.offending-value))
1321
1322(define (procedure-signature-return-value-violation who message retval-index failed-expression offending-value)
1323 (raise-non-continuable-standard-condition who
1324 message (list offending-value)
1325 (make-procedure-signature-return-value-violation retval-index failed-expression offending-value)))
1326
1327;;; --------------------------------------------------------------------
1328
1329(define-core-condition-type &procedure-arguments-consistency-violation
1330 &procedure-precondition-violation
1331 make-procedure-arguments-consistency-violation
1332 procedure-arguments-consistency-violation?)
1333
1334(define (procedure-arguments-consistency-violation who message . irritants)
1335 (raise-non-continuable-standard-condition who
1336 message irritants
1337 (make-procedure-arguments-consistency-violation)))
1338
1339(define (procedure-arguments-consistency-violation/failed-expression who message failed-expression . irritants)
1340 (raise-non-continuable-standard-condition who
1341 message irritants
1342 (condition (make-procedure-arguments-consistency-violation)
1343 (make-failed-expression-con…Large files files are truncated, but you can click here to view the full file