diff --git a/collects/racket/match/gen-match.rkt b/collects/racket/match/gen-match.rkt index 0472308089..666b1c7253 100644 --- a/collects/racket/match/gen-match.rkt +++ b/collects/racket/match/gen-match.rkt @@ -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))))])) diff --git a/collects/racket/match/runtime.rkt b/collects/racket/match/runtime.rkt index 2527d0059c..677a48619f 100644 --- a/collects/racket/match/runtime.rkt +++ b/collects/racket/match/runtime.rkt @@ -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)