diff --git a/collects/typed-scheme/private/tc-app-unit.ss b/collects/typed-scheme/private/tc-app-unit.ss index 46e3b5108c..9c46a61ffa 100644 --- a/collects/typed-scheme/private/tc-app-unit.ss +++ b/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))]) diff --git a/collects/typed-scheme/private/tc-let-unit.ss b/collects/typed-scheme/private/tc-let-unit.ss index 953eebfd52..eb29285264 100644 --- a/collects/typed-scheme/private/tc-let-unit.ss +++ b/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))))) diff --git a/collects/typed-scheme/private/tc-toplevel.ss b/collects/typed-scheme/private/tc-toplevel.ss index 63e2a82b2d..e5f4fbbc13 100644 --- a/collects/typed-scheme/private/tc-toplevel.ss +++ b/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 diff --git a/collects/typed-scheme/private/type-effect-convenience.ss b/collects/typed-scheme/private/type-effect-convenience.ss index cf76cb5599..6f1667913a 100644 --- a/collects/typed-scheme/private/type-effect-convenience.ss +++ b/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))])) diff --git a/collects/typed-scheme/private/type-rep.ss b/collects/typed-scheme/private/type-rep.ss index 02b59e3f96..06442e2c03 100644 --- a/collects/typed-scheme/private/type-rep.ss +++ b/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 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.