add #:extra-srclocs argument to raise-read-error
Also, modernize the error checking to use raise-argument-error and generally Rackety
This commit is contained in:
parent
2ac6615da9
commit
2067534431
|
@ -1,52 +1,50 @@
|
|||
; Don't change this module to #lang, since it's used by syntax/module-reader
|
||||
(module readerr racket/private/base
|
||||
(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))
|
||||
|
||||
raise-read-eof-error)
|
||||
|
||||
(define (raise-read-error msg source-name line col pos span #:extra-srclocs [extra-srclocs '()])
|
||||
(-raise-read-error make-exn:fail:read msg source-name line col pos span
|
||||
extra-srclocs
|
||||
'raise-read-error))
|
||||
|
||||
(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"])
|
||||
(-raise-read-error make-exn:fail:read:eof msg source-name line col pos span '()
|
||||
'raise-read-eof-error))
|
||||
|
||||
(define (-raise-read-error make-exn:fail:read msg source-name line col pos span extra-srclocs name)
|
||||
(define (bad-type which what)
|
||||
(raise-argument-error name what which
|
||||
msg source-name line col pos span))
|
||||
|
||||
(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 (make-srcloc
|
||||
source-name line col pos span)))))))
|
||||
(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))
|
||||
(unless (and (list? extra-srclocs) (andmap srcloc? extra-srclocs))
|
||||
(raise-argument-error name "(list/c srcloc?)" extra-srclocs))
|
||||
|
||||
(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)
|
||||
(cons (make-srcloc source-name line col pos span)
|
||||
extra-srclocs))))
|
||||
|
||||
(define (ordinal? x)
|
||||
(or (not x)
|
||||
(exact-positive-integer? x)))
|
||||
(define ordinal "(or/c exact-positive-integer? #f)")
|
||||
(define (cardinal? x)
|
||||
(or (not x)
|
||||
(exact-nonnegative-integer? x)))
|
||||
(define cardinal "(or/c exact-nonnegative-integer? #f)"))
|
||||
|
|
|
@ -10,14 +10,16 @@
|
|||
[line (or/c number? false/c)]
|
||||
[col (or/c number? false/c)]
|
||||
[pos (or/c number? false/c)]
|
||||
[span (or/c number? false/c)])
|
||||
[span (or/c number? false/c)]
|
||||
[#:extra-srclocs extra-srclocs (listof srcloc?) '()])
|
||||
any]{
|
||||
|
||||
Creates and raises an @racket[exn:fail:read] exception, using
|
||||
@racket[msg-string] as the base error message.
|
||||
|
||||
Source-location information is added to the error message using the
|
||||
last five arguments (if the @racket[error-print-source-location]
|
||||
last five arguments and the @racket[extra-srclocs]
|
||||
(if the @racket[error-print-source-location]
|
||||
parameter is set to @racket[#t]). The @racket[source] argument is an
|
||||
arbitrary value naming the source location---usually a file path
|
||||
string. Each of the @racket[line], @racket[pos] arguments is
|
||||
|
|
Loading…
Reference in New Issue
Block a user