From f2af8fa380b981dc07528f43a8000a1cf16f858e Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Tue, 9 Nov 2010 23:27:27 -0500
Subject: [PATCH] Fix error messages.

1. Before:

     (define-syntax-rule (foo x) = (+ x 1))
     define-syntax-rule: too many templates at: ((+ x 1)) in: (define-syntax-rule (foo x) = (+ x 1))

   after:

     define-syntax-rule: too many forms at: (+ x 1) in: (define-syntax-rule (foo x) = (+ x 1))

2. Before:

     (define-syntax-rule (foo x) (+ x 1))
     (foo "bar" "baz")
     foo: `(bar baz)' did not match pattern `(x)' in: (foo "bar" "baz")

   after:

     foo: (foo "bar" "baz") did not match pattern (foo x) in: (foo "bar" "baz")
---
 collects/racket/private/misc.rkt | 38 +++++++++++++++++---------------
 1 file changed, 20 insertions(+), 18 deletions(-)

diff --git a/collects/racket/private/misc.rkt b/collects/racket/private/misc.rkt
index f2b5dbdf17..916c07620d 100644
--- a/collects/racket/private/misc.rkt
+++ b/collects/racket/private/misc.rkt
@@ -11,24 +11,26 @@
 
   (define-syntax define-syntax-rule
     (lambda (stx)
-      (syntax-case stx ()
-        [(dr (name . pattern) template)
-         (identifier? #'name)
-         (syntax/loc stx
-           (define-syntax name
-             (lambda (user)
-               (syntax-case** dr #t user () free-identifier=?
-                              [(_ . pattern) (syntax/loc user template)]
-                              [else (raise-syntax-error #f (format "`~a' did not match pattern `~a'" (cdr (syntax->datum user)) 'pattern) user)]
-                              ))))]
-        [(dr (name . pattern) template)
-         (raise-syntax-error 'define-syntax-rule "expected an identifier" stx #'name)]
-        [(dr (name . pattern))
-         (raise-syntax-error 'define-syntax-rule "no template provided" stx)]
-        [(dr (name . pattern) template . etc)
-         (raise-syntax-error 'define-syntax-rule "too many templates" stx #'etc)]
-        [(dr head . template)
-         (raise-syntax-error 'define-syntax-rule "invalid pattern" stx #'head)])))
+      (let-values ([(err) (lambda (what . xs)
+                            (apply raise-syntax-error
+                                   'define-syntax-rule what stx xs))])
+        (syntax-case stx ()
+          [(dr (name . pattern) template)
+           (identifier? #'name)
+           (syntax/loc stx
+             (define-syntax name
+               (lambda (user-stx)
+                 (syntax-case** dr #t user-stx () free-identifier=?
+                   [(_ . pattern) (syntax/loc user-stx template)]
+                   [_ (let*-values ([(sexpr) (syntax->datum user-stx)]
+                                    [(msg) (format
+                                            "~.s did not match pattern ~.s"
+                                            sexpr (cons (car sexpr) 'pattern))])
+                           (raise-syntax-error #f msg user-stx))]))))]
+          [(_ (name . ptrn) tmpl)         (err "expected an identifier" #'name)]
+          [(_ (name . ptrn))              (err "missing template")]
+          [(_ (name . ptrn) tmpl etc . _) (err "too many forms" #'etc)]
+          [(_ head . _)                   (err "invalid pattern" #'head)]))))
 
   ;; -------------------------------------------------------------------------