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

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

@ -11,24 +11,26 @@
(define-syntax define-syntax-rule
(lambda (stx)
(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)
(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)])))
(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)]))))
;; -------------------------------------------------------------------------