Add (rnrs conditions)

This commit is contained in:
Daphne Preston-Kendal 2024-11-02 10:31:11 +01:00
parent c1b017aaa7
commit 910c32182f

View file

@ -195,6 +195,7 @@
(scheme cxr) (scheme cxr)
(scheme inexact) (scheme inexact)
(scheme complex) (scheme complex)
(rnrs conditions)
(rename (srfi 141) (rename (srfi 141)
(euclidean-quotient div) (euclidean-quotient div)
(euclidean-remainder mod) (euclidean-remainder mod)
@ -211,15 +212,17 @@
(if (not expr) (if (not expr)
(assertion-violation #f "assertion failed" (quote expr)))))) (assertion-violation #f "assertion failed" (quote expr))))))
;; for now, errors and assertion violations are the same until we (define (%error make-base who message irritants)
;; work out what to do about SRFI 35/(rnrs conditions) support (assert (or (not who) (symbol? who) (string? who)))
(assert (string? message))
(raise (condition (make-base)
(if who (make-who-condition who) (condition))
(make-message-condition message)
(make-irritants-condition irritants))))
(define (error who message . irritants) (define (error who message . irritants)
(define full-message (%error make-error who message irritants))
(if who (define (assertion-violation who message . irritants)
(show #f (written who) ": " message) (%error make-assertion-violation who message irritants))
message))
(apply r7rs:error full-message irritants))
(define assertion-violation error)
(define (real-valued? n) (zero? (imag-part n))) (define (real-valued? n) (zero? (imag-part n)))
(define (rational-valued? n) (define (rational-valued? n)