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

reformatting

Browse Source
This commit is contained in:
Sam Tobin-Hochstadt 2006-09-01 16:52:45 -04:00
parent dd4c63ab07
commit 9e17a6d993
1 changed files with 50 additions and 50 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

92
collects/mzlib/private/match/match-internal-func.ss
View File

@ -65,57 +65,57 @@
((_ ([pat exp] rest ...) body ...)
(if (pattern-var? (syntax pat))
#'(let ([pat exp])
(match-let* (rest ...) body ...))
(match-let* (rest ...) body ...))
#'(match exp [pat (match-let* (rest ...) body ...)]))
)))
(define-syntax (match-letrec stx)
(syntax-case stx ()
[(_ (clauses ...)) (match:syntax-err stx "bad syntax (empty body)")]
[(_ ([pat exp] ...) . body)
(andmap pattern-var?
(syntax->list #'(pat ...)))
#'(letrec ([pat exp] ...) . body)]
[(_ ([pat exp] ...) . body)
(let* ((**match-bound-vars** '())
(compiled-match
(gen-match #'the-exp
'()
#'(((list pat ...) never-used))
stx
(lambda (sf bv)
(set! **match-bound-vars** bv)
#`(begin
#,@(map (lambda (x) #`(set! #,(car x) #,(cdr x)))
(reverse bv))
. body )))))
#`(letrec (#,@(map
(lambda (x) #`(#,(car x) #f))
(reverse **match-bound-vars**))
(the-exp (list exp ...)))
#,compiled-match))]))
(syntax-case stx ()
[(_ (clauses ...)) (match:syntax-err stx "bad syntax (empty body)")]
[(_ ([pat exp] ...) . body)
(andmap pattern-var?
(syntax->list #'(pat ...)))
#'(letrec ([pat exp] ...) . body)]
[(_ ([pat exp] ...) . body)
(let* ((**match-bound-vars** '())
(compiled-match
(gen-match #'the-exp
'()
#'(((list pat ...) never-used))
stx
(lambda (sf bv)
(set! **match-bound-vars** bv)
#`(begin
#,@(map (lambda (x) #`(set! #,(car x) #,(cdr x)))
(reverse bv))
. body )))))
#`(letrec (#,@(map
(lambda (x) #`(#,(car x) #f))
(reverse **match-bound-vars**))
(the-exp (list exp ...)))
#,compiled-match))]))
(define-syntax (match-define stx)
(syntax-case stx ()
[(_ pat exp)
(identifier? #'pat)
#'(define pat exp)]
[(_ pat exp)
(let* ((**match-bound-vars** '())
(compiled-match
(gen-match #'the-exp
'()
#'((pat never-used))
stx
(lambda (sf bv)
(set! **match-bound-vars** bv)
#`(begin
#,@(map (lambda (x)
#`(set! #,(car x) #,(cdr x)))
(reverse bv)))))))
#`(begin #,@(map
(lambda (x) #`(define #,(car x) #f))
(reverse **match-bound-vars**))
(let ((the-exp exp))
#,compiled-match)))]))
[(_ pat exp)
(identifier? #'pat)
#'(define pat exp)]
[(_ pat exp)
(let* ([**match-bound-vars** '()]
[compiled-match
(gen-match #'the-exp
'()
#'((pat never-used))
stx
(lambda (sf bv)
(set! **match-bound-vars** bv)
#`(begin
#,@(map (lambda (x)
#`(set! #,(car x) #,(cdr x)))
(reverse bv)))))])
#`(begin #,@(map
(lambda (x) #`(define #,(car x) #f))
(reverse **match-bound-vars**))
(let ((the-exp exp))
#,compiled-match)))]))
)