From f272acec5fed3c1be7159efa928956e628c126e1 Mon Sep 17 00:00:00 2001
From: Jay McCarthy <jay@racket-lang.org>
Date: Thu, 2 Sep 2010 07:03:50 -0600
Subject: [PATCH] Correcting bug discovered by Arjun

---
 collects/plai/datatype.rkt               | 24 ++++++++++--------------
 collects/tests/plai/datatype-exports.rkt | 16 ++++++++++++++++
 2 files changed, 26 insertions(+), 14 deletions(-)
 create mode 100644 collects/tests/plai/datatype-exports.rkt

diff --git a/collects/plai/datatype.rkt b/collects/plai/datatype.rkt
index 4e17d8cc53..eeff071b87 100644
--- a/collects/plai/datatype.rkt
+++ b/collects/plai/datatype.rkt
@@ -59,8 +59,6 @@
   (symbol->string (syntax-e s)))
 
 (define-syntax (define-type stx)
-  (define (format-id/std fmt x)
-    (format-id stx fmt #:source x x))
   (syntax-parse
    stx
    [(_ datatype:id
@@ -82,23 +80,21 @@
          (cons #'datatype? (syntax->list #'(variant ...))))
     (with-syntax
         ([(variant* ...) 
-          (map (lambda (s)
-                 (datum->syntax stx (syntax->datum s)))
-               (generate-temporaries #'(variant ...)))])
+          (generate-temporaries #'(variant ...))])
       
       (with-syntax
           ([((field/c-val ...) ...)
             (syntax-map generate-temporaries #'((field/c ...) ...))]
            [datatype?
-            (format-id/std "~a?" #'datatype)]
+            (format-id stx "~a?" #'datatype #:source #'datatype)]
            [(variant? ...)
-            (syntax-map (curry format-id/std "~a?") #'(variant ...))]
+            (syntax-map (λ (x) (format-id stx "~a?" x #:source x)) #'(variant ...))]
            [(variant*? ...)
-            (syntax-map (curry format-id/std "~a?") #'(variant* ...))]
+            (syntax-map (λ (x) (format-id x "~a?" x #:source x)) #'(variant* ...))]
            [(make-variant ...)
-            (syntax-map (curry format-id/std "make-~a") #'(variant ...))]
+            (syntax-map (λ (x) (format-id stx "make-~a" x #:source x)) #'(variant ...))]
            [(make-variant* ...)
-            (syntax-map (curry format-id/std "make-~a") #'(variant* ...))])
+            (syntax-map (λ (x) (format-id x "make-~a" x #:source x)) #'(variant* ...))])
         
         (with-syntax
             ([((f:variant? ...) ...)
@@ -108,26 +104,26 @@
                           #'((field ...) ...))]
              [((variant-field ...) ...)
               (syntax-map (lambda (variant fields)
-                            (syntax-map (curry format-id/std (string-append (syntax-string variant) "-~a"))
+                            (syntax-map (λ (f) (format-id stx "~a-~a" variant f #:source f))
                                         fields))
                           #'(variant ...)
                           #'((field ...) ...))]
              [((variant*-field ...) ...)
               (syntax-map (lambda (variant fields)
-                            (syntax-map (curry format-id/std (string-append (syntax-string variant) "-~a"))
+                            (syntax-map (λ (f) (format-id variant "~a-~a" variant f #:source f))
                                         fields))
                           #'(variant* ...)
                           #'((field ...) ...))]
              
              [((set-variant-field! ...) ...)
               (syntax-map (lambda (variant fields)
-                            (syntax-map (curry format-id/std (string-append "set-" (syntax-string variant) "-~a!"))
+                            (syntax-map (λ (f) (format-id stx "set-~a-~a!" variant f #:source f))
                                         fields))
                           #'(variant ...)
                           #'((field ...) ...))]
              [((set-variant*-field! ...) ...)
               (syntax-map (lambda (variant fields)
-                            (syntax-map (curry format-id/std (string-append "set-" (syntax-string variant) "-~a!"))
+                            (syntax-map (λ (f) (format-id variant "set-~a-~a!" variant f #:source f))
                                         fields))
                           #'(variant* ...)
                           #'((field ...) ...))])
diff --git a/collects/tests/plai/datatype-exports.rkt b/collects/tests/plai/datatype-exports.rkt
new file mode 100644
index 0000000000..a9c1592dcf
--- /dev/null
+++ b/collects/tests/plai/datatype-exports.rkt
@@ -0,0 +1,16 @@
+#lang racket/load
+(require tests/eli-tester)
+
+(module ex plai
+  (define-type Type
+    [Variant (field number?)]))
+  
+(define-syntax (exports-of stx)
+ (syntax-case stx ()
+   [(_ module-name)
+    (let ([exports (syntax-local-module-exports (syntax->datum #'module-name))])
+      #`(quote #,(cdaddr exports)))]))
+
+(test (exports-of 'ex)
+      =>
+      '(Type set-Variant-field! make-Variant Variant? Variant-field Variant Type?))
\ No newline at end of file