suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Fix error messages.

Browse Source 
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")
This commit is contained in:
Eli Barzilay 2010-11-09 23:27:27 -05:00
parent d7369f819c
commit f2af8fa380
1 changed files with 20 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
collects/racket/private/misc.rkt
View File

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