;;;; This is free software.  See LICENSE for copyright information.

(define (type-exception loc msg . args)
  (abort
   (make-composite-condition
    (make-property-condition 'exn
     'location loc
     'message msg
     'arguments args)
    (make-property-condition 'type)
    (make-property-condition 'assertion))))

(define-syntax assert-type
  (syntax-rules ()
    ((assert-type loc expr)
     (unless expr
       (type-exception loc "type-check failed" 'expr)))))

(define (bounds-exception loc msg . args)
  (abort
   (make-composite-condition
    (make-property-condition 'exn
     'location loc
     'message msg
     'arguments args)
    (make-property-condition 'bounds)
    (make-property-condition 'assertion))))

(define (bytestring-error loc msg . args)
  (abort
   (make-composite-condition
    (make-property-condition 'exn
     'location loc
     'message msg
     'arguments args)
    (make-property-condition 'bytestring))))

;; Exported
(define (bytestring-error? obj)
  ((condition-predicate 'bytestring) obj))