;;; © 2022 Wolfgang Corcoran-Mathe
;;;
;;; Permission is hereby granted, free of charge, to any person obtaining a
;;; copy of this software and associated documentation files (the "Software"),
;;; to deal in the Software without restriction, including without limitation
;;; the rights to use, copy, modify, merge, publish, distribute, sublicense,
;;; and/or sell copies of the Software, and to permit persons to whom the
;;; Software is furnished to do so, subject to the following conditions:
;;;
;;; The above copyright notice and this permission notice shall be included
;;; in all copies or substantial portions of the Software.
;;;
;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL
;;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR
;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,
;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
;;; OTHER DEALINGS IN THE SOFTWARE.

(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 (arity-exception loc argl)
  (abort
   (make-composite-condition
    (make-property-condition 'exn
     'location loc
     'message "invalid number of arguments"
     'arguments argl)
    (make-property-condition 'arity)
    (make-property-condition 'assertion))))

(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))))