From f085196bf8515cc859ddd0b946b409a57cdc532b Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Wed, 14 Nov 2007 20:46:51 +0000
Subject: [PATCH] constraint define-syntax in the R5RS language

svn: r7727
---
 collects/r5rs/init.ss |  3 ++-
 collects/r5rs/main.ss | 12 ++++++++++--
 2 files changed, 12 insertions(+), 3 deletions(-)

diff --git a/collects/r5rs/init.ss b/collects/r5rs/init.ss
index b1400be0dd..f67054f97b 100644
--- a/collects/r5rs/init.ss
+++ b/collects/r5rs/init.ss
@@ -8,8 +8,9 @@
   (read-square-bracket-as-paren #f)
 
   (print-vector-length #f)
-  (print-pair-curly-braces #t)
   (print-mpair-curly-braces #f)
+  ;; Printing pairs with curly braces is a bad idea, because
+  ;;  syntax errors then use curly braces!
   
   (define-syntax out
     (syntax-rules ()
diff --git a/collects/r5rs/main.ss b/collects/r5rs/main.ss
index 169458d0ab..148b106ed4 100644
--- a/collects/r5rs/main.ss
+++ b/collects/r5rs/main.ss
@@ -406,6 +406,13 @@
        (syntax/loc stx
          (define . rest))]))
 
+  (define-syntax (r5rs:define-syntax stx)
+    (syntax-case stx ()
+      [(_ id expr)
+       (identifier? #'id)
+       (syntax/loc stx
+         (define-syntax id expr))]))
+
   (define-syntax r5rs:if
     (syntax-rules ()
       [(_ test then)
@@ -419,10 +426,11 @@
                        [r5rs:if if]
                        [r5rs:lambda lambda]
                        [r5rs:letrec letrec]
-                       [r5rs:define define])
+                       [r5rs:define define]
+                       [r5rs:define-syntax define-syntax])
            let and or cond case delay do
 	   let* begin set!
-	   define-syntax let-syntax letrec-syntax
+	   let-syntax letrec-syntax
            => else
 
 	   ;; We have to include the following MzScheme-isms to do anything,