From 2d3a402e262fb35350477b5fe01bad0896006cf6 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Tue, 30 Jul 2013 15:45:45 -0400 Subject: [PATCH] Add more events to the base type environment Notably the following are not supported yet: - `filesystem-change-evt` (likely needs separate base type) - `port-progress-evt` (separate type, and how do you handle `port-provides-progress-evts?`?) - all other events that rely on progress events Also, the events from racket/port don't work yet due to a strange bug with bindings that have contracts imported into TR's base environment original commit: ace226d5060ce2f2ed3fac2b802ddaee0d31ca0a --- .../typed-racket/base-env/base-env.rkt | 64 +++++++++++-------- 1 file changed, 39 insertions(+), 25 deletions(-) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt index c4c63ec9..07603d3d 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/base-env.rkt @@ -326,8 +326,8 @@ [channel-get (-poly (a) ((-channel a) . -> . a))] [channel-try-get (-poly (a) ((-channel a) . -> . (Un a (-val #f))))] [channel-put (-poly (a) ((-channel a) a . -> . -Void))] - - +[channel-put-evt (-poly (a) (-> (-channel a) a (-mu x (make-Evt x))))] +[channel-put-evt? (make-pred-ty (-mu x (make-Evt x)))] ;Section 3.3 @@ -501,11 +501,9 @@ ;Section 10.1.3 [thread-wait (-Thread . -> . -Void)] - -;TODO need event types -;thread-dead-evt -;thread-resume-evt -;thread-suspend-evt +[thread-dead-evt (-> -Thread (-mu x (make-Evt x)))] +[thread-resume-evt (-> -Thread (-mu x (make-Evt x)))] +[thread-suspend-evt (-> -Thread (-mu x (make-Evt x)))] ;Section 10.1.4 [thread-send @@ -514,6 +512,7 @@ (-> -Thread Univ (-> a) (Un -Void a))))] [thread-receive (-> Univ)] [thread-try-receive (-> Univ)] +[thread-receive-evt (-> (-mu x (make-Evt x)))] [thread-rewind-receive (-> (-lst Univ) -Void)] ;Section 10.3.1 (Thread Cells) @@ -1530,6 +1529,10 @@ [tcp-close (-TCP-Listener . -> . -Void)] [tcp-listener? (make-pred-ty -TCP-Listener)] +[tcp-accept-evt + (-> -TCP-Listener + (make-Evt (-pair -Input-Port (-pair -Output-Port (-val '())))))] + [tcp-abandon-port (-Port . -> . -Void)] [tcp-addresses (cl->* (-Port [(-val #f)] . ->opt . (-values (list -String -String))) @@ -1562,19 +1565,21 @@ [udp-bound? (-> -UDP-Socket B)] [udp-connected? (-> -UDP-Socket B)] +[udp-send-ready-evt (-> -UDP-Socket (-mu x (make-Evt x)))] +[udp-receive-ready-evt (-> -UDP-Socket (-mu x (make-Evt x)))] +[udp-send-to-evt (->opt -UDP-Socket -String -Nat -Bytes [-Nat -Nat] + (make-Evt -Void))] +[udp-send-evt (->opt -UDP-Socket -Bytes [-Nat -Nat] + (make-Evt -Void))] +[udp-receive!-evt + (->opt -UDP-Socket -Bytes [-Nat -Nat] + (make-Evt (-pair -Nat (-pair -String (-pair -Nat (-val null))))))] + [udp-addresses (cl->* (->opt -UDP-Socket [(-val #f)] (-values (list -String -String))) (-> -UDP-Socket (-val #t) (-values (list -String -NonNegFixnum -String -NonNegFixnum))))] - - - - - - - - ;; racket/path [explode-path (-SomeSystemPathlike . -> . (-lst (Un -SomeSystemPath (one-of/c 'up 'same))))] @@ -2190,10 +2195,11 @@ [semaphore-wait (-> -Semaphore -Void)] [semaphore-try-wait? (-> -Semaphore B)] [semaphore-wait/enable-break (-> -Semaphore -Void)] +[semaphore-peek-evt (-> -Semaphore (-mu x (make-Evt x)))] +[semaphore-peek-evt? (make-pred-ty (-mu x (make-Evt x)))] ;[call-with-semaphore ???] ;[call-with-semaphore/enable-break ???] - ;Section 17.2 (Libraries and Collections) [find-library-collection-paths (->opt [(-lst -Pathlike) (-lst -Pathlike)] (-lst -Path))] [collection-file-path (->* (list -Pathlike) -Pathlike -Path)] @@ -2262,6 +2268,7 @@ [close-output-port (-> -Output-Port -Void)] [port-closed? (-> -Port B)] +[port-closed-evt (-> -Port (-mu x (make-Evt x)))] [current-input-port (-Param -Input-Port -Input-Port)] [current-output-port (-Param -Output-Port -Output-Port)] @@ -2446,15 +2453,21 @@ ;12.1.10.3 -;eof-evt -;read-bytes-evt -;read-bytes!-evt -;read-bytes-avail!-evt -;read-string-evt -;read-string!-evt -;read-line-evt -;read-bytes-line-evt -;peek-bytes-evt +[eof-evt (-> -Input-Port (make-Evt (-val eof)))] +[read-bytes-evt (-> -Nat -Input-Port (make-Evt (Un -Bytes (-val eof))))] +;read-bytes!-evt (need progress event support) +[read-bytes-avail!-evt + (-> -Bytes -Input-Port (make-Evt (Un -Nat (-val eof))))] +[read-string-evt (-> -Nat -Input-Port (make-Evt (Un -String (-val eof))))] +[read-string!-evt (-> -String -Input-Port (make-Evt (Un -Nat (-val eof))))] +[read-line-evt (-> -Input-Port + (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) + (make-Evt (Un -String (-val eof))))] +[read-bytes-line-evt + (-> -Input-Port + (one-of/c 'linefeed 'return 'return-linefeed 'any 'any-one) + (make-Evt (Un -Bytes (-val eof))))] +;peek-bytes-evt (ditto progress event) ;peek-bytes!-evt ;peek-bytes-avail!-evt ;peek-string-evt @@ -2729,6 +2742,7 @@ #:named (Un (-val #f) -Symbol) #f -Place)] [place-wait (-> -Place -Int)] +[place-dead-evt (-> -Place (make-Evt -Byte))] [place-break (-> -Place -Void)] [place-kill (-> -Place -Void)] [place-channel (-> (-values (list -Place-Channel -Place-Channel)))]