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

Correct with-type so it handles result types of the form (values t ...).

Browse Source 
svn: r18531

original commit: 7b831e86a6e70edafb2993f3169d891d27fa5d77
This commit is contained in:
Stevie Strickland 2010-03-14 02:32:20 +00:00
parent 0a828f2262
commit 78214ab410
4 changed files with 36 additions and 11 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
collects/tests/typed-scheme/fail/with-type3.ss Normal file
View File

@ -0,0 +1,12 @@
#;
(exn-pred exn:fail:contract?)
#lang scheme
(require typed/scheme)
(define-values (a b)
(with-type
#:result (values String (Number -> Number))
(values "foo" (lambda (x) x))))
(b a)

4
collects/tests/typed-scheme/succeed/with-type.ss
View File

@ -8,6 +8,10 @@
#:freevars ([x String])
(string-append x ", world")))
(define-values (a b)
(with-type #:result (values Number String)
(values 3 "foo")))
(with-type ([fun (Number -> Number)]
[val Number])
(define (fun x) x)

25
collects/typed-scheme/private/with-types.ss
View File

@ -46,13 +46,20 @@
(lambda () (tc-error/stx stx "Type ~a could not be converted to a contract." t)))))
(define region-tc-result
(and expr? (parse-tc-results resty)))
(define region-cnt
(and region-tc-result
(match region-tc-result
[(tc-result1: t) (type->contract
t
#:typed-side #t
(lambda () (tc-error/stx #'region-ty-stx "Type ~a could not be converted to a contract." t)))])))
(define region-cnts
(if region-tc-result
(match region-tc-result
[(tc-result1: t)
(list (type->contract
t
#:typed-side #t
(lambda () (tc-error/stx #'region-ty-stx "Type ~a could not be converted to a contract." t))))]
[(tc-results: ts)
(for/list ([t (in-list ts)])
(type->contract
t #:typed-side #t
(lambda () (tc-error/stx #'region-ty-stx "Type ~a could not be converted to a contract." t))))])
null))
(for ([i (in-list (syntax->list fvids))]
[ty (in-list fv-types)])
(register-type i ty))
@ -98,14 +105,14 @@
[(cnt ...) fv-cnts]
[(ex-id ...) exids]
[(ex-cnt ...) ex-cnts]
[region-cnt region-cnt]
[(region-cnt ...) region-cnts]
[body expanded-body]
[check-syntax-help (syntax-property #'(void) 'disappeared-use (type-name-references))])
(if expr?
(quasisyntax/loc stx
(begin check-syntax-help
(with-contract typed-region
#:result region-cnt
#:results (region-cnt ...)
#:freevars ([fv.id cnt] ...)
body)))
(syntax/loc stx

6
collects/typed-scheme/scribblings/ts-reference.scrbl
View File

@ -349,8 +349,10 @@ The @scheme[with-type] for allows for localized Typed Scheme regions in otherwis
(code:line #:freevars ([id fv-type] ...))]
[result-spec (code:line #:result type)]
[export-spec ([export-id export-type] ...)])]{
The first form, an expression, checks that @scheme[body ...+] has the type @scheme[type].
Uses of the result value are appropriately checked by a contract generated from
The first form, an expression, checks that @scheme[body ...+] has the type @scheme[type].
If the last expression in @scheme[body ...+] returns multiple values, @scheme[type] must
be a type of the form @scheme[(values t ...)].
Uses of the result values are appropriately checked by contracts generated from
@scheme[type].
The second form, which can be used as a definition, checks that each of the @scheme[export-id]s