fix r6rs syntax->datum

svn: r9640

collects/r6rs/scribblings/r6rs.scrbl

@@ -163,6 +163,7 @@ Examples:
 (rnrs io simple (6))  #, @elem{roughly means}  rnrs/io/simple-6
 (rnrs)                #, @elem{roughly means}  rnrs
 (rnrs (6))            #, @elem{roughly means}  rnrs/main-6
+(scheme base)         #, @elem{roughly means}  scheme/base
 ]
 
 When an @|r6rs| library or top-level program refers to another
@@ -183,6 +184,7 @@ Examples (assuming a typical PLT Scheme installation):
 (rnrs io simple (6))  #, @elem{really means}  (lib "rnrs/io/simple-6.ss")
 (rnrs)                #, @elem{really means}  (lib "rnrs/main-6.ss")
 (rnrs (6))            #, @elem{really means}  (lib "rnrs/main-6.ss")
+(scheme base)         #, @elem{really means}  (lib "scheme/base.ss")
 ]
 
 

collects/rnrs/syntax-case-6.ss

@@ -38,7 +38,17 @@
   (datum->syntax id (convert-mpairs datum)))
 
 (define (r6rs:syntax->datum stx)
-  (convert-pairs (syntax->datum stx)))
+  (cond
+   [(syntax? stx)
+    (convert-pairs (syntax->datum stx))]
+   [(mpair? stx) (mcons (r6rs:syntax->datum
+                         (mcar stx))
+                        (r6rs:syntax->datum
+                         (mcdr stx)))]
+   [(vector? stx) (list->vector
+                   (map r6rs:syntax->datum
+                        (vector->list stx)))]
+   [else stx]))
 
 (define (r6rs:generate-temporaries l)
   (list->mlist

collects/tests/r6rs/syntax-case.ss

@@ -210,6 +210,13 @@
     (test (syntax->datum #'(a b)) '(a b))
     (test (syntax->datum #'(a . b)) '(a . b))
 
+    (test (syntax->datum '1) 1)
+    (test (syntax->datum '(a . b)) '(a . b))
+    (test (syntax->datum '(a b)) '(a b))
+    (test (syntax->datum (cons #'a #'b)) '(a . b))
+    (test (syntax->datum (vector #'a #'b)) '#(a b))
+    (test (syntax->datum '#(a b)) '#(a b))
+
     (test (syntax->datum (datum->syntax #'x 1)) 1)
     (test (syntax->datum (datum->syntax #'x 'a)) 'a)
     (test (syntax->datum (datum->syntax #'x '(a b))) '(a b))
@@ -281,5 +288,8 @@
     (test/exn (syntax-violation 'form "bad" 7 8) &syntax)
 
     ;;
-    ))
+    )
+
+  (run-syntax-case-tests)
+  (report-test-results))