Added srclocs to errors raised by match.

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))))]))

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)