From 7118de47c40960e52bf311b9e90ec36c0bd5a85e Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sun, 4 May 2008 12:55:53 +0000
Subject: [PATCH] fix r6rs syntax->datum

svn: r9640
---
 collects/r6rs/scribblings/r6rs.scrbl |  2 ++
 collects/rnrs/syntax-case-6.ss       | 12 +++++++++++-
 collects/tests/r6rs/syntax-case.ss   | 12 +++++++++++-
 3 files changed, 24 insertions(+), 2 deletions(-)

diff --git a/collects/r6rs/scribblings/r6rs.scrbl b/collects/r6rs/scribblings/r6rs.scrbl
index 3c68c32ebe..18aab045ce 100644
--- a/collects/r6rs/scribblings/r6rs.scrbl
+++ b/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")
 ]
 
 
diff --git a/collects/rnrs/syntax-case-6.ss b/collects/rnrs/syntax-case-6.ss
index 5f838ab17e..988db30287 100644
--- a/collects/rnrs/syntax-case-6.ss
+++ b/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
diff --git a/collects/tests/r6rs/syntax-case.ss b/collects/tests/r6rs/syntax-case.ss
index 516786ec4e..e1f43e7b0d 100644
--- a/collects/tests/r6rs/syntax-case.ss
+++ b/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))