1234567891011121314151617181920212223242526272829303132333435363738394041424344454647 |
- (library (exceptions)
- (export make-contract-violated-exception-plain
- make-exception-contract-violated-compound
- &contract-violated
- contract-violated-exception?)
- (import (except (rnrs base) let-values)
- (only (guile)
- lambda* λ
- record-constructor
- make-exception-type
- &programming-error)
- (ice-9 exceptions))
- ;; Create a custom exception type, to make it clearer,
- ;; that a contract failed, and not only an arbitrary
- ;; assertion.
- (define &contract-violated
- (make-exception-type
- ;; name of the new exception type
- '&contract-violated
- ;; parent exception type
- &programming-error
- ;; list of values the constructor of the exception
- ;; takes and their names in the record
- '()))
- (define make-contract-violated-exception-plain
- ;; record-constructor is a procedure, which will return
- ;; the constructor for any record.
- (record-constructor
- ;; Create an exception type, which is a record. This
- ;; record has a constructor, which we can name using
- ;; define for example.
- &contract-violated))
- (define contract-violated-exception?
- (exception-predicate &contract-violated))
- (define make-exception-contract-violated-compound
- (λ (message origin irritants irritant-values)
- (make-exception
- (make-contract-violated-exception-plain)
- (make-exception-with-message message)
- (make-exception-with-origin origin)
- (make-exception-with-irritants irritants)
- (make-exception-with-irritants irritant-values)))))
|