On Tue, Jun 24, 2014 at 3:17 PM, <stch...@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 <stch...@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] > +@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!")))] > } > > +@defform[(Async-Channelof t)]{An @rtech{asynchronous channel} on which only > @racket[t]s can be sent. > +@ex[ > +(require typed/racket/async-channel) > +(ann (make-async-channel) (Async-Channelof Symbol)) > +] > +} > + > +@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?]. > +@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 *** _________________________ Racket Developers list: http://lists.racket-lang.org/dev