added a "warning" procedure, that's like assertion-violation and
error except that it throws a warning via raise-continuable.
This commit is contained in:
parent
a884cc9ff7
commit
22dc82567d
|
@ -16,14 +16,14 @@
|
|||
|
||||
(library (ikarus exceptions)
|
||||
(export with-exception-handler raise raise-continuable
|
||||
error assertion-violation die)
|
||||
error warning assertion-violation die)
|
||||
(import
|
||||
(only (rnrs) condition make-non-continuable-violation
|
||||
make-message-condition make-error make-who-condition
|
||||
make-irritants-condition make-assertion-violation)
|
||||
(except (ikarus)
|
||||
with-exception-handler raise raise-continuable
|
||||
error assertion-violation die))
|
||||
error warning assertion-violation die))
|
||||
|
||||
(define handlers
|
||||
(make-parameter
|
||||
|
@ -60,28 +60,24 @@
|
|||
(make-non-continuable-violation)
|
||||
(make-message-condition "handler returned")))))))
|
||||
|
||||
(define (error who msg . irritants)
|
||||
(unless (string? msg)
|
||||
(assertion-violation 'error "message is not a string" msg))
|
||||
(raise
|
||||
(define (err who* raise* cond* who msg irritants)
|
||||
(unless (string? msg)
|
||||
(assertion-violation who* "message is not a string" msg))
|
||||
(raise*
|
||||
(condition
|
||||
(make-error)
|
||||
(cond*)
|
||||
(if who (make-who-condition who) (condition))
|
||||
(make-message-condition msg)
|
||||
(make-irritants-condition irritants))))
|
||||
|
||||
(define (assertion-violation who msg . irritants)
|
||||
(unless (string? msg)
|
||||
(assertion-violation 'assertion-violation "message is not a string" msg))
|
||||
(raise
|
||||
(condition
|
||||
(make-assertion-violation)
|
||||
(if who (make-who-condition who) (condition))
|
||||
(make-message-condition msg)
|
||||
(make-irritants-condition irritants))))
|
||||
|
||||
(define die assertion-violation)
|
||||
|
||||
(define (error who msg . irritants)
|
||||
(err 'error raise make-error who msg irritants))
|
||||
(define (assertion-violation who msg . irritants)
|
||||
(err 'assertion-violation raise make-assertion-violation who msg irritants))
|
||||
(define (warning who msg . irritants)
|
||||
(err 'warning raise-continuable make-warning who msg irritants))
|
||||
(define (die who msg . irritants)
|
||||
(err 'die raise make-assertion-violation who msg irritants))
|
||||
|
||||
)
|
||||
|
||||
|
|
|
@ -29,7 +29,8 @@
|
|||
input-port-column-number)
|
||||
(except (ikarus) read-char read read-token comment-handler get-datum
|
||||
read-annotated read-script-annotated annotation?
|
||||
annotation-expression annotation-source annotation-stripped))
|
||||
annotation-expression annotation-source annotation-stripped
|
||||
input-port-column-number))
|
||||
|
||||
(define (die/lex id pos who msg arg*)
|
||||
(raise
|
||||
|
|
|
@ -790,10 +790,6 @@
|
|||
(lambda (who fmt . args)
|
||||
(display-error "Error" who fmt args)))
|
||||
|
||||
(define warning
|
||||
(lambda (who fmt . args)
|
||||
(display-error "Warning" who fmt args)))
|
||||
|
||||
(define (assert-open-textual-output-port p who)
|
||||
(unless (output-port? p)
|
||||
(die who "not an output port" p))
|
||||
|
|
|
@ -1 +1 @@
|
|||
1841
|
||||
1842
|
||||
|
|
|
@ -735,6 +735,7 @@
|
|||
[equal? i r ba se]
|
||||
[eqv? i r ba se]
|
||||
[error i r ba]
|
||||
[warning i]
|
||||
[die i]
|
||||
[even? i r ba se]
|
||||
[exact i r ba]
|
||||
|
|
Loading…
Reference in New Issue