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

From: Eric Dobson (eric.n.dobson at gmail.com)
Date: Wed Jun 25 00:26:33 EDT 2014

On Tue, Jun 24, 2014 at 3:17 PM,  <stchang at racket-lang.org> wrote:
> stchang has updated `master' from 49ff6d3c84 to 500745f41b.
>   http://git.racket-lang.org/plt/49ff6d3c84..500745f41b
>
> =====[ One Commit ]=====================================================
> Directory summary:
>    7.5% pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/reference/
>    4.6% pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/
>    6.6% pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/
>    7.6% pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/private/
>    7.5% pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/
>    5.0% pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/
>   60.8% pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/
>
> ~~~~~~~~~~
>
> 500745f Stephen Chang <stchang at racket-lang.org> 2014-06-24 18:16
> :
> | add typed/racket/async-channel
> :
>   A pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/async-channel.rkt
>   A pkgs/typed-racket-pkgs/typed-racket-more/typed/racket/private/async-channel-wrapped.rkt
>   A pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/fail/async-channel-contract.rkt
>   C pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/{events.rkt => events-with-async-channel.rkt} (86%)
>   C pkgs/typed-racket-pkgs/typed-racket-test/tests/typed-racket/succeed/{threads-and-channels.rkt => threads-and-async-channels.rkt} (50%)
>   M .../scribblings/reference/libraries.scrbl           |  1 +
>   M .../static-contracts/combinators/derived.rkt        |  3 ++-
>   M .../typed-racket/base-env/base-types.rkt            |  2 ++
>   M .../typed-racket/infer/infer-unit.rkt               |  3 +++
>   M .../typed-racket-lib/typed-racket/rep/type-rep.rkt  |  6 ++++++
>   M .../typed-racket-lib/typed-racket/types/abbrev.rkt  |  2 ++
>   M .../typed-racket-lib/typed-racket/types/printer.rkt |  2 ++
>   M .../typed-racket-lib/typed-racket/types/subtype.rkt |  3 +++
>   M .../typed-racket/private/type-contract.rkt          |  1 +
>   M .../typed-racket/scribblings/reference/types.scrbl  | 18 +++++++++++++++++-
>   M .../typed-racket/succeed/make-top-predicate.rkt     |  1 +
>   M .../typed-racket/types/structural.rkt               |  2 ++
>
> =====[ Overall Diff ]===================================================
>
> pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/reference/libraries.scrbl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/reference/libraries.scrbl
> +++ NEW/pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/reference/libraries.scrbl
> @@ -71,6 +71,7 @@ The following libraries are included with Typed Racket in the
>  @defmodule/incl[typed/openssl/md5]
>  @defmodule/incl[typed/openssl/sha1]
>  @defmodule/incl[typed/pict]
> + at defmodule/incl[typed/racket/async-channel]
>  @defmodule/incl[typed/rackunit]
>  @defmodule/incl[typed/srfi/14]
>  @defmodule/incl[typed/syntax/stx]
>
> pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/reference/types.scrbl
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/reference/types.scrbl
> +++ NEW/pkgs/typed-racket-pkgs/typed-racket-doc/typed-racket/scribblings/reference/types.scrbl
> @@ -4,7 +4,8 @@
>                  "numeric-tower-pict.rkt"
>                  scribble/eval
>                  racket/sandbox)
> -       (require (for-label (only-meta-in 0 [except-in typed/racket for])))]
> +       (require (for-label (only-meta-in 0 [except-in typed/racket for])
> +                           racket/async-channel))]
>
>  @(define the-eval (make-base-eval))
>  @(the-eval '(require (except-in typed/racket #%top-interaction #%module-begin)))
> @@ -412,6 +413,21 @@ corresponding to @racket[trest], where @racket[bound]
>  @ex[(lambda: ([x : Any]) (if (channel? x) x (error "not a channel!")))]
>  }
>
> + at defform[(Async-Channelof t)]{An @rtech{asynchronous channel} on which only @racket[t]s can be sent.
> + at ex[
> +(require typed/racket/async-channel)
> +(ann (make-async-channel) (Async-Channelof Symbol))
> +]
> +}
> +
> + at defidform[Async-ChannelTop]{is the type of an @rtech{asynchronous channel} with unknown
> +  message type and is the supertype of all asynchronous channel types. This type typically
> +  appears in programs via the combination of occurrence typing and
> +  @racket[async-channel?].
> + at ex[(require typed/racket/async-channel)
> +    (lambda: ([x : Any]) (if (async-channel? x) x (error "not an async-channel!")))]
> +}
> +
>  @defform*[[(Parameterof t)
>             (Parameterof s t)]]{A @rtech{parameter} of @racket[t].  If two type arguments are supplied,
>                                   the first is the type the parameter accepts, and the second is the type returned.
>
> pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-types.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-types.rkt
> +++ NEW/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-types.rkt
> @@ -115,6 +115,7 @@
>  [Procedure top-func]
>  [BoxTop -BoxTop]
>  [ChannelTop -ChannelTop]
> +[Async-ChannelTop -Async-ChannelTop]
>  [VectorTop -VectorTop]
>  [HashTableTop -HashTop]
>  [MPairTop -MPairTop]
> @@ -168,6 +169,7 @@
>  [Pair (-poly (a b) (-pair a b))]
>  [Boxof (-poly (a) (make-Box a))]
>  [Channelof (-poly (a) (make-Channel a))]
> +[Async-Channelof (-poly (a) (make-Async-Channel a))]
>  [Ephemeronof (-poly (a) (make-Ephemeron a))]
>  [Setof (-poly (e) (make-Set e))]
>  [Evtof (-poly (r) (-evt r))]
>
> pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt
> +++ NEW/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt
> @@ -592,6 +592,8 @@
>             (% cset-meet (cg/inv s s*) (cg/inv t t*))]
>            [((Channel: e) (Channel: e*))
>             (cg/inv e e*)]
> +          [((Async-Channel: e) (Async-Channel: e*))
> +           (cg/inv e e*)]
>            [((ThreadCell: e) (ThreadCell: e*))
>             (cg/inv e e*)]
>            [((Continuation-Mark-Keyof: e) (Continuation-Mark-Keyof: e*))
> @@ -629,6 +631,7 @@
>                 t)]
>            [((CustodianBox: t) (Evt: t*)) (cg S t*)]
>            [((Channel: t) (Evt: t*)) (cg t t*)]
> +          [((Async-Channel: t) (Evt: t*)) (cg t t*)]
>            ;; we assume all HTs are mutable at the moment
>            [((Hashtable: s1 s2) (Hashtable: t1 t2))
>             ;; for mutable hash tables, both are invariant
>
> pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt
> +++ NEW/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/private/type-contract.rkt
> @@ -330,6 +330,7 @@
>          [(VectorTop:) (only-untyped vector?/sc)]
>          [(BoxTop:) (only-untyped box?/sc)]
>          [(ChannelTop:) (only-untyped channel?/sc)]
> +        [(Async-ChannelTop:) (only-untyped async-channel?/sc)]
>          [(HashtableTop:) (only-untyped hash?/sc)]
>          [(MPairTop:) (only-untyped mpair?/sc)]
>          [(ThreadCellTop:) (only-untyped thread-cell?/sc)]
>
> pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- OLD/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt
> +++ NEW/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt
> @@ -186,6 +186,11 @@
>    [#:key 'channel])
>
>  ;; elem is a Type
> +(def-type Async-Channel ([elem Type/c])
> +  [#:frees (λ (f) (make-invariant (f elem)))]
> +  [#:key 'async-channel])
> +
> +;; elem is a Type
>  (def-type ThreadCell ([elem Type/c])
>    [#:frees (λ (f) (make-invariant (f elem)))]
>    [#:key 'thread-cell])
> @@ -397,6 +402,7 @@
>  ;; the supertype of all of these values
>  (def-type BoxTop () [#:fold-rhs #:base] [#:key 'box])
>  (def-type ChannelTop () [#:fold-rhs #:base] [#:key 'channel])
> +(def-type Async-ChannelTop () [#:fold-rhs #:base] [#:key 'async-channel])
>  (def-type VectorTop () [#:fold-rhs #:base] [#:key 'vector])
>  (def-type HashtableTop () [#:fold-rhs #:base] [#:key 'hash])
>  (def-type MPairTop () [#:fold-rhs #:base] [#:key 'mpair])
>
> pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/static-contracts/combinators/derived.rkt
> ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
> --- 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?


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


Posted on the dev mailing list.