52 lines
1.9 KiB
Scheme
52 lines
1.9 KiB
Scheme
(module readerr mzscheme
|
|
(provide raise-read-error
|
|
raise-read-eof-error)
|
|
|
|
(define (raise-read-error msg source-name line col pos span)
|
|
(-raise-read-error make-exn:fail:read msg source-name line col pos span))
|
|
|
|
(define (raise-read-eof-error msg source-name line col pos span)
|
|
(-raise-read-error make-exn:fail:read:eof msg source-name line col pos span))
|
|
|
|
(define (-raise-read-error make-exn:fail:read msg source-name line col pos span)
|
|
(let ([bad-type
|
|
(lambda (which what)
|
|
(raise-type-error 'raise-read-error
|
|
what
|
|
which
|
|
msg source-name line col pos span))]
|
|
[ordinal? (lambda (x)
|
|
(or (not x)
|
|
(and (number? x) (exact? x) (positive? x) (integer? x))))]
|
|
[ordinal "positive exact integer"]
|
|
[cardinal? (lambda (x)
|
|
(or (not x)
|
|
(and (number? x) (exact? x) (not (negative? x)) (integer? x))))]
|
|
[cardinal "non-negative exact integer"])
|
|
|
|
(unless (string? msg)
|
|
(bad-type 0 "string"))
|
|
(unless (ordinal? line)
|
|
(bad-type 2 ordinal))
|
|
(unless (cardinal? col)
|
|
(bad-type 3 cardinal))
|
|
(unless (ordinal? pos)
|
|
(bad-type 4 ordinal))
|
|
(unless (cardinal? span)
|
|
(bad-type 5 cardinal))
|
|
|
|
(raise
|
|
(make-exn:fail:read
|
|
(format "~a~a"
|
|
(cond [(not (error-print-source-location)) ""]
|
|
[(and line col)
|
|
(format "~a:~a:~a: " source-name line col)]
|
|
[pos
|
|
(format "~a::~a: " source-name pos)]
|
|
[else
|
|
(format "~a: " source-name)])
|
|
msg)
|
|
(current-continuation-marks)
|
|
(list-immutable (make-srcloc
|
|
source-name line col pos span)))))))
|