make-Values now checks its argument for having only 1 element

collects/typed-scheme/private/tc-app-unit.ss

@@ -540,7 +540,7 @@
     [(#%plain-app values arg) (tc-expr #'arg)]
     [(#%plain-app values . args)
      (let ([tys (map tc-expr/t (syntax->list #'args))])
-       (ret (list->values-ty tys)))]
+       (ret (-values tys)))]
     ;; special case for `list'
     [(#%plain-app list . args)
      (let ([tys (map tc-expr/t (syntax->list #'args))])

collects/typed-scheme/private/tc-let-unit.ss

@@ -33,7 +33,7 @@
    (for-each expr->type
              clauses
              exprs 
-             (map list->values-ty types))
+             (map -values types))
    (if expected 
        (tc-exprs/check (syntax->list body) expected)
        (tc-exprs (syntax->list body)))))

collects/typed-scheme/private/tc-toplevel.ss

@@ -154,7 +154,7 @@
       [(define-values (var ...) expr)
        (let* ([vars (syntax->list #'(var ...))]
               [ts (map lookup-type vars)])
-         (tc-expr/check #'expr (list->values-ty ts)))
+         (tc-expr/check #'expr (-values ts)))
        (void)]
       
       ;; to handle the top-level, we have to recur into begins

collects/typed-scheme/private/type-effect-convenience.ss

@@ -140,12 +140,6 @@
 
 (define -values make-Values)
 
-;; produce the appropriate type of a list of types
-;; that is - if there is exactly one type, just produce it, otherwise produce a values-ty
-;; list[type] -> type
-(define (list->values-ty l)
-  (if (= 1 (length l)) (car l) (-values l)))
-
 (define-syntax *Un
   (syntax-rules ()
     [(_ . args) (make-Union (list . args))]))

collects/typed-scheme/private/type-rep.ss

@@ -143,8 +143,10 @@
 (dt Univ () [#:frees #f] [#:fold-rhs #:base])
 
 ;; types : Listof[Type]
-(dt Values (types) [#:frees (combine-frees (map free-vars* types))
-                            (combine-frees (map free-idxs* types))]
+(dt Values (types) 
+    #:no-provide
+    [#:frees (combine-frees (map free-vars* types))
+             (combine-frees (map free-idxs* types))]
     [#:fold-rhs (*Values (map type-rec-id types))])
 
 (dt ValuesDots (types dty dbound) 
@@ -515,6 +517,11 @@
         [(type<? s t) 1]
         [else -1]))
 
+(define (Values* l)
+  (if (and (pair? l) (null? (cdr l)))
+      (car l)
+      (*Values l)))
+
 ;(trace subst subst-all)
 
 (provide
@@ -532,6 +539,8 @@
  type-equal? type-compare type<?
  remove-dups
  sub-eff
+ Values: Values? Values-types
+ (rename-out [Values* make-Values])
  (rename-out [Mu:* Mu:]               
              [Poly:* Poly:]
              [PolyDots:* PolyDots:]

collects/typed-scheme/private/type-utils.ss

@@ -56,12 +56,6 @@
                                  (make-ValuesDots (map sb types) (sb dty) dbound))])
       target))
 
-;; the other definition is not accessible here
-(define (-values args)
-  (if (= (length args) 1)
-      (car args)
-      (make-Values args)))
-
 ;; substitute-dots : Listof[Type] Option[type] Name Type -> Type
 (define (substitute-dots images rimage name target)    
   (define (sb t) (substitute-dots images rimage name t))
@@ -69,7 +63,7 @@
       (type-case sb target
                  [#:ValuesDots types dty dbound
                                (if (eq? name dbound)
-                                   (-values
+                                   (make-Values
                                     (append 
                                      (map sb types)
                                      ;; We need to recur first, just to expand out any dotted usages of this.