fix some bugs

svn: r17251
This commit is contained in:
Sam Tobin-Hochstadt 2009-12-09 23:10:37 +00:00
parent a9b36c93ae
commit 8ef5ad42c4

View File

@ -2,6 +2,7 @@
(require (for-syntax scheme/base (require (for-syntax scheme/base
unstable/syntax unstable/syntax
unstable/sequence
syntax/parse syntax/parse
"parse.ss" "parse.ss"
"parse-helper.ss" "parse-helper.ss"
@ -77,18 +78,19 @@
#'(let () body1 body ...)] #'(let () body1 body ...)]
[(_ ([pat exp] rest-pats ...) body1 body ...) [(_ ([pat exp] rest-pats ...) body1 body ...)
#`(match*/derived #`(match*/derived
#,stx
(exp) (exp)
#,stx
[(pat) #,(syntax/loc stx (match-let* (rest-pats ...) body1 body ...))])])) [(pat) #,(syntax/loc stx (match-let* (rest-pats ...) body1 body ...))])]))
(define-syntax (match-letrec stx) (define-syntax (match-letrec stx)
(syntax-parse stx (syntax-parse stx
[(_ ((~and cl [pat exp]) ...) body1 body ...) [(_ ((~and cl [pat exp]) ...) body1 body ...)
(syntax/loc stx (let () (quasisyntax/loc stx
(let ()
#,@(for/list ([c (in-syntax #'(cl ...))] #,@(for/list ([c (in-syntax #'(cl ...))]
[p (in-syntax #'(pat ...))] [p (in-syntax #'(pat ...))]
[e (in-syntax #'(exp ...))]) [e (in-syntax #'(exp ...))])
(syntax/loc c (match-define p e))) (quasisyntax/loc c (match-define #,p #,e)))
body1 body ...))])) body1 body ...))]))
(define-syntax (match-define stx) (define-syntax (match-define stx)