suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Remove dependency on unstable/error.

Browse Source
This commit is contained in:
Vincent St-Amour 2015-09-13 13:34:45 -05:00
parent ca64ab5e23
commit 689c294e91
1 changed files with 17 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
racket/collects/syntax/parse/private/runtime-report.rkt
View File

@ -3,7 +3,6 @@
racket/format racket/format
syntax/stx syntax/stx
racket/struct racket/struct
unstable/error
syntax/srcloc syntax/srcloc
"minimatch.rkt" "minimatch.rkt"
syntax/parse/private/residual syntax/parse/private/residual
@ -175,6 +174,11 @@ complicated.
(define (error/reports ctx reports) (define (error/reports ctx reports)
(error/report ctx (car reports) (pair? (cdr reports)))) (error/report ctx (car reports) (pair? (cdr reports))))
(define (format-if prefix val)
(if val
(format "\n ~a: ~a" prefix val)
""))
(define (error/report ctx report more?) (define (error/report ctx report more?)
(let* ([message (report-message report)] (let* ([message (report-message report)]
[context (report-context report)] [context (report-context report)]
@ -183,13 +187,18 @@ complicated.
[sub-stx (report-stx report)] [sub-stx (report-stx report)]
[within-stx (report-within-stx report)] [within-stx (report-within-stx report)]
[message [message
(compose-error-message (format "~a: ~a~a~a~a~a~a"
who message who message
'("at" maybe) (stx-if-loc sub-stx) (format-if "at" (stx-if-loc sub-stx))
'("within" maybe) (stx-if-loc within-stx) (format-if "within" (stx-if-loc within-stx))
'("in" maybe) (stx-if-loc stx) (format-if "in" (stx-if-loc stx))
'("parsing context" multi maybe) context (if (null? context)
'("note" maybe) (and more? "additional errors omitted"))] ""
(apply string-append
"\n parsing context: "
(for/list ([c (in-list context)])
(format "\n ~a" c))))
(format-if "note" (and more? "additional errors omitted")))]
[message [message
(if (error-print-source-location) (if (error-print-source-location)
(let ([source-stx (or stx sub-stx within-stx)]) (let ([source-stx (or stx sub-stx within-stx)])