exceptions.scm 1.6 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647
  1. (library (exceptions)
  2. (export make-contract-violated-exception-plain
  3. make-exception-contract-violated-compound
  4. &contract-violated
  5. contract-violated-exception?)
  6. (import (except (rnrs base) let-values)
  7. (only (guile)
  8. lambda* λ
  9. record-constructor
  10. make-exception-type
  11. &programming-error)
  12. (ice-9 exceptions))
  13. ;; Create a custom exception type, to make it clearer,
  14. ;; that a contract failed, and not only an arbitrary
  15. ;; assertion.
  16. (define &contract-violated
  17. (make-exception-type
  18. ;; name of the new exception type
  19. '&contract-violated
  20. ;; parent exception type
  21. &programming-error
  22. ;; list of values the constructor of the exception
  23. ;; takes and their names in the record
  24. '()))
  25. (define make-contract-violated-exception-plain
  26. ;; record-constructor is a procedure, which will return
  27. ;; the constructor for any record.
  28. (record-constructor
  29. ;; Create an exception type, which is a record. This
  30. ;; record has a constructor, which we can name using
  31. ;; define for example.
  32. &contract-violated))
  33. (define contract-violated-exception?
  34. (exception-predicate &contract-violated))
  35. (define make-exception-contract-violated-compound
  36. (λ (message origin irritants irritant-values)
  37. (make-exception
  38. (make-contract-violated-exception-plain)
  39. (make-exception-with-message message)
  40. (make-exception-with-origin origin)
  41. (make-exception-with-irritants irritants)
  42. (make-exception-with-irritants irritant-values)))))