clean up `define-syntax-rules'

by removing a redundant expression in an error message, adding
 tests, and documenting the fact that a syntax-error message can
 expose the pattern source to users
This commit is contained in:
Matthew Flatt 2011-02-11 09:51:24 -07:00
parent 8c0d19fb12
commit 0840430b21
3 changed files with 27 additions and 4 deletions

View File

@ -26,10 +26,10 @@
([(sexpr) (syntax->datum user-stx)] ([(sexpr) (syntax->datum user-stx)]
[(msg) [(msg)
(if (pair? sexpr) (if (pair? sexpr)
(format "~.s did not match pattern ~.s" (format "use does not match pattern: ~.s"
sexpr (cons (car sexpr) 'pattern)) (cons (car sexpr) 'pattern))
(if (symbol? sexpr) (if (symbol? sexpr)
(format "must be used in a pattern ~.s" (format "use does not match pattern: ~.s"
(cons sexpr 'pattern)) (cons sexpr 'pattern))
(error 'internal-error (error 'internal-error
"something bad happened")))]) "something bad happened")))])

View File

@ -469,7 +469,9 @@ Equivalent to
(syntax-rules () (syntax-rules ()
[(id . pattern) template])) [(id . pattern) template]))
] ]
}
but with syntax errors potentially phrased in terms of
@racket[pattern].}
@defidform[...]{ @defidform[...]{

View File

@ -1456,6 +1456,27 @@
(get-output-bytes s)) (get-output-bytes s))
exn:fail?) exn:fail?)
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; define-syntax-rule
(define-syntax-rule (a-rule-pattern x [y z])
(list 'x 'y 'z))
(test '(1 2 3) 'a-rule (a-rule-pattern 1 [2 3]))
(test '(1 2 3) 'a-rule (a-rule-pattern 1 . ([2 3])))
(test '(1 2 3) 'a-rule (a-rule-pattern 1 [2 . (3)]))
(syntax-test #'a-rule-pattern)
(syntax-test #'(a-rule-pattern 1 2 3))
(syntax-test #'(a-rule-pattern 1 . 2))
(syntax-test #'(a-rule-pattern . 1))
(syntax-test #'(a-rule-pattern 1 [2 3] 4))
(let ([no-match? (lambda (exn)
(regexp-match? #"does not match pattern" (exn-message exn)))])
(error-test #'a-rule-pattern no-match?)
(error-test #'(a-rule-pattern) no-match?)
(error-test #'(a-rule-pattern 1) no-match?))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs) (report-errs)