[racket-dev] [plt] Push #28930: master branch updated

>> --- 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 ***