From fa857a40acbb475ca2c2ab3b40d02c547d798129 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Thu, 31 Jul 2008 19:26:46 +0000 Subject: [PATCH] Allow ... rest variables to be used as lists. Bind Values as a type. svn: r11010 --- collects/typed-scheme/private/base-types.ss | 2 +- collects/typed-scheme/private/lexical-env.ss | 10 ++++++---- 2 files changed, 7 insertions(+), 5 deletions(-) diff --git a/collects/typed-scheme/private/base-types.ss b/collects/typed-scheme/private/base-types.ss index 1790b12bb8..c36c4ca1e7 100644 --- a/collects/typed-scheme/private/base-types.ss +++ b/collects/typed-scheme/private/base-types.ss @@ -82,7 +82,7 @@ -> U mu Un All Opaque Vectorof - Parameter Tuple Class + Parameter Tuple Class Values ) (provide-extra-tnames) diff --git a/collects/typed-scheme/private/lexical-env.ss b/collects/typed-scheme/private/lexical-env.ss index 79b9a47a16..e5946a3126 100644 --- a/collects/typed-scheme/private/lexical-env.ss +++ b/collects/typed-scheme/private/lexical-env.ss @@ -1,6 +1,6 @@ #lang scheme/base -(require "type-environments.ss" "tc-utils.ss" "type-env.ss" "mutated-vars.ss" "type-utils.ss") +(require "type-environments.ss" "tc-utils.ss" "type-env.ss" "mutated-vars.ss" "type-utils.ss" "type-effect-convenience.ss") (provide (all-defined-out)) @@ -23,9 +23,11 @@ (lookup (lexical-env) i (lambda (i) (lookup-type i (lambda () - (if (lookup (dotted-env) i (lambda _ #f)) - (tc-error/expr "Rest variable ~a with ... type used in an inappropriate context" (syntax-e i)) - (lookup-fail (syntax-e i)))))))) + (cond [(lookup (dotted-env) i (lambda _ #f)) + => + (lambda (a) + (-lst (substitute Univ (cdr a) (car a))))] + [else (lookup-fail (syntax-e i))])))))) ;; refine the type of i in the lexical env ;; (identifier type -> type) identifier -> environment