Use the form name from match*/derived to improve error messages.

This commit is contained in:
Sam Tobin-Hochstadt 2014-03-28 10:04:54 -04:00
parent 52c5d9fde6
commit 431ba2e88b
2 changed files with 9 additions and 3 deletions

View File

@ -26,6 +26,12 @@
(parameterize ([orig-stx stx])
(unless (syntax->list es)
(raise-syntax-error 'match* "expected a sequence of expressions to match" es)))
(define/with-syntax form-name
(syntax-case stx ()
[(fname . _)
(identifier? #'fname)
(syntax-e #'fname)]
[_ 'match]))
(define len (length (syntax->list es)))
(define srcloc-list (list #`(quote #,(syntax-source stx))
#`(quote #,(syntax-line stx))
@ -36,7 +42,7 @@
(define/with-syntax (exprs ...) es)
(define/with-syntax outer-fail (generate-temporary #'fail))
(define/with-syntax orig-expr (if (= 1 len) (stx-car #'(xs ...)) #'(list xs ...)))
(define/with-syntax raise-error (quasisyntax/loc stx (match:error orig-expr (list (srcloc #,@srcloc-list)))))
(define/with-syntax raise-error (quasisyntax/loc stx (match:error orig-expr (list (srcloc #,@srcloc-list)) 'form-name)))
(define parsed-clauses
(for/list ([clause (syntax->list clauses)]
[pats (syntax->list #'(pats ...))]

View File

@ -18,8 +18,8 @@
#:property prop:exn:srclocs (lambda (ex) (exn:misc:match-srclocs ex)))
(define (match:error val srclocs)
(raise (make-exn:misc:match (format "match: no matching clause for ~e" val)
(define (match:error val srclocs form-name)
(raise (make-exn:misc:match (format "~a: no matching clause for ~e" form-name val)
(current-continuation-marks)
val
srclocs)))