From 189ef12cd0b6a6ea4ee18771f242563253f14aec Mon Sep 17 00:00:00 2001
From: Casey Klein <clklein@racket-lang.org>
Date: Thu, 18 Sep 2008 04:51:02 +0000
Subject: [PATCH] Fixed bug in generation of ellipses.

svn: r11794
---
 collects/redex/private/rg-test.ss |  5 ++++-
 collects/redex/private/rg.ss      | 26 ++++++++++++++++----------
 2 files changed, 20 insertions(+), 11 deletions(-)

diff --git a/collects/redex/private/rg-test.ss b/collects/redex/private/rg-test.ss
index 0cb8c853a1..6aedc0a987 100644
--- a/collects/redex/private/rg-test.ss
+++ b/collects/redex/private/rg-test.ss
@@ -546,6 +546,9 @@
    '((..._1 . ..._3) (..._2 . ..._3) (..._4 . ..._3)))
   (test (hash-map (class-reassignments (parse-pattern '(x_1 ... x_1 ..._!_1 x_1 ..._1))) 
                   (λ (_ cls) cls))
-        '(..._1 ..._1)))
+        '(..._1 ..._1))
+  (test-class-reassignments
+   '((3 ..._1) ..._2 (4 ..._1) ..._3)
+   '((..._2 . ..._3))))
 
 (print-tests-passed 'rg-test.ss)
diff --git a/collects/redex/private/rg.ss b/collects/redex/private/rg.ss
index f5797d11ae..977f837be9 100644
--- a/collects/redex/private/rg.ss
+++ b/collects/redex/private/rg.ss
@@ -500,22 +500,28 @@ To do a better job of not generating programs with free variables,
       (if (and par (not (eq? chd par))) (recur par (hash-ref sets par #f)) chd)))
   
   (let* ([last-contexts (make-hasheq)]
+         [record-binder
+          (λ (pat under assignments)
+            (if (null? under) 
+                assignments
+                (let ([last (hash-ref last-contexts pat #f)])
+                  (if last
+                      (foldl (λ (cur last asgns) (union cur last asgns)) assignments under last)
+                      (begin
+                        (hash-set! last-contexts pat under)
+                        assignments)))))]
          [assignments
           (let recur ([pat pattern] [under null] [assignments #hasheq()])
             (match pat
               ;; `(name ,id ,sub-pat) not considered, since bindings introduced
               ;; by name must be unique.
               [(and (? symbol?) (app symbol->string (regexp named-nt-rx)))
-               (if (null? under) 
-                   assignments
-                   (let ([last (hash-ref last-contexts pat #f)])
-                     (if last
-                         (foldl (λ (cur last asgns) (union cur last asgns)) assignments under last)
-                         (begin
-                           (hash-set! last-contexts pat under)
-                           assignments))))]
-              [(struct ellipsis (_ sub-pat (struct class (cls)) _))
-               (recur sub-pat (cons cls under) assignments)]
+               (record-binder pat under assignments)]
+              [(struct ellipsis (name sub-pat (struct class (cls)) _))
+               (recur sub-pat (cons cls under)
+                 (if (and (symbol? name) (regexp-match named-ellipsis-rx (symbol->string name)))
+                     (record-binder name under assignments)
+                     assignments))]
               [(? list?)
                (foldl (λ (pat asgns) (recur pat under asgns)) assignments pat)]
               [_ assignments]))])