[racket-dev] [plt] Push #28930: master branch updated
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 ***
![[logo]](/logo.png){kind=logo}