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

allow internal definitions in when', unless', cond, case', `match'

Browse Source
This commit is contained in:
Matthew Flatt 2010-10-12 05:55:16 -06:00
parent 5e162d94e2
commit 99df8e1267
9 changed files with 49 additions and 59 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
collects/racket/match/gen-match.rkt
View File

@ -58,7 +58,7 @@
(let ([mk (lambda (unm rhs)
(make-Row (for/list ([p (syntax->list pats)])
(parse/cert p cert))
#`(begin . #,rhs) unm null))])
#`(let-values () . #,rhs) unm null))])
(syntax-case* rhs (=>)
(lambda (x y) (eq? (syntax-e x) (syntax-e y)))
[((=> unm) . rhs) (mk #'unm #'rhs)]

8
collects/racket/private/cond.rkt
View File

@ -67,18 +67,14 @@
(serror
"missing expressions in `else' clause"
line)
(if first?
;; first => be careful not to introduce a splicable begin...
`(,(quote-syntax if) #t ,(cons (quote-syntax begin) value) (void))
;; we're in an `if' branch already...
(cons (quote-syntax begin) value)))
(list* (quote-syntax let-values) (quote-syntax ()) value))
(if (stx-null? value)
(let ([gen (gen-temp-id 'c)])
`(,(quote-syntax let-values) ([(,gen) ,test])
(,(quote-syntax if) ,gen ,gen ,(loop rest #f))))
(list
(quote-syntax if) test
(cons (quote-syntax begin) value)
(list* (quote-syntax let-values) (quote-syntax ()) value)
(loop rest #f))))))))))))
in-form)))])
(values

6
collects/racket/private/define-et-al.rkt
View File

@ -41,7 +41,8 @@
(list (quote-syntax if)
(stx-car (stx-cdr x))
(list*
(quote-syntax begin)
(quote-syntax let-values)
(quote-syntax ())
(stx-cdr (stx-cdr x)))
(quote-syntax (void)))
x)
@ -61,7 +62,8 @@
(cadr l)
(quote-syntax (void))
(list*
(quote-syntax begin)
(quote-syntax let-values)
(quote-syntax ())
(cddr l)))
x)
(raise-syntax-error

25
collects/racket/private/more-scheme.rkt
View File

@ -27,13 +27,13 @@
((_ v)
(syntax (#%expression (begin v (void)))))
((_ v (else e1 e2 ...))
(syntax/loc x (#%expression (begin v e1 e2 ...))))
(syntax/loc x (#%expression (begin v (let-values () e1 e2 ...)))))
((_ v ((k ...) e1 e2 ...))
(syntax/loc x (if (case-test v (k ...)) (begin e1 e2 ...) (void))))
(syntax/loc x (if (case-test v (k ...)) (let-values () e1 e2 ...) (void))))
((self v ((k ...) e1 e2 ...) c1 c2 ...)
(syntax/loc x (let ((x v))
(if (case-test x (k ...))
(begin e1 e2 ...)
(let-values () e1 e2 ...)
(self x c1 c2 ...)))))
((_ v (bad e1 e2 ...) . rest)
(raise-syntax-error
@ -74,20 +74,11 @@
orig-x))))
(syntax->list (syntax (var ...)))
(syntax->list (syntax (step ...))))))
(syntax-case (syntax (e1 ...)) ()
(() (syntax/loc
orig-x
(let doloop ((var init) ...)
(if e0
(void)
(begin c ... (doloop step ...))))))
((e1 e2 ...)
(syntax/loc
orig-x
(let doloop ((var init) ...)
(if e0
(begin e1 e2 ...)
(begin c ... (doloop step ...))))))))))))
(syntax/loc orig-x
(let doloop ((var init) ...)
(if e0
(begin (void) e1 ...)
(begin c ... (doloop step ...))))))))))
(define-syntax parameterize
(lambda (stx)

2
collects/scribblings/reference/for.scrbl
View File

@ -339,7 +339,7 @@ parallel iterations.}
@defform/subs[(do ([id init-expr step-expr-maybe] ...)
(stop?-expr finish-expr ...)
expr ...+)
expr ...)
([step-expr-maybe code:blank
step-expr])]{

16
collects/scribblings/reference/match.scrbl
View File

@ -17,12 +17,12 @@ on regular-expression matching on strings, bytes, and streams.
@note-lib[racket/match #:use-sources (racket/match)]
@defform/subs[(match val-expr clause ...)
([clause [pat expr ...+]
[pat (=> id) expr ...+]])]{
([clause [pat body ...+]
[pat (=> id) body ...+]])]{
Finds the first @racket[pat] that matches the result of
@racket[val-expr], and evaluates the corresponding @racket[expr]s with
bindings introduced by @racket[pat] (if any). The last @racket[expr]
@racket[val-expr], and evaluates the corresponding @racket[body]s with
bindings introduced by @racket[pat] (if any). The last @racket[body]
in the matching clause is evaluated in tail position with respect to
the @racket[match] expression.
@ -30,10 +30,10 @@ The @racket[clause]s are tried in order to find a match. If no
@racket[clause] matches, then the @exnraise[exn:misc:match?].
An optional @racket[(=> id)] between a @racket[pat] and the
@racket[expr]s is bound to a @defterm{failure procedure} of zero
@racket[body]s is bound to a @defterm{failure procedure} of zero
arguments. If this procedure is invoked, it escapes back to the
pattern matching expression, and resumes the matching process as if
the pattern had failed to match. The @racket[expr]s must not mutate
the pattern had failed to match. The @racket[body]s must not mutate
the object being matched before calling the failure procedure,
otherwise the behavior of matching is unpredictable.
@ -358,8 +358,8 @@ In more detail, patterns match as follows:
@section{Additional Matching Forms}
@defform/subs[(match* (val-expr ...+) clause* ...)
([clause* [(pat ...+) expr ...+]
[(pat ...+) (=> id) expr ...+]])]{
([clause* [(pat ...+) body ...+]
[(pat ...+) (=> id) body ...+]])]{
Matches a sequence of values against each clause in order, matching
only when all patterns in a clause match. Each clause must have the
same number of patterns as the number of @racket[val-expr]s.

34
collects/scribblings/reference/syntax.scrbl
View File

@ -1738,8 +1738,8 @@ position with respect to the @racket[if] form.
@defform/subs[#:literals (else =>)
(cond cond-clause ...)
([cond-clause [test-expr then-expr ...+]
[else then-expr ...+]
([cond-clause [test-expr then-body ...+]
[else then-body ...+]
[test-expr => proc-expr]
[test-expr]])]{
@ -1750,10 +1750,10 @@ A @racket[cond-clause] that starts with @racket[else] must be the last
If no @racket[cond-clause]s are present, the result is @|void-const|.
If only a @racket[[else then-expr ...+]] is present, then the
@racket[then-expr]s are evaluated. The results from all but the last
@racket[then-expr] are ignored. The results of the last
@racket[then-expr], which is in tail position with respect to the
If only a @racket[[else then-body ...+]] is present, then the
@racket[then-body]s are evaluated. The results from all but the last
@racket[then-body] are ignored. The results of the last
@racket[then-body], which is in tail position with respect to the
@racket[cond] form, are the results for the whole @racket[cond]
form.
@ -1763,10 +1763,10 @@ the remaining @racket[cond-clause]s, in tail position with respect to
the original @racket[cond] form. Otherwise, evaluation depends on the
form of the @racket[cond-clause]:
@specsubform[[test-expr then-expr ...+]]{The @racket[then-expr]s are
@specsubform[[test-expr then-body ...+]]{The @racket[then-body]s are
evaluated in order, and the results from all but the last
@racket[then-expr] are ignored. The results of the last
@racket[then-expr], which is in tail position with respect to the
@racket[then-body] are ignored. The results of the last
@racket[then-body], which is in tail position with respect to the
@racket[cond] form, provides the result for the whole @racket[cond]
form.}
@ -1860,8 +1860,8 @@ position with respect to the original @racket[or] form.
@defform/subs[#:literals (else)
(case val-expr case-clause ...)
([case-clause [(datum ...) then-expr ...+]
[else then-expr ...+]])]{
([case-clause [(datum ...) then-body ...+]
[else then-body ...+]])]{
Evaluates @racket[val-expr] and uses the result to select a
@racket[case-clause]. The selected clause is the first one with a
@ -1872,7 +1872,7 @@ result of @racket[val-expr]. If no such @racket[datum] is present, the
@racket[case] form is @|void-const|.
For the selected @racket[case-clause], the results of the last
@racket[then-expr], which is in tail position with respect to the
@racket[then-body], which is in tail position with respect to the
@racket[case] form, are the results for the whole @racket[case] form.
A @racket[case-clause] that starts with @racket[else] must be the last
@ -2202,12 +2202,12 @@ classifications:
@guideintro["when+unless"]{@racket[when] and @racket[unless]}
@defform[(when test-expr expr ...)]{
@defform[(when test-expr body ...+)]{
Evaluates @racket[test-expr]. If the result is @racket[#f], then
the result of the @racket[when] expression is
@|void-const|. Otherwise, the @racket[expr]s are evaluated, and the
last @racket[expr] is in tail position with respect to the
@|void-const|. Otherwise, the @racket[body]s are evaluated, and the
last @racket[body] is in tail position with respect to the
@racket[when] form.
@mz-examples[
@ -2218,9 +2218,9 @@ last @racket[expr] is in tail position with respect to the
(display " there"))
]}
@defform[(unless test-expr expr ...)]{
@defform[(unless test-expr body ...+)]{
Equivalent to @racket[(when (not test-expr) expr ...)].
Equivalent to @racket[(when (not test-expr) body ...+)].
@mz-examples[
(unless (positive? 5)

13
collects/tests/racket/syntax.rktl
View File

@ -526,12 +526,12 @@
(with-handlers () ,@body)))
(teval `(test ,val 'with-handlers-begin
(with-handlers ([void void]) ,@body)))
(syntax-test (datum->syntax #f `(when (positive? 1) ,@body) #f))
(syntax-test (datum->syntax #f `(unless (positive? -1) ,@body) #f))
(syntax-test (datum->syntax #f `(cond [(positive? 1) ,@body][else #f]) #f))
(syntax-test (datum->syntax #f `(cond [(positive? -1) 0][else ,@body]) #f))
(syntax-test (datum->syntax #f `(case (positive? 1) [(#t) ,@body][else -12]) #f))
(syntax-test (datum->syntax #f `(cond [#t ,@body]) #f))
(teval `(test ,val 'when-begin (when (positive? 1) ,@body)))
(teval `(test ,val 'unless-begin (unless (positive? -1) ,@body)))
(teval `(test ,val 'cons-begin (cond [(positive? 1) ,@body][else #f])))
(teval `(test ,val 'cons-else-begin (cond [(positive? -1) 0][else ,@body])))
(teval `(test ,val 'case-begin (case (positive? 1) [(#t) ,@body][else -12])))
(teval `(test ,val 'cond-only-begin (cond [#t ,@body])))
(syntax-test (datum->syntax #f `(do ((x 1)) (#t ,@body) ,@body) #f))
(syntax-test (datum->syntax #f `(begin0 12 ,@body) #f)))])
(wrap 5 '((begin (define x 5)) x))
@ -791,7 +791,6 @@
(syntax-test #'(lambda () (void (define x 2)) 1))
(syntax-test #'(cond [(< 2 3) (define x 2)] [else 5]))
(syntax-test #'(cond [else (define x 2)]))
(syntax-test #'(cond [else (define x 2) 0]))
;; No good way to test in mzc:
(error-test #'(define x (values)) exn:application:arity?)

2
doc/release-notes/racket/HISTORY.txt
View File

@ -1,4 +1,6 @@
Version 5.0.1.8
Changed body of `when', `unless', `cond' clauses, `case'
clauses, and `match' clauses to be internal-definition contexts
Added #true and #false, and changed #t/#T and #f/#F to
require a delimiter afterward
Added print-boolean-long-form