From c914aab4ea5d0a6d8a477226e81a6df9dbe836f1 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Sat, 22 Mar 2008 01:40:13 +0000
Subject: [PATCH] add orig-stx parameter

svn: r9056
---
 collects/scheme/match/gen-match.ss | 3 ++-
 collects/scheme/match/patterns.ss  | 1 +
 2 files changed, 3 insertions(+), 1 deletion(-)

diff --git a/collects/scheme/match/gen-match.ss b/collects/scheme/match/gen-match.ss
index c9b2e4f92b..44a89b941a 100644
--- a/collects/scheme/match/gen-match.ss
+++ b/collects/scheme/match/gen-match.ss
@@ -9,6 +9,7 @@
 ;; this parses the clauses using parse/cert, then compiles them
 ;; go : syntax syntax syntax certifier -> syntax
 (define (go parse/cert stx exprs clauses cert)
+  (parameterize ([orig-stx stx])
   (syntax-case clauses ()
     [([pats . rhs] ...)
      (let ([len (length (syntax->list exprs))])
@@ -42,4 +43,4 @@
              (let ([xs exprs]
                    ...)
                (let ([fail (lambda () #,(syntax/loc stx (match:error orig-expr)))])
-                 body))))))]))
\ No newline at end of file
+                 body))))))])))
diff --git a/collects/scheme/match/patterns.ss b/collects/scheme/match/patterns.ss
index 0e7246bc1f..904d5f5bff 100644
--- a/collects/scheme/match/patterns.ss
+++ b/collects/scheme/match/patterns.ss
@@ -19,6 +19,7 @@
                                                       (current-continuation-marks)
                                                       val)))
 
+(define orig-stx (make-parameter #f))
 
 (define-struct Pat () #:transparent)
 ;; v is an identifier