From bf579f30e7dfbcf62c65dbdebf3a2b5433627a20 Mon Sep 17 00:00:00 2001 From: Sam Tobin-Hochstadt Date: Wed, 19 Nov 2008 22:50:10 +0000 Subject: [PATCH] Add scheme/tcp bindings. svn: r12516 original commit: a4ac14b124cb70127897fcb117d4d9312ab17518 --- collects/typed-scheme/private/base-env.ss | 15 ++++++++++++++- .../private/type-effect-convenience.ss | 3 ++- 2 files changed, 16 insertions(+), 2 deletions(-) diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss index 1bcfa78f..64137632 100644 --- a/collects/typed-scheme/private/base-env.ss +++ b/collects/typed-scheme/private/base-env.ss @@ -2,6 +2,7 @@ (require scheme/list + scheme/tcp (only-in rnrs/lists-6 fold-left) '#%paramz (only-in '#%kernel [apply kernel:apply]) @@ -480,4 +481,16 @@ [eof (-val eof)] [read-accept-reader (-Param B B)] -[maybe-print-message (-String . -> . -Void)] \ No newline at end of file +[maybe-print-message (-String . -> . -Void)] + +;; scheme/tcp +[tcp-listener? (make-pred-ty -TCP-Listener)] +[tcp-abandon-port (-Port . -> . -Void)] +[tcp-accept (-TCP-Listener . -> . (-values (list -Input-Port -Output-Port)) )] +[tcp-accept/enable-break (-TCP-Listener . -> . (-values (list -Input-Port -Output-Port)) )] +[tcp-accept-ready? (-TCP-Listener . -> . B )] +[tcp-addresses (-Port . -> . (-values (list N N)))] +[tcp-close (-TCP-Listener . -> . -Void )] +[tcp-connect (-String -Integer . -> . (-values (list -Input-Port -Output-Port)))] +[tcp-connect/enable-break (-String -Integer . -> . (-values (list -Input-Port -Output-Port)))] +[tcp-listen (N . -> . -TCP-Listener)] \ No newline at end of file diff --git a/collects/typed-scheme/private/type-effect-convenience.ss b/collects/typed-scheme/private/type-effect-convenience.ss index 6776fe54..217e0c0c 100644 --- a/collects/typed-scheme/private/type-effect-convenience.ss +++ b/collects/typed-scheme/private/type-effect-convenience.ss @@ -12,7 +12,7 @@ scheme/promise (for-syntax macro-debugger/stxclass/stxclass) (for-syntax scheme/base) - (for-template scheme/base scheme/contract)) + (for-template scheme/base scheme/contract scheme/tcp)) (provide (all-defined-out) ;; these should all eventually go away @@ -134,6 +134,7 @@ (define -Namespace (make-Base 'Namespace #'namespace?)) (define -Output-Port (make-Base 'Output-Port #'output-port?)) (define -Input-Port (make-Base 'Input-Port #'input-port?)) +(define -TCP-Listener (make-Base 'TCP-Listener #'tcp-listener?)) (define -Syntax make-Syntax) (define -HT make-Hashtable)