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

Added srclocs to errors raised by match.

Browse Source
This commit is contained in:
Eric Dobson 2011-07-03 13:44:10 -04:00 committed by Vincent St-Amour
parent 5d06476cb3
commit fc8ed9772a
2 changed files with 14 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
collects/racket/match/gen-match.rkt
View File

@ -29,7 +29,13 @@
'match*
"expected a sequence of expressions to match"
exprs))]
[let ([len (length (syntax->list exprs))])]
[let ([len (length (syntax->list exprs))]
[srcloc-list (list
(syntax-source stx)
(syntax-line stx)
(syntax-column stx)
(syntax-position stx)
(syntax-span stx))])]
[with-syntax ([(xs ...) (generate-temporaries exprs)]
[(exprs ...) exprs]
[(fail) (generate-temporaries #'(fail))])]
@ -72,5 +78,5 @@
(quasisyntax/loc stx
(let ([xs exprs] ...)
(let ([fail (lambda ()
#,(syntax/loc stx (match:error orig-expr)))])
#,(quasisyntax/loc stx (match:error orig-expr (list (apply srcloc (quote #,srcloc-list))))))])
body))))]))

9
collects/racket/match/runtime.rkt
View File

@ -14,12 +14,15 @@
(define match-equality-test (make-parameter equal?))
(define-struct (exn:misc:match exn:fail) (value))
(define-struct (exn:misc:match exn:fail) (value srclocs)
#:property prop:exn:srclocs (lambda (ex) (exn:misc:match-srclocs ex)))
(define (match:error val)
(define (match:error val srclocs)
(raise (make-exn:misc:match (format "match: no matching clause for ~e" val)
(current-continuation-marks)
val)))
val
srclocs)))
(define-syntax-parameter fail
(lambda (stx)