From 370c4bdce240da5fa5513ae575335d5c548f58cc Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Wed, 18 Dec 2013 12:58:37 -0600 Subject: [PATCH] fix any-wrap/c for promises --- .../typed-racket/utils/any-wrap.rkt | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/any-wrap.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/any-wrap.rkt index 0c3b83d8c8..75f2b2f45d 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/any-wrap.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/utils/any-wrap.rkt @@ -1,7 +1,10 @@ #lang racket/base (require racket/match racket/contract/base racket/contract/combinator - racket/promise racket/set) + racket/set + (only-in (combine-in racket/private/promise) + promise? + prop:force promise-forcer)) (define undef (letrec ([x x]) x)) @@ -97,9 +100,15 @@ [_ (fail neg-party v)])) (chaperone-procedure v (lambda args (fail neg-party v))))] [(? promise?) - ;; for promises, just apply Any in the promise - (contract (promise/c any-wrap/c) v - (blame-positive b) (blame-negative b))] + (chaperone-struct + v + promise-forcer + (λ (_ proc) + (chaperone-procedure + proc + (λ (promise) + (values (λ (val) (any-wrap/traverse neg-party val)) + promise)))))] [_ (fail neg-party v)])) (λ (v) (λ (neg-party) (any-wrap/traverse neg-party v))))