/scheme/ikarus.conditions.sls
Unknown | 1706 lines | 1463 code | 243 blank | 0 comment | 0 complexity | c75a209a44bdcc6423a81a8adbf06a27 MD5 | raw file
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