Fix error reporting when first clause is not a list.

Ok for 4.2.

svn: r14965
This commit is contained in:
Sam Tobin-Hochstadt 2009-05-23 23:51:52 +00:00
parent 148d945fbe
commit 1b2013dd73

View File

@ -41,16 +41,19 @@
(syntax-case stx () (syntax-case stx ()
[(k [pats . rhs] ...) [(k [pats . rhs] ...)
(let* ([pss (syntax->list #'(pats ...))] (let* ([pss (syntax->list #'(pats ...))]
[ps1 (car pss)] [ps1 (car pss)])
[len (length (syntax->list ps1))]) (unless (syntax->list ps1)
(for/list ([ps pss]) (raise-syntax-error
(unless (= (length (syntax->list ps)) len) #f "expected a sequence of patterns" stx ps1))
(raise-syntax-error (let ([len (length (syntax->list ps1))])
#f "unequal number of patterns in match clauses" (for/list ([ps pss])
stx ps))) (unless (= (length (syntax->list ps)) len)
(with-syntax ([(vars ...) (generate-temporaries (car pss))]) (raise-syntax-error
(syntax/loc stx #f "unequal number of patterns in match clauses"
(lambda (vars ...) (match* (vars ...) [pats . rhs] ...)))))])) stx ps)))
(with-syntax ([(vars ...) (generate-temporaries (car pss))])
(syntax/loc stx
(lambda (vars ...) (match* (vars ...) [pats . rhs] ...))))))]))
;; there's lots of duplication here to handle named let ;; there's lots of duplication here to handle named let
;; some factoring out would do a lot of good ;; some factoring out would do a lot of good