From 8e1add79c9c987e7be8a27167cbdd286f38f0646 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 23 Jul 2008 12:25:41 +0000
Subject: [PATCH] R6RS syntax vector repair (PR 9625)

svn: r10870
---
 collects/rnrs/syntax-case-6.ss      | 17 ++++++++++-------
 collects/tests/r6rs/syntax-case.sls |  6 ++++++
 2 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/collects/rnrs/syntax-case-6.ss b/collects/rnrs/syntax-case-6.ss
index e12c014a4f..1061c33a99 100644
--- a/collects/rnrs/syntax-case-6.ss
+++ b/collects/rnrs/syntax-case-6.ss
@@ -240,12 +240,10 @@
                  (if (or a b counting?)
                      (cons a b)
                      #f))]
-      [#(a ...) (let ([as (map (lambda (a)
-                                 (loop a in-ellipses? #f))
-                               (syntax->list #'(a ...)))])
-                  (if (ormap values as)
-                      (list->vector as)
-                      #f))]
+      [#(a ...) (let ([as (loop (syntax->list #'(a ...))
+                                in-ellipses?
+                                #f)])
+                  (and as (vector as)))]
       [a
        (identifier? #'a)
        (ormap (lambda (pat-var)
@@ -278,7 +276,12 @@
       (mcons (unwrap (car p) (car mapping))
              (unwrap (cdr p) (cdr mapping))))]
    [(vector? mapping)
-    (list->vector (mlist->list (unwrap (vector->list (syntax-e stx)) (vector->list mapping))))]
+    (list->vector (let loop ([v (unwrap (vector->list (syntax-e stx))
+                                        (vector-ref mapping 0))])
+                    (cond
+                     [(null? v) null]
+                     [(mpair? v) (cons (mcar v) (loop (mcdr v)))]
+                     [(syntax? v) (syntax->list v)])))]
    [(null? mapping) null]
    [(box? mapping)
     ;; ellipses
diff --git a/collects/tests/r6rs/syntax-case.sls b/collects/tests/r6rs/syntax-case.sls
index 5851a53f5c..5541301b76 100644
--- a/collects/tests/r6rs/syntax-case.sls
+++ b/collects/tests/r6rs/syntax-case.sls
@@ -192,6 +192,12 @@
     (test (syntax-case '#(1 2 3 4) ()
             [#(1 x ... 2 3 4) #'(x ...)])
           '())
+    (test (syntax-case #'() ()
+            [(x ...)
+             (let ([v #'#(x ...)])
+               (list (syntax->datum v) (vector? v)))])
+          '(#() #t))
+    (test (vector? #'#(1 2 3)) #f)
     (test (syntax-case #'(1) ()
             [(_) (syntax->datum #'_)])
           '_)