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