From 09d32d35e06abe31075bf3fbf04f6c749f3d5603 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Wed, 15 Aug 2012 20:51:35 -0700 Subject: [PATCH] Add promise support to type->contract. Closes PR13024. --- collects/tests/typed-racket/unit-tests/contract-tests.rkt | 3 ++- collects/typed-racket/private/type-contract.rkt | 3 +++ 2 files changed, 5 insertions(+), 1 deletion(-) diff --git a/collects/tests/typed-racket/unit-tests/contract-tests.rkt b/collects/tests/typed-racket/unit-tests/contract-tests.rkt index 5f38803f4f..53cefd4602 100644 --- a/collects/tests/typed-racket/unit-tests/contract-tests.rkt +++ b/collects/tests/typed-racket/unit-tests/contract-tests.rkt @@ -12,7 +12,8 @@ (define (contract-tests) (test-suite "Contract Tests" - (t (-Number . -> . -Number)))) + (t (-Number . -> . -Number)) + (t (-Promise -Number)))) (define-go contract-tests) (provide contract-tests) diff --git a/collects/typed-racket/private/type-contract.rkt b/collects/typed-racket/private/type-contract.rkt index 59e9ca0384..7c003e3410 100644 --- a/collects/typed-racket/private/type-contract.rkt +++ b/collects/typed-racket/private/type-contract.rkt @@ -199,6 +199,9 @@ #`(box/c #,(t->c t))] [(Pair: t1 t2) #`(cons/c #,(t->c t1) #,(t->c t2))] + [(Promise: t) + (when flat? (exit (fail))) + #`(promise/c #,(t->c t))] [(Opaque: p? cert) #`(flat-named-contract (quote #,(syntax-e p?)) #,(cert p?))] [(F: v) (cond [(assoc v (vars)) => second]