PageRenderTime 68ms CodeModel.GetById 25ms RepoModel.GetById 0ms app.codeStats 0ms

/scheme/ikarus.conditions.sls

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