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

add "within:" line for stxparse errors

Browse Source 
related to PR 13806
This commit is contained in:
Ryan Culpepper 2013-10-10 23:50:06 -04:00
parent 6e022706b4
commit 454234cfc9
2 changed files with 21 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -64,8 +64,8 @@ complicated.
(raise-syntax-error/reports stx0 reports)))
;; A Report is
;; - (report string (listof string) stx)
(define-struct report (message context stx) #:prefab)
;; - (report string (listof string) stx stx)
(define-struct report (message context stx within-stx) #:prefab)
;; report/class : (non-empty-listof Failure) -> (listof Report)
(define (report/class fs)
@ -82,22 +82,23 @@ complicated.
(let ([frame-expect (and (pair? es) (car es))]
[context (append* (map context-prose-for-expect (if (pair? es) (cdr es) null)))])
(cond [(not frame-expect)
(report "bad syntax" context #f)]
(report "bad syntax" context #f #f)]
[else
(let ([frame-stx
(let-values ([(x cx) (stx-list-drop/cx stx stx index)])
(datum->syntax cx x cx))])
(let-values ([(frame-stx within-stx)
(let-values ([(x cx) (stx-list-drop/cx stx stx index)])
(values (datum->syntax cx x cx)
(if (syntax? x) #f cx)))])
(cond [(equal? frame-expect (expect:atom '() #f))
(syntax-case frame-stx ()
[(one . more)
(report "unexpected term" context #'one)]
(report "unexpected term" context #'one #f)]
[_
(report (prose-for-expect frame-expect) context frame-stx)])]
(report (prose-for-expect frame-expect) context frame-stx within-stx)])]
[(expect:disj? frame-expect)
(report (prose-for-expects (expect:disj-expects frame-expect))
context frame-stx)]
context frame-stx within-stx)]
[else
(report (prose-for-expect frame-expect) context frame-stx)]))])))
(report (prose-for-expect frame-expect) context frame-stx within-stx)]))])))
;; prose-for-expects : (listof Expect) -> string
;; FIXME: partition by role first?
@ -161,6 +162,7 @@ complicated.
[message0 (report-message report)]
[context (report-context report)])
(raise-syntax-error* message0 stx0 (report-stx report)
#:within (report-within-stx report)
'("parsing context" multi maybe) context
'("note" maybe) (and more? "additional errors omitted"))))

12
racket/collects/unstable/error.rkt
View File

@ -37,7 +37,8 @@ TODO
any)]
[raise-syntax-error*
(->* [string? (or/c syntax? #f) (or/c syntax? #f)]
[#:continued (or/c string? (listof string))]
[#:continued (or/c string? (listof string))
#:within (or/c #f syntax?)]
#:rest details-list/c
any)]
[compose-error-message
@ -63,10 +64,11 @@ TODO
(define (raise-syntax-error* message0 stx sub-stx
#:who [who #f]
#:within [within-stx #f]
#:continued [continued-message null]
#:extra-sources [extra-stxs null]
. field+detail-list)
(let* ([source-stx (or stx sub-stx)]
(let* ([source-stx (or stx sub-stx within-stx)]
[who (or who
(let* ([maybe-id (if (stx-pair? stx) (stx-car stx) stx)])
(if (identifier? maybe-id) (syntax-e maybe-id) '?)))]
@ -76,6 +78,9 @@ TODO
'("at" maybe) (and sub-stx
(error-print-source-location)
(format "~.s" (syntax->datum sub-stx)))
'("within" maybe) (and within-stx
(error-print-source-location)
(format "~.s" (syntax->datum within-stx)))
'("in" maybe) (and stx
(error-print-source-location)
(format "~.s" (syntax->datum stx)))
@ -87,7 +92,8 @@ TODO
(raise
(exn:fail:syntax message
(current-continuation-marks)
(cond [sub-stx (cons sub-stx extra-stxs)]
(cond [within-stx (cons within-stx extra-stxs)]
[sub-stx (cons sub-stx extra-stxs)]
[stx (cons stx extra-stxs)]
[else extra-stxs])))))