You cannot select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
beautiful-racket/beautiful-racket-lib/br/exception.rkt

28 lines
1.1 KiB
Racket

8 years ago
#lang racket/base
(require (for-syntax racket/base br/syntax) br/define racket/match)
(provide (all-defined-out))
(define-macro (define-exn EXN-ID BASE-EXN)
(with-pattern ([RAISE-EXN-ID (prefix-id "raise-" #'EXN-ID)])
#'(begin
(struct EXN-ID BASE-EXN () #:transparent)
(define (RAISE-EXN-ID)
(raise (EXN-ID (format "error: ~a" 'EXN-ID) (current-continuation-marks)))))))
(define-macro (define-exn-srcloc EXN-ID BASE-EXN)
(with-pattern ([RAISE-EXN-ID (prefix-id "raise-" #'EXN-ID)])
#'(begin
(define-struct (EXN-ID BASE-EXN)
(a-srcloc) #:transparent
#:property prop:exn:srclocs
(lambda (a-struct)
(match a-struct
[(struct EXN-ID
(msg marks a-srcloc))
(list a-srcloc)])))
(define RAISE-EXN-ID
(case-lambda
[(srcloc)
(raise (EXN-ID (format "error: ~a" 'EXN-ID) (current-continuation-marks) srcloc))]
[()
(raise (EXN-ID (format "error: ~a" 'EXN-ID) (current-continuation-marks)))])))))