>> --- >> OLD/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt >> +++ >> NEW/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt >> @@ -6,7 +6,7 @@ >> >> (require "simple.rkt" "structural.rkt" >> (for-template racket/base racket/list racket/set racket/promise >> racket/mpair >> - racket/class)) >> + racket/class racket/async-channel)) >> (provide (all-defined-out)) >> >> (define identifier?/sc (flat/sc #'identifier?)) >> @@ -28,6 +28,7 @@ >> (define empty-hash/sc (and/sc hash?/sc (flat/sc #'(λ (h) (zero? (hash-count >> h)))))) >> >> (define channel?/sc (flat/sc #'channel?)) >> +(define async-channel?/sc (flat/sc #'channel?)) > > Should this be #'async-channel?
Yes, you are right. I'll fix it. Thanks. > > >> (define thread-cell?/sc (flat/sc #'thread-cell?)) >> (define prompt-tag?/sc (flat/sc #'continuation-prompt-tag?)) >> (define continuation-mark-key?/sc (flat/sc #'continuation-mark-key?)) >> >> pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt >> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >> --- OLD/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt >> +++ NEW/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/abbrev.rkt >> @@ -54,6 +54,7 @@ >> (define -Param make-Param) >> (define -box make-Box) >> (define -channel make-Channel) >> +(define -async-channel make-Async-Channel) >> (define -thread-cell make-ThreadCell) >> (define -Promise make-Promise) >> (define -set make-Set) >> @@ -169,6 +170,7 @@ >> (define -HT make-Hashtable) >> (define/decl -BoxTop (make-BoxTop)) >> (define/decl -ChannelTop (make-ChannelTop)) >> +(define/decl -Async-ChannelTop (make-Async-ChannelTop)) >> (define/decl -HashTop (make-HashtableTop)) >> (define/decl -VectorTop (make-VectorTop)) >> (define/decl -MPairTop (make-MPairTop)) >> >> pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt >> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >> --- >> OLD/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt >> +++ >> NEW/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt >> @@ -424,6 +424,7 @@ >> [(StructTop: (Struct: nm _ _ _ _ _)) `(Struct ,(syntax-e nm))] >> [(BoxTop:) 'BoxTop] >> [(ChannelTop:) 'ChannelTop] >> + [(Async-ChannelTop:) 'Async-ChannelTop] >> [(ThreadCellTop:) 'ThreadCellTop] >> [(VectorTop:) 'VectorTop] >> [(HashtableTop:) 'HashTableTop] >> @@ -462,6 +463,7 @@ >> [(Box: e) `(Boxof ,(t->s e))] >> [(Future: e) `(Futureof ,(t->s e))] >> [(Channel: e) `(Channelof ,(t->s e))] >> + [(Async-Channel: e) `(Async-Channelof ,(t->s e))] >> [(ThreadCell: e) `(ThreadCellof ,(t->s e))] >> [(Promise: e) `(Promise ,(t->s e))] >> [(Ephemeron: e) `(Ephemeronof ,(t->s e))] >> >> pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/structural.rkt >> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >> --- >> OLD/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/structural.rkt >> +++ >> NEW/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/structural.rkt >> @@ -32,6 +32,7 @@ >> (define-for-syntax structural-reps >> #'([BoxTop ()] >> [ChannelTop ()] >> + [Async-ChannelTop ()] >> [ClassTop ()] >> [Continuation-Mark-KeyTop ()] >> [Error ()] >> @@ -62,6 +63,7 @@ >> [Continuation-Mark-Keyof (#:inv)] >> [Box (#:inv)] >> [Channel (#:inv)] >> + [Async-Channel (#:inv)] >> [ThreadCell (#:inv)] >> [Vector (#:inv)] >> [Hashtable (#:inv #:inv)] >> >> pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt >> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >> --- >> OLD/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt >> +++ >> NEW/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt >> @@ -510,6 +510,7 @@ >> ;; compared against t* here >> (subtype* A0 s t*)] >> [((Channel: t) (Evt: t*)) (subtype* A0 t t*)] >> + [((Async-Channel: t) (Evt: t*)) (subtype* A0 t t*)] >> ;; Invariant types >> [((Box: s) (Box: t)) (type-equiv? A0 s t)] >> [((Box: _) (BoxTop:)) A0] >> @@ -517,6 +518,8 @@ >> [((ThreadCell: _) (ThreadCellTop:)) A0] >> [((Channel: s) (Channel: t)) (type-equiv? A0 s t)] >> [((Channel: _) (ChannelTop:)) A0] >> + [((Async-Channel: s) (Async-Channel: t)) (type-equiv? A0 s t)] >> + [((Async-Channel: _) (Async-ChannelTop:)) A0] >> [((Vector: s) (Vector: t)) (type-equiv? A0 s t)] >> [((Vector: _) (VectorTop:)) A0] >> [((HeterogeneousVector: _) (VectorTop:)) A0] >> >> pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/async-channel.rkt >> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >> --- /dev/null >> +++ >> NEW/pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/async-channel.rkt >> @@ -0,0 +1,16 @@ >> +#lang s-exp typed-racket/base-env/extra-env-lang >> + >> +;; This module provides a typed version of racket/async-channel >> + >> +(require "private/async-channel-wrapped.rkt" >> + (for-syntax (only-in (rep type-rep) make-Async-ChannelTop))) >> + >> +;; Section 11.2.4 (Buffered Asynchronous Channels) >> +(type-environment >> + [make-async-channel (-poly (a) (->opt [(-opt -PosInt)] (-async-channel >> a)))] >> + [async-channel? (make-pred-ty (make-Async-ChannelTop))] >> + [async-channel-get (-poly (a) ((-async-channel a) . -> . a))] >> + [async-channel-try-get (-poly (a) ((-async-channel a) . -> . (-opt a)))] >> + [async-channel-put (-poly (a) ((-async-channel a) a . -> . -Void))] >> + [async-channel-put-evt (-poly (a) (-> (-async-channel a) a (-mu x (-evt >> x))))]) >> + >> >> pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/private/async-channel-wrapped.rkt >> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >> --- /dev/null >> +++ >> NEW/pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/private/async-channel-wrapped.rkt >> @@ -0,0 +1,24 @@ >> +#lang racket >> +(require (for-syntax racket/syntax)) >> +(require (prefix-in r: racket/async-channel)) >> + >> +;; all the functions from racket/async-channel, but wrapped to hide >> contracts >> + >> +;; create "r:" prefixed identifier >> +(define-for-syntax (r: id) (format-id id "r:~a" id)) >> + >> +;; eta expand to hide contracts >> +(define-syntax (provide/eta stx) >> + (syntax-case stx () >> + [(_ f ...) >> + (with-syntax ([(r:f ...) (map r: (syntax->list #'(f ...)))]) >> + #'(begin >> + (define (f . xs) (apply r:f xs)) ... >> + (provide f ...)))])) >> + >> +(provide/eta async-channel? >> + make-async-channel >> + async-channel-get >> + async-channel-try-get >> + async-channel-put >> + async-channel-put-evt) >> >> pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/async-channel-contract.rkt >> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >> --- /dev/null >> +++ >> NEW/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/async-channel-contract.rkt >> @@ -0,0 +1,19 @@ >> +#; >> +(exn-pred #rx"could not convert type to a contract.*Async-Channelof") >> +#lang racket/load >> + >> +;; Test typed-untyped interaction with channels >> + >> +(module typed typed/racket >> + (require typed/racket/async-channel) >> + (: ch (Async-Channelof (Boxof Integer))) >> + (define ch (make-async-channel)) >> + (: putter (-> Thread)) >> + (define (putter) >> + (thread (λ () (async-channel-put ch (box 3))))) >> + (provide putter ch)) >> + >> +(require 'typed) >> +(putter) >> +(set-box! (async-channel-get ch) "not an integer") >> + >> >> pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/make-top-predicate.rkt >> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ >> --- >> OLD/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/make-top-predicate.rkt >> +++ >> NEW/pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/make-top-predicate.rkt >> @@ -3,6 +3,7 @@ >> (make-predicate VectorTop) >> (make-predicate BoxTop) >> (make-predicate ChannelTop) >> +(make-predicate Async-ChannelTop) >> (make-predicate HashTableTop) >> (make-predicate MPairTop) >> (make-predicate Thread-CellTop) >> >> *** See above for renames and copies *** _________________________ Racket Developers list: http://lists.racket-lang.org/dev