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

syntax/parse: accept #:context (list symbol/#f syntax)

Browse Source 
The symbol is used as the "who" field in the error message.

Also fix lazy-require of runtime-report.rkt in residual.rkt; don't
load until syntax-parse actually needs to produce an error report.
(Previously was loaded to create handler whenever syntax-parse code ran.)
This commit is contained in:
Ryan Culpepper 2015-09-10 21:16:49 -04:00
parent 4c2a32d293
commit 8d9eb05347
7 changed files with 92 additions and 34 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
pkgs/racket-doc/syntax/scribblings/parse/parsing.scrbl
View File

@ -40,7 +40,8 @@ Two parsing forms are provided: @racket[syntax-parse] and
(code:line #:phase phase-expr)]
[clause (syntax-pattern pattern-directive ... body ...+)])
#:contracts ([stx-expr syntax?]
[context-expr syntax?]
[context-expr (or/c syntax? symbol? #f
(list/c symbol? syntax?))]
[phase-expr (or/c exact-integer? #f)])]{
Evaluates @racket[stx-expr], which should produce a syntax object, and
@ -60,18 +61,32 @@ error is raised.
The following options are supported:
@specsubform[(code:line #:context context-expr)
#:contracts ([context-expr syntax?])]{
#:contracts
([context-expr (or/c syntax? symbol? #f
(list/c symbol? syntax?))])]{
When present, @racket[context-expr] is used in reporting parse
failures; otherwise @racket[stx-expr] is used. The
@racket[current-syntax-context] parameter is also set to the value of
@racket[context-expr].
failures; otherwise @racket[stx-expr] is used. If
@racket[context-expr] evaluates to @racket[(list _who _context-stx)],
then @racket[_who] appears in the error message as the form raising
the error, and @racket[_context-stx] is used as the term. If
@racket[context-expr] evaluates to a symbol, it is used as
@racket[_who] and @racket[stx-expr] (the syntax to be destructured) is
used as @racket[_context-stx]. If @racket[context-expr] evaluates to a
syntax object, it is used as @racket[_context-stx] and @racket[_who]
is inferred as with @racket[raise-syntax-error].
The @racket[current-syntax-context] parameter is also set to the
syntax object @racket[_context-stx].
@(myexamples
(syntax-parse #'(a b 3)
[(x:id ...) 'ok])
(syntax-parse #'(a b 3)
#:context #'(lambda (a b 3) (+ a b))
[(x:id ...) 'ok])
(syntax-parse #'(a b 3)
#:context 'check-id-list
[(x:id ...) 'ok]))
}

31
pkgs/racket-test/tests/stxparse/test.rkt
View File

@ -268,14 +268,29 @@
;; == syntax-parse: other feature tests
(test-case "syntax-parse: #:context"
(check-exn
(lambda (exn)
(regexp-match #rx"me: expected exact-nonnegative-integer" (exn-message exn)))
(lambda ()
(syntax-parse #'(m x) #:context #'me
[(_ n:nat) 'ok])))
(void))
(test-case "syntax-parse: #:context w/ syntax"
(check-exn
#rx"me: expected exact-nonnegative-integer"
(lambda ()
(syntax-parse #'(m x)
#:context #'me
[(_ n:nat) 'ok]))))
(test-case "syntax-parse: #:context w/ symbol"
(check-exn
#rx"me: expected identifier"
(lambda ()
(syntax-parse #'(m 1)
#:context 'me
[(_ x:id) 'ok]))))
(test-case "syntax-parse: #:context w/ symbol+stx"
(check-exn
#rx"me: expected identifier.*in: \\(bigterm\\)"
(lambda ()
(syntax-parse #'(m 1)
#:context (list 'me #'(bigterm))
[(_ x:id) 'ok]))))
(test-case "syntax-parse: #:literals"
(syntax-parse #'(0 + 1 * 2)

3
racket/collects/syntax/parse/debug.rkt
View File

@ -9,8 +9,7 @@
syntax/parse/private/residual
"private/runtime.rkt"
"private/runtime-progress.rkt"
(except-in "private/runtime-report.rkt"
syntax-patterns-fail)
"private/runtime-report.rkt"
"private/kws.rkt")
;; No lazy loading for this module's dependencies.

10
racket/collects/syntax/parse/private/parse.rkt
View File

@ -361,6 +361,10 @@ Conventions:
(with-disappeared-uses
(with-txlifts
(lambda ()
(define who
(syntax-case #'ctx ()
[(m . _) (identifier? #'m) #'m]
[_ 'syntax-parse]))
(define-values (chunks clauses-stx)
(parse-keyword-options #'clauses parse-directive-table
#:context #'ctx
@ -403,13 +407,13 @@ Conventions:
(for/lists (patterns body-exprs defs2s) ([clause (in-list (stx->list clauses-stx))])
(for-clause clause)))
(with-syntax ([(def ...) (apply append (get-txlifts-as-definitions) defs defs2s)])
#`(let* ([ctx0 #,context]
[pr (ps-empty x ctx0)]
#`(let* ([ctx0 (normalize-context '#,who #,context x)]
[pr (ps-empty x (cadr ctx0))]
[es #f]
[cx x]
[fh0 (syntax-patterns-fail ctx0)])
def ...
(parameterize ((current-syntax-context ctx0))
(parameterize ((current-syntax-context (cadr ctx0)))
(with ([fail-handler fh0]
[cut-prompt fh0])
#,(cond [(pair? patterns)

26
racket/collects/syntax/parse/private/residual.rkt
View File

@ -65,6 +65,7 @@
name->too-few/once
name->too-few
name->too-many
normalize-context
syntax-patterns-fail)
;; == from runtime.rkt
@ -241,9 +242,32 @@
;; == parse.rkt
;; normalize-context : Symbol Any Syntax -> (list Symbol/#f Syntax)
(define (normalize-context who ctx stx)
(cond [(syntax? ctx)
(list #f ctx)]
[(symbol? ctx)
(list ctx stx)]
[(eq? ctx #f)
(list #f stx)]
[(and (list? ctx)
(= (length ctx) 2)
(or (symbol? (car ctx)) (eq? #f (car ctx)))
(syntax? (cadr ctx)))
ctx]
[else (error who "bad #:context argument\n expected: ~s\n given: ~e"
'(or/c syntax? symbol? #f (list/c (or/c symbol? #f) syntax?))
ctx)]))
;; == parse.rkt
(lazy-require
["runtime-report.rkt"
(syntax-patterns-fail)])
(call-current-failure-handler ctx fs)])
;; syntax-patterns-fail : (list Symbol/#f Syntax) -> FailureSet -> (escapes)
(define ((syntax-patterns-fail ctx) fs)
(call-current-failure-handler ctx fs))
;; == specialized ellipsis parser
;; returns (values 'ok attr-values) or (values 'fail failure)

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

@ -6,16 +6,13 @@
unstable/error
syntax/srcloc
"minimatch.rkt"
(except-in syntax/parse/private/residual
syntax-patterns-fail)
syntax/parse/private/residual
"kws.rkt")
(provide syntax-patterns-fail
(provide call-current-failure-handler
current-failure-handler
maximal-failures
invert-ps
ps->stx+index
)
ps->stx+index)
#|
TODO: given (expect:thing _ D _ R) and (expect:thing _ D _ #f),
@ -28,8 +25,8 @@ Note: there is a cyclic dependence between residual.rkt and this module,
broken by a lazy-require of this module into residual.rkt
|#
(define ((syntax-patterns-fail stx0) fs)
(call-with-values (lambda () ((current-failure-handler) stx0 fs))
(define (call-current-failure-handler ctx fs)
(call-with-values (lambda () ((current-failure-handler) ctx fs))
(lambda vals
(error 'current-failure-handler
"current-failure-handler: did not escape, produced ~e"
@ -37,8 +34,8 @@ broken by a lazy-require of this module into residual.rkt
((1) (car vals))
(else (cons 'values vals)))))))
(define (default-failure-handler stx0 fs)
(report-failureset stx0 fs))
(define (default-failure-handler ctx fs)
(report-failureset ctx fs))
(define current-failure-handler
(make-parameter default-failure-handler))
@ -57,11 +54,11 @@ special handling of failures like "unexpected term" make things more
complicated.
|#
;; report-failureset : stx FailureSet -> escapes
(define (report-failureset stx0 fs)
;; report-failureset : (list Symbol/#f Syntax) FailureSet -> escapes
(define (report-failureset ctx fs)
(let* ([classes (maximal-failures fs)]
[reports (apply append (map report/class classes))])
(raise-syntax-error/reports stx0 reports)))
(raise-syntax-error/reports ctx reports)))
;; A Report is
;; - (report string (listof string) stx stx)
@ -175,12 +172,15 @@ complicated.
;; == Do Report ==
(define (raise-syntax-error/reports stx0 reports)
(define (raise-syntax-error/reports ctx reports)
(let* ([report (car reports)]
[more? (pair? (cdr reports))]
[message0 (report-message report)]
[context (report-context report)])
[context (report-context report)]
[who (car ctx)]
[stx0 (cadr ctx)])
(raise-syntax-error* message0 stx0 (report-stx report)
#:who who
#:within (report-within-stx report)
'("parsing context" multi maybe) context
'("note" maybe) (and more? "additional errors omitted"))))

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

@ -38,6 +38,7 @@ TODO
[raise-syntax-error*
(->* [string? (or/c syntax? #f) (or/c syntax? #f)]
[#:continued (or/c string? (listof string))
#:who (or/c symbol? #f)
#:within (or/c #f syntax?)]
#:rest details-list/c
any)]