From 26522375597aa615f0763ab34461c6af55c4ffa5 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 13 Oct 2010 17:43:06 -0500
Subject: [PATCH] fixed a bug in extended languages & the _ check

---
 collects/redex/private/reduction-semantics.rkt | 6 ++++--
 collects/redex/tests/tl-test.rkt               | 8 ++++++++
 2 files changed, 12 insertions(+), 2 deletions(-)

diff --git a/collects/redex/private/reduction-semantics.rkt b/collects/redex/private/reduction-semantics.rkt
index 5ddc6aabda..579698fe5c 100644
--- a/collects/redex/private/reduction-semantics.rkt
+++ b/collects/redex/private/reduction-semantics.rkt
@@ -1844,7 +1844,7 @@
          (raise-syntax-error 'define-extended-language "expected an identifier" stx #'orig-lang))
        (check-rhss-not-empty stx (cdddr (syntax->list stx)))
        (let ([old-names (language-id-nts #'orig-lang 'define-extended-language)])
-         (with-syntax ([((new-nt-names orig) ...) (append (pull-out-names 'define-language stx #'(names ...)) 
+         (with-syntax ([((new-nt-names orig) ...) (append (pull-out-names 'define-extended-language stx #'(names ...)) 
                                                           (map (λ (x) #`(#,x #f)) old-names))])
            #'(begin
                (define define-language-name (extend-language orig-lang (names rhs ...) ...))
@@ -1877,7 +1877,9 @@
                   (syntax->list (syntax/loc stx (name ...)))))
      (with-syntax ([((r-rhs ...) ...) (map (lambda (rhss) (map (λ (x) (rewrite-side-conditions/check-errs
                                                                        (append (language-id-nts #'lang 'define-extended-language)
-                                                                               (syntax->datum #'(name ...)))
+                                                                               (map (λ (x) (syntax-case x ()
+                                                                                             [(x y) (syntax-e #'x)]))
+                                                                                    (pull-out-names 'define-extended-language stx #'(name ...))))
                                                                        'define-extended-language
                                                                        #f
                                                                        x))
diff --git a/collects/redex/tests/tl-test.rkt b/collects/redex/tests/tl-test.rkt
index 727c4f84a7..d06d1cadcb 100644
--- a/collects/redex/tests/tl-test.rkt
+++ b/collects/redex/tests/tl-test.rkt
@@ -313,6 +313,14 @@
       (term (f 1)))
     (test rhs-eval-count 2))
   
+  (let ()
+    (define-language L)
+    (define-extended-language E L
+      (v ((bar X_1) X_1))
+      ((X Y) any))
+    (test (and (redex-match E v (term ((bar 1) 1))) #t) #t)
+    (test (redex-match E v (term ((bar 1) 2))) #f))
+  
 ;                                                                                             
 ;                                                                                             
 ;                                 ;;;                                ;