From 8decf99f34fe326f280732c9d8d0fc7c559ebb93 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sat, 9 Jul 2011 06:32:41 -0600 Subject: [PATCH] move error reporting out of `define-syntax-rule' expansion --- collects/racket/private/misc.rkt | 26 ++++++++++++++------------ 1 file changed, 14 insertions(+), 12 deletions(-) diff --git a/collects/racket/private/misc.rkt b/collects/racket/private/misc.rkt index ccf6ca0fbe..aa07c8a34f 100644 --- a/collects/racket/private/misc.rkt +++ b/collects/racket/private/misc.rkt @@ -9,6 +9,19 @@ ;; ------------------------------------------------------------------------- + (define-for-syntax (pattern-failure user-stx pattern) + (let*-values ([(sexpr) (syntax->datum user-stx)] + [(msg) + (if (pair? sexpr) + (format "use does not match pattern: ~.s" + (cons (car sexpr) pattern)) + (if (symbol? sexpr) + (format "use does not match pattern: ~.s" + (cons sexpr pattern)) + (error 'internal-error + "something bad happened")))]) + (raise-syntax-error #f msg user-stx))) + (define-syntax define-syntax-rule (lambda (stx) (let-values ([(err) (lambda (what . xs) @@ -22,18 +35,7 @@ (lambda (user-stx) (syntax-case** dr #t user-stx () free-identifier=? [(_ . pattern) (syntax-protect (syntax/loc user-stx template))] - [_ (let*-values - ([(sexpr) (syntax->datum user-stx)] - [(msg) - (if (pair? sexpr) - (format "use does not match pattern: ~.s" - (cons (car sexpr) 'pattern)) - (if (symbol? sexpr) - (format "use does not match pattern: ~.s" - (cons sexpr 'pattern)) - (error 'internal-error - "something bad happened")))]) - (raise-syntax-error #f msg user-stx))]))))] + [_ (pattern-failure user-stx 'pattern)]))))] [(_ (name . ptrn) tmpl) (err "expected an identifier" #'name)] [(_ (name . ptrn)) (err "missing template")] [(_ (name . ptrn) tmpl etc . _) (err "too many forms" #'etc)]