From ea2861b03ae742bcc8d0cb39fb1a749e6526dd3c Mon Sep 17 00:00:00 2001
From: Casey Klein <clklein@racket-lang.org>
Date: Wed, 7 Apr 2010 15:33:36 +0000
Subject: [PATCH] Fixes PR 10843

svn: r18752
---
 collects/redex/private/matcher.ss            | 16 ++++++----------
 collects/redex/private/underscore-allowed.ss |  2 +-
 collects/redex/tests/tl-test.ss              | 15 +++++++++++++++
 3 files changed, 22 insertions(+), 11 deletions(-)

diff --git a/collects/redex/private/matcher.ss b/collects/redex/private/matcher.ss
index 9fa3b0b499..1b60992a02 100644
--- a/collects/redex/private/matcher.ss
+++ b/collects/redex/private/matcher.ss
@@ -686,16 +686,6 @@ before the pattern compiler is invoked.
                                          (build-flat-context exp)
                                          none)))))))
         #f)]
-      [`variable-not-otherwise-mentioned 
-       (values
-        (let ([literals (compiled-lang-literals clang)])
-          (lambda (exp hole-info)
-            (and (symbol? exp)
-                 (not (memq exp literals))
-                 (list (make-mtch (make-bindings null)
-                                  (build-flat-context exp)
-                                  none)))))
-        #f)]
       [`hole
        (values (match-hole none) #t)]
       [(? string?)
@@ -814,6 +804,12 @@ before the pattern compiler is invoked.
       [`number (simple-match number?)]
       [`string (simple-match string?)]
       [`variable (simple-match symbol?)]
+      [`variable-not-otherwise-mentioned
+       (let ([literals (compiled-lang-literals clang)])
+         (simple-match
+          (λ (exp)
+            (and (symbol? exp) 
+                 (not (memq exp literals))))))]
       [`natural (simple-match (λ (x) (and (integer? x) (exact? x) (not (negative? x)))))]
       [`integer (simple-match (λ (x) (and (integer? x) (exact? x))))]
       [`real (simple-match real?)]
diff --git a/collects/redex/private/underscore-allowed.ss b/collects/redex/private/underscore-allowed.ss
index b7759847c1..55c8420295 100644
--- a/collects/redex/private/underscore-allowed.ss
+++ b/collects/redex/private/underscore-allowed.ss
@@ -1,3 +1,3 @@
 #lang scheme/base
 (provide underscore-allowed) 
-(define underscore-allowed '(any number string variable natural integer real))
+(define underscore-allowed '(any number string variable variable-not-otherwise-mentioned natural integer real))
diff --git a/collects/redex/tests/tl-test.ss b/collects/redex/tests/tl-test.ss
index bceba8e321..5aae54226e 100644
--- a/collects/redex/tests/tl-test.ss
+++ b/collects/redex/tests/tl-test.ss
@@ -233,6 +233,21 @@
     (test (pair? (redex-match L x (term a_c))) #t)
     (test (pair? (redex-match L y (term a_bc))) #t))
   
+  ; underscores allowed on built-in non-terminals and names bound
+  (let ([m (redex-match 
+            grammar 
+            (any_1 number_1 natural_1 integer_1
+                   real_1 string_1 variable_1
+                   variable-not-otherwise-mentioned_1)
+            '(1 2 3 4 5 "s" s t))])
+    (test (if m
+              (map bind-exp
+                   (sort (match-bindings (car m))
+                         string<=?
+                         #:key (compose symbol->string bind-name)))
+              '())
+          '(1 4 3 2 5 "s" t s)))
+  
   ;; test caching
   (let ()
     (define match? #t)