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

Change how contracts for multiple values are handled to be a little cleaner

Browse Source 
syntactically.

svn: r18458
This commit is contained in:
Stevie Strickland 2010-03-04 00:04:07 +00:00
parent f2788561d3
commit 5fe0a790c1
3 changed files with 20 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/scheme/contract/regions.ss
View File

@ -463,16 +463,14 @@
#:fail-when (check-duplicate-identifier (syntax->list #'(var ...)))
(format "duplicate exported name ~a"
(syntax-e (check-duplicate-identifier (syntax->list #'(var ...)))))])
(define-splicing-syntax-class result-clause
#:description "a results clause"
[pattern (~seq #:result ctc:expr)])
(define-splicing-syntax-class rcs
(define-splicing-syntax-class results-clause
#:attributes ([ctc 1])
#:description "a non-empty sequence of result clauses"
[pattern (~seq rc:result-clause ...+)
#:with (ctc ...) #'(rc.ctc ...)])
#:description "a results clause"
[pattern (~seq #:result c:expr)
#:with (ctc ...) #'(c)]
[pattern (~seq #:results (ctc:expr ...))])
(syntax-parse stx
[(_ (~optional :region-clause #:defaults ([region #'region])) blame:id rc:rcs fv:fvs . body)
[(_ (~optional :region-clause #:defaults ([region #'region])) blame:id rc:results-clause fv:fvs . body)
(if (not (eq? (syntax-local-context) 'expression))
(quasisyntax/loc stx (#%expression #,stx))
(let*-values ([(intdef) (syntax-local-make-definition-context)]

11
collects/scribblings/reference/contracts.scrbl
View File

@ -745,11 +745,12 @@ ensure that the exported functions are treated parametrically.
@defform*/subs[
[(with-contract blame-id (wc-export ...) free-var-list ... body ...+)
(with-contract blame-id result-spec ...+ free-var-list ... body ...+)]
(with-contract blame-id results-spec free-var-list ... body ...+)]
([wc-export
(id contract-expr)]
[result-spec
(code:line #:result contract-expr)]
(code:line #:result contract-expr)
(code:line #:results (contract-expr ...))]
[free-var-list
(code:line #:freevars ([id contract-expr] ...))
(code:line #:freevar id contract-expr)])]{
@ -763,9 +764,9 @@ the form allows definition/expression interleaving if its context does.
The second @scheme[with-contract] form must appear in expression position.
The final @scheme[body] expression should return the same number of values
as the number of @scheme[result-spec]s, and each returned value is contracted
with the contract listed in its respective @scheme[result-spec].
The sequence of @scheme[body] forms is treated as for @scheme[let].
as the number of contracts listed in the @scheme[result-spec], and each
returned value is contracted with its respective contract. The sequence
of @scheme[body] forms is treated as for @scheme[let].
The @scheme[blame-id] is used for the positive positions of
contracts paired with exported @scheme[id]s. Contracts broken

14
collects/tests/mzscheme/contract-test.ss
View File

@ -3045,20 +3045,23 @@
(λ (x) 5))
#t)
"top-level")
(test/spec-passed
'with-contract-exp-values-1
'(let-values ([() (with-contract r #:results () (values))])
1))
(test/spec-passed
'with-contract-exp-values-1
'(let-values ([(x y) (with-contract r
#:result number?
#:result string?
#:results (number? string?)
(values 3 "foo"))])
1))
(test/spec-failed
'with-contract-exp-values-2
'(let-values ([(x y) (with-contract r
#:result number?
#:result string?
#:results (number? string?)
(values "bar" "foo"))])
1)
"(region r)")
@ -3066,8 +3069,7 @@
(test/spec-passed
'with-contract-exp-values-3
'(let-values ([(x y) (with-contract r
#:result number?
#:result string?
#:results (number? string?)
(define (f) (values 3 "foo"))
(f))])
1))