From 7fd52472b46f3c6482a158cd084afc9b575121b1 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Sat, 4 May 2013 13:44:52 -0400
Subject: [PATCH] fixed quasisyntax to work with prefab struct templates

Prefab struct templates have problems with unsyntax-splicing,
but so do vectors. See commented tests.
---
 collects/racket/private/qqstx.rkt | 10 ++++++++++
 collects/tests/racket/stx.rktl    | 19 +++++++++++++++++++
 2 files changed, 29 insertions(+)

diff --git a/collects/racket/private/qqstx.rkt b/collects/racket/private/qqstx.rkt
index 12103d98ab..d823b43c07 100644
--- a/collects/racket/private/qqstx.rkt
+++ b/collects/racket/private/qqstx.rkt
@@ -241,6 +241,16 @@
                                            stx
                                            stx)
                                           bindings)))]
+                      [(prefab-struct-key (syntax-e stx))
+                       (let* ([d (syntax-e stx)]
+                              [key (prefab-struct-key d)]
+                              [fields (cdr (vector->list (struct->vector d)))])
+                         (loop (datum->syntax stx fields stx)
+                               depth
+                               same-k
+                               (lambda (v bindings)
+                                 (let ([p (apply make-prefab-struct key (syntax->list v))])
+                                   (convert-k (datum->syntax stx p stx stx) bindings)))))]
                       [else
                        (same-k)])]))))]
            [qq (lambda (orig-stx body mk-final)
diff --git a/collects/tests/racket/stx.rktl b/collects/tests/racket/stx.rktl
index e71eb19805..d345ee1434 100644
--- a/collects/tests/racket/stx.rktl
+++ b/collects/tests/racket/stx.rktl
@@ -1717,6 +1717,25 @@
     (dynamic-require ''mm-context-m3 #f))
   (test #"1\n2\n" get-output-bytes o))
 
+;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Check `quasisyntax' finds `unsyntax'
+
+(with-syntax ([a #'1] [(c ...) #'(3 4 5)])
+  (let ([b #'2] [ds (list #'3 #'4 #'5)])
+    (test '(1 2) syntax->datum (quasisyntax (a (unsyntax b))))
+    (test '(2 1) syntax->datum (quasisyntax ((unsyntax b) a)))
+    (test '(1 . 2) syntax->datum (quasisyntax (a unsyntax b)))
+    (test '((1) (2)) syntax->datum (quasisyntax ((a) ((unsyntax b)))))
+    (test '#(1 2) syntax->datum (quasisyntax #(a (unsyntax b))))
+    (test '#(1 2 3 4 5) syntax->datum (quasisyntax #(a (unsyntax b) c ...)))
+    (test '#s(PS 1 2) syntax->datum (quasisyntax #s(PS a (unsyntax b))))
+    (test '#s(PS 1 2 3 4 5) syntax->datum (quasisyntax #s(PS a (unsyntax b) c ...)))
+    #|
+    (test '#(1 2 3 4 5) syntax->datum (quasisyntax #(a (unsyntax b) (unsyntax-splicing ds))))
+    (test '#s(PS 1 2 3 4 5) syntax->datum
+          (quasisyntax #s(PS a (unsyntax b) (unsyntax-splicing ds))))
+    |#))
+
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Check preservation of properties by `quasisyntax'