diff --git a/collects/tests/typed-scheme/fail/multi-arr-parse.rkt b/collects/tests/typed-scheme/fail/multi-arr-parse.rkt new file mode 100644 index 0000000000..bd9cdbd917 --- /dev/null +++ b/collects/tests/typed-scheme/fail/multi-arr-parse.rkt @@ -0,0 +1,6 @@ +#; +(exn-pred 1 ".*once in a form.*") +#lang typed/scheme + +(: foo : (Integer -> Integer -> Integer)) +(define foo 1) diff --git a/collects/typed-scheme/private/parse-type.rkt b/collects/typed-scheme/private/parse-type.rkt index ee9cd9dda6..509c6acf8c 100644 --- a/collects/typed-scheme/private/parse-type.rkt +++ b/collects/typed-scheme/private/parse-type.rkt @@ -204,6 +204,12 @@ (add-type-name-reference #'kw) (-Param (parse-type #'t1) (parse-type #'t2))] ;; function types + ;; handle this error first: + [((~or dom (~between (~and kw t:->) 2 +inf.0)) ...) + (for ([k (syntax->list #'(kw ...))]) (add-type-name-reference k)) + (tc-error/stx (syntax->list #'(kw ...)) + "The -> type constructor may be used only once in a form") + Err] [(dom (~and kw t:->) rng : ~! latent:latent-filter) (add-type-name-reference #'kw) ;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty @@ -247,11 +253,14 @@ ;; use expr to rule out keywords [(dom:expr ... kws:keyword-tys ... (~and kw t:->) rng) (add-type-name-reference #'kw) - (make-Function - (list (make-arr - (map parse-type (syntax->list #'(dom ...))) - (parse-values-type #'rng) - #:kws (attribute kws.Keyword))))] + (let ([doms (for/list ([d (syntax->list #'(dom ...))]) + (let ([dt (parse-type d)]) + (if (type-equal? dt Err) Univ dt)))]) + (make-Function + (list (make-arr + doms + (parse-values-type #'rng) + #:kws (attribute kws.Keyword)))))] [id:identifier (cond