From 9b84def3c1314f9639e0df282e7959a3a49ea2a5 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Sun, 4 Jan 2009 18:08:37 +0000
Subject: [PATCH] PR 10002

svn: r13002
---
 collects/redex/private/reduction-semantics.ss | 42 ++++++++++++-------
 1 file changed, 26 insertions(+), 16 deletions(-)

diff --git a/collects/redex/private/reduction-semantics.ss b/collects/redex/private/reduction-semantics.ss
index 653464e38c..18aa7ef857 100644
--- a/collects/redex/private/reduction-semantics.ss
+++ b/collects/redex/private/reduction-semantics.ss
@@ -1045,25 +1045,35 @@
            
   (define (check-clauses stx syn-error-name rest)
     (syntax-case rest ()
-      [([(lhs ...) roc ...] ...)
+      [([(lhs ...) roc1 roc2 ...] ...)
        rest]
+      [([(lhs ...) rhs ...] ...)
+       (begin
+         (for-each 
+          (λ (clause)
+            (syntax-case clause ()
+              [(a b) (void)]
+              [x (raise-syntax-error syn-error-name "expected a pattern and a right-hand side" stx clause)]))
+          (syntax->list #'([(lhs ...) rhs ...] ...)))
+         (raise-syntax-error syn-error-name "error checking failed.3" stx))]
       [([x roc ...] ...)
-       (for-each 
-        (λ (x)
-          (syntax-case x ()
-            [(lhs ...) (void)]
-            [x (raise-syntax-error syn-error-name "expected a function prototype" stx #'x)]))
-        (syntax->list #'(x ...)))
-       (raise-syntax-error syn-error-name "error checking failed.1" stx)]
+       (begin
+         (for-each 
+          (λ (x)
+            (syntax-case x ()
+              [(lhs ...) (void)]
+              [x (raise-syntax-error syn-error-name "expected a function prototype" stx #'x)]))
+          (syntax->list #'(x ...)))
+         (raise-syntax-error syn-error-name "error checking failed.1" stx))]
       [(x ...)
-       (for-each 
-        (λ (x)
-          (syntax-case x ()
-            [(stuff ...) (void)]
-            [x (raise-syntax-error syn-error-name "expected a metafunction clause" stx #'x)]))
-        (syntax->list #'(x ...)))
-       (raise-syntax-error syn-error-name "error checking failed.2" stx)]))
-        
+       (begin
+         (for-each 
+          (λ (x)
+            (syntax-case x ()
+              [(stuff ...) (void)]
+              [x (raise-syntax-error syn-error-name "expected a metafunction clause" stx #'x)]))
+          (syntax->list #'(x ...)))
+         (raise-syntax-error syn-error-name "error checking failed.2" stx))]))
   
   (define (extract-side-conditions name stx stuffs)
     (let loop ([stuffs (syntax->list stuffs)]