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

svn: r18531

collects/tests/typed-scheme/fail/with-type3.ss

@@ -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)

collects/tests/typed-scheme/succeed/with-type.ss

@@ -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)

collects/typed-scheme/private/with-types.ss

@@ -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 
+    (define region-cnts 
-      (and region-tc-result
+      (if region-tc-result
-           (match region-tc-result 
+          (match region-tc-result 
-             [(tc-result1: t) (type->contract 
+            [(tc-result1: t)
-                               t 
+             (list (type->contract 
-                               #:typed-side #t
+                    t 
-                               (lambda () (tc-error/stx #'region-ty-stx "Type ~a could not be converted to a 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

collects/typed-scheme/scribblings/ts-reference.scrbl

@@ -350,7 +350,9 @@ The @scheme[with-type] for allows for localized Typed Scheme regions in otherwis
                [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 
+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