From 163bd080f9850a508c9eae3a4adf4f544ef02fad Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Tue, 3 Feb 2009 22:44:57 +0000
Subject: [PATCH] stxclass: allow block as syntax-parse rhs

svn: r13399
---
 collects/stxclass/private/codegen.ss | 21 ++++++++++-----------
 1 file changed, 10 insertions(+), 11 deletions(-)

diff --git a/collects/stxclass/private/codegen.ss b/collects/stxclass/private/codegen.ss
index 1685612b13..9dffe0fca8 100644
--- a/collects/stxclass/private/codegen.ss
+++ b/collects/stxclass/private/codegen.ss
@@ -53,18 +53,17 @@
                                                #:sc? #f
                                                #:literals literals)])
          (syntax-case rest ()
-           [(b)
+           [(b ...)
             (let* ([pattern (parse-pattern #'p decls 0)])
               (make-pk (list pattern)
                        (expr:convert-sides sides
                                            (pattern-attrs pattern)
                                            var
                                            (lambda (iattrs)
-                                             (wrap-pattern-body/attrs iattrs
-                                                                      0
-                                                                      #'b)))))]
+                                             (wrap-pattern-body/attrs
+                                              iattrs 0 rest)))))]
            [_
-            (wrong-syntax clause "expected single body expression")]))]))
+            (wrong-syntax clause "expected body")]))]))
   (unless (stx-list? clauses-stx)
     (wrong-syntax clauses-stx "expected sequence of clauses"))
   (let ([pks (map clause->pk (stx->list clauses-stx))])
@@ -103,7 +102,7 @@
     [(cons (struct clause:when (e)) rest)
      (let* ([k-rest (expr:convert-sides rest iattrs main-var k)])
        (with-syntax ([(x) (generate-temporaries #'(x))])
-         #`(let ([x #,(wrap-pattern-body/attrs iattrs 0 e)])
+         #`(let ([x #,(wrap-pattern-body/attrs iattrs 0 (list e))])
              (if x
                  #,k-rest
                  #,(fail #'enclosing-fail main-var
@@ -113,7 +112,7 @@
      (let* ([new-iattrs (append (pattern-attrs p) iattrs)]
             [k-rest (expr:convert-sides rest new-iattrs main-var k)])
        (with-syntax ([(x fail-k) (generate-temporaries #'(x fail-k))])
-         #`(let ([x #,(wrap-pattern-body/attrs iattrs 0 e)]
+         #`(let ([x #,(wrap-pattern-body/attrs iattrs 0 (list e))]
                  [fail-k enclosing-fail])
              #,(parse:pks (list #'x)
                           (list (done-frontier #'x))
@@ -582,13 +581,13 @@
        (make-pk (list* head tail rest-ps) k)]))
   (map shift-pk pks))
 
-;; wrap-pattern-body : (listof IAttr) nat stx -> stx
-(define (wrap-pattern-body/attrs iattrs depth b)
+;; wrap-pattern-body : (listof IAttr) nat stxlist -> stx
+(define (wrap-pattern-body/attrs iattrs depth bs)
   (let* ([flat-iattrs (flatten-attrs* iattrs depth #f #f)]
          [ids (map attr-name flat-iattrs)]
          [depths (map attr-depth flat-iattrs)])
     (with-syntax ([(id ...) ids]
                   [(depth ...) depths]
-                  [b b])
+                  [bs bs])
       #`(let-syntax ([id (make-syntax-mapping 'depth (quote-syntax id))] ...)
-          b))))
+          . bs))))