From 61a80e85fbe383de33bbb3c80dc22b6e1f43d3e5 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 16 May 2008 19:56:07 +0000
Subject: [PATCH] Fix uses of make-Dummy. Fix handling of seen vars in ...

svn: r9870
---
 collects/scheme/match/compiler.ss | 16 +++++++++-------
 collects/scheme/match/parse.ss    |  8 ++++----
 2 files changed, 13 insertions(+), 11 deletions(-)

diff --git a/collects/scheme/match/compiler.ss b/collects/scheme/match/compiler.ss
index e2176c2c50..e586f1f68f 100644
--- a/collects/scheme/match/compiler.ss
+++ b/collects/scheme/match/compiler.ss
@@ -118,6 +118,7 @@
        (compile-con-pat accs pred Struct-ps))]
     [else (error 'compile "bad key: ~a" k)]))
 
+
 ;; produces the syntax for a let clause
 (define (compile-one vars block esc)
   (define-values (first rest-pats) (Row-split-pats (car block)))
@@ -147,7 +148,7 @@
             (lambda (row)
               (define-values (p ps) (Row-split-pats row))
               (define v (Var-v p))
-              (define seen (Row-vars-seen row))
+              (define seen (Row-vars-seen row))              
               ;; a new row with the rest of the patterns
               (cond
                 ;; if this was a wild-card variable, don't bind
@@ -157,10 +158,9 @@
                                       (Row-vars-seen row))]
                 ;; if we've seen this variable before, check that it's equal to
                 ;; the one we saw
-                [(ormap (lambda (e)
-                          (let ([v* (car e)] [id (cdr e)])
-                            (and (bound-identifier=? v v*) id)))
-                        seen)
+                [(for/or ([e seen])
+                         (let ([v* (car e)] [id (cdr e)])
+                           (and (bound-identifier=? v v*) id)))                 
                  =>
                  (lambda (id)
                    (make-Row ps
@@ -390,13 +390,15 @@
                                 (make-Row pats
                                           rhs
                                           (Row-unmatch (car block))
-                                          null))
+                                          (Row-vars-seen
+                                           (car block))))
                               (map list heads)
                               (syntax->list #'(rhs ...)))
                          (list (make-Row (list tail)
                                          #`tail-rhs
                                          (Row-unmatch (car block))
-                                         null)))
+                                         (Row-vars-seen
+                                          (car block)))))
                         #'failkv)))]
     [else (error 'compile "unsupported pattern: ~a~n" first)]))
 
diff --git a/collects/scheme/match/parse.ss b/collects/scheme/match/parse.ss
index c2a18d6eb0..78d376b9be 100644
--- a/collects/scheme/match/parse.ss
+++ b/collects/scheme/match/parse.ss
@@ -104,7 +104,7 @@
                   (cons max (map (lambda _ 1) ps))
                   ;; vars in lp are lists, vars elsewhere are not
                   (cons #f (map (lambda _ #t) ps))
-                  (make-Null (make-Dummy #f))
+                  (make-Null (make-Dummy (syntax/loc stx _)))
                   #f))]
     [(list-no-order p ...)
      (ormap ddk? (syntax->list #'(p ...)))
@@ -119,10 +119,10 @@
                   (map (lambda _ 1) ps)
                   ;; all of these patterns get bound to only one thing
                   (map (lambda _ #t) ps)
-                  (make-Null (make-Dummy #f))
+                  (make-Null (make-Dummy (syntax/loc stx _)))
                   #f))]
-    [(list) (make-Null (make-Dummy stx))]
-    [(mlist) (make-Null (make-Dummy stx))]
+    [(list) (make-Null (make-Dummy (syntax/loc stx _)))]
+    [(mlist) (make-Null (make-Dummy (syntax/loc stx _)))]
     [(list ..)
      (ddk? #'..)
      (raise-syntax-error 'match "incorrect use of ... in pattern" stx #'..)]