diff --git a/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt b/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt index 02995dd4..e666d3ea 100644 --- a/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt +++ b/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt @@ -98,6 +98,8 @@ (-polydots (a) (t:-> (make-ValuesDots (list) a 'a)))] [(case-lambda (Number -> Boolean) (Number Number -> Number)) (cl-> [(N) B] [(N N) N])] + [(case-> (Number -> Boolean) (Number Number -> Number)) (cl-> [(N) B] + [(N N) N])] [1 (-val 1)] [#t (-val #t)] [#f (-val #f)] diff --git a/collects/typed-scheme/private/base-types-extra.rkt b/collects/typed-scheme/private/base-types-extra.rkt index 5e8eef63..022d46b8 100644 --- a/collects/typed-scheme/private/base-types-extra.rkt +++ b/collects/typed-scheme/private/base-types-extra.rkt @@ -12,7 +12,7 @@ ;; special type names that are not bound to particular types (define-other-types - -> U Rec All Opaque Vector + -> case-> U Rec All Opaque Vector Parameterof List List* Class Values Instance Refinement pred) diff --git a/collects/typed-scheme/private/parse-type.rkt b/collects/typed-scheme/private/parse-type.rkt index 6e59d204..905c4ece 100644 --- a/collects/typed-scheme/private/parse-type.rkt +++ b/collects/typed-scheme/private/parse-type.rkt @@ -152,7 +152,7 @@ (parameterize ([current-orig-stx stx]) (syntax-parse stx - #:literals (t:Class t:Refinement t:Instance t:List t:List* cons t:pred t:-> : case-lambda + #:literals (t:Class t:Refinement t:Instance t:List t:List* cons t:pred t:-> : case-lambda t:case-> t:Rec t:U t:All t:Opaque t:Parameter t:Vector quote) [t #:declare t (3d Type?) @@ -202,7 +202,7 @@ [((~and kw t:pred) t) (add-type-name-reference #'kw) (make-pred-ty (parse-type #'t))] - [((~and kw case-lambda) tys ...) + [((~and kw (~or case-lambda t:case->)) tys ...) (add-type-name-reference #'kw) (make-Function (for/list ([ty (syntax->list #'(tys ...))]) diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt index 46475ac2..44c3118c 100644 --- a/collects/typed-scheme/private/prims.rkt +++ b/collects/typed-scheme/private/prims.rkt @@ -30,7 +30,7 @@ This file defines two sorts of primitives. All of them are provided into any mod (require "../utils/require-contract.rkt" "colon.rkt" "../typecheck/internal-forms.rkt" - (rename-in racket/contract [-> c->]) + (rename-in racket/contract [-> c->] [case-> c:case->]) "base-types.rkt" "base-types-extra.rkt" racket/flonum ; for for/flvector and for*/flvector