merged units branch

svn: r5033

original commit: 3459c3a58f
This commit is contained in:
Eli Barzilay 2006-12-05 20:31:14 +00:00
parent 7cc0a1760d
commit e6fc4d4027
15 changed files with 73 additions and 127 deletions

View File

@ -1,11 +1,8 @@
(module cgi mzscheme (module cgi mzscheme
(require (lib "unitsig.ss")) (require (lib "unit.ss")
"cgi-sig.ss"
"cgi-unit.ss")
(require "cgi-sig.ss") (define-values/invoke-unit/infer cgi@)
(require "cgi-unit.ss")
(define-values/invoke-unit/sig net:cgi^ (provide-signature-elements cgi^))
net:cgi@)
(provide-signature-elements net:cgi^))

View File

@ -1,9 +1,8 @@
(module cookie mzscheme (module cookie mzscheme
(require (lib "unitsig.ss") (require (lib "unit.ss")
"cookie-sig.ss" "cookie-sig.ss"
"cookie-unit.ss") "cookie-unit.ss")
(provide-signature-elements net:cookie^) (provide-signature-elements cookie^)
(define-values/invoke-unit/sig net:cookie^ (define-values/invoke-unit/infer cookie@))
cookie@))

View File

@ -1,11 +1,8 @@
(module dns mzscheme (module dns mzscheme
(require (lib "unitsig.ss")) (require (lib "unit.ss")
"dns-sig.ss"
"dns-unit.ss")
(require "dns-sig.ss") (define-values/invoke-unit/infer dns@)
(require "dns-unit.ss")
(define-values/invoke-unit/sig net:dns^ (provide-signature-elements dns^))
net:dns@)
(provide-signature-elements net:dns^))

View File

@ -1,11 +1,8 @@
(module ftp mzscheme (module ftp mzscheme
(require (lib "unitsig.ss")) (require (lib "unit.ss")
"ftp-sig.ss"
"ftp-unit.ss")
(require "ftp-sig.ss") (define-values/invoke-unit/infer ftp@)
(require "ftp-unit.ss")
(define-values/invoke-unit/sig net:ftp^ (provide-signature-elements ftp^))
net:ftp@)
(provide-signature-elements net:ftp^))

View File

@ -1,13 +1,10 @@
(module imap mzscheme (module imap mzscheme
(require (lib "unitsig.ss") (require (lib "unit.ss")
(lib "contract.ss")) (lib "contract.ss")
"imap-sig.ss"
(require "imap-sig.ss"
"imap-unit.ss") "imap-unit.ss")
(define-values/invoke-unit/sig net:imap^ (define-values/invoke-unit/infer imap@)
net:imap@)
(provide/contract (provide/contract
[imap-get-hierarchy-delimiter (imap-connection? . -> . bytes?)] [imap-get-hierarchy-delimiter (imap-connection? . -> . bytes?)]

View File

@ -27,9 +27,8 @@
;; Commentary: ;; Commentary:
(module mime mzscheme (module mime mzscheme
(require (lib "unitsig.ss")) (require (lib "unit.ss")
"mime-sig.ss"
(require "mime-sig.ss"
"mime-unit.ss" "mime-unit.ss"
"qp-sig.ss" "qp-sig.ss"
"qp.ss" "qp.ss"
@ -38,11 +37,15 @@
"head-sig.ss" "head-sig.ss"
"head.ss") "head.ss")
(define-values/invoke-unit/sig net:mime^ (define-unit-from-context base64@ base64^)
net:mime@ (define-unit-from-context qp@ qp^)
#f (define-unit-from-context head@ head^)
net:base64^ net:qp^ net:head^)
(provide-signature-elements net:mime^)) (define-compound-unit/infer mime@2 (import) (export mime^)
(link base64@ qp@ head@ mime@))
(define-values/invoke-unit/infer mime@2)
(provide-signature-elements mime^))
;;; mime.ss ends here ;;; mime.ss ends here

View File

@ -1,11 +1,8 @@
(module nntp mzscheme (module nntp mzscheme
(require (lib "unitsig.ss")) (require (lib "unit.ss")
"nntp-sig.ss"
"nntp-unit.ss")
(require "nntp-sig.ss") (define-values/invoke-unit/infer nntp@)
(require "nntp-unit.ss")
(define-values/invoke-unit/sig net:nntp^ (provide-signature-elements nntp^))
net:nntp@)
(provide-signature-elements net:nntp^))

View File

@ -1,14 +1,11 @@
(module pop3 mzscheme (module pop3 mzscheme
(require (lib "unitsig.ss")) (require (lib "unit.ss")
"pop3-sig.ss"
"pop3-unit.ss")
(require "pop3-sig.ss") (define-values/invoke-unit/infer pop3@)
(require "pop3-unit.ss")
(define-values/invoke-unit/sig net:pop3^ (provide-signature-elements pop3^))
net:pop3@)
(provide-signature-elements net:pop3^))
#| #|

View File

@ -26,14 +26,12 @@
;; Commentary: ;; Commentary:
(module qp mzscheme (module qp mzscheme
(require (lib "unitsig.ss")) (require (lib "unit.ss")
"qp-sig.ss"
"qp-unit.ss")
(require "qp-sig.ss") (define-values/invoke-unit/infer qp@)
(require "qp-unit.ss")
(define-values/invoke-unit/sig net:qp^ (provide-signature-elements qp^))
net:qp@)
(provide-signature-elements net:qp^))
;;; qp.ss ends here ;;; qp.ss ends here

View File

@ -1,11 +1,8 @@
(module sendmail mzscheme (module sendmail mzscheme
(require (lib "unitsig.ss")) (require (lib "unit.ss")
"sendmail-sig.ss"
"sendmail-unit.ss")
(require "sendmail-sig.ss") (define-values/invoke-unit/infer sendmail@)
(require "sendmail-unit.ss")
(define-values/invoke-unit/sig net:sendmail^ (provide-signature-elements sendmail^))
net:sendmail@)
(provide-signature-elements net:sendmail^))

View File

@ -1,11 +1,8 @@
(module smtp mzscheme (module smtp mzscheme
(require (lib "unitsig.ss")) (require (lib "unit.ss")
"smtp-sig.ss"
"smtp-unit.ss")
(require "smtp-sig.ss") (define-values/invoke-unit/infer smtp@)
(require "smtp-unit.ss")
(define-values/invoke-unit/sig net:smtp^ (provide-signature-elements smtp^))
net:smtp@)
(provide-signature-elements net:smtp^))

View File

@ -1,6 +1,6 @@
(module ssl-tcp-unit mzscheme (module ssl-tcp-unit mzscheme
(provide make-ssl-tcp@) (provide make-ssl-tcp@)
(require (lib "unitsig.ss") (require (lib "unit.ss")
"tcp-sig.ss" "tcp-sig.ss"
(lib "mzssl.ss" "openssl") (lib "mzssl.ss" "openssl")
(lib "etc.ss")) (lib "etc.ss"))
@ -8,8 +8,9 @@
(define (make-ssl-tcp@ (define (make-ssl-tcp@
server-cert-file server-key-file server-root-cert-files server-suggest-auth-file server-cert-file server-key-file server-root-cert-files server-suggest-auth-file
client-cert-file client-key-file client-root-cert-files) client-cert-file client-key-file client-root-cert-files)
(unit/sig net:tcp^ (unit
(import) (import)
(export tcp^)
(define ctx (ssl-make-client-context)) (define ctx (ssl-make-client-context))
(when client-cert-file (when client-cert-file

View File

@ -1,7 +1,7 @@
(module tcp-redirect mzscheme (module tcp-redirect mzscheme
(provide tcp-redirect) (provide tcp-redirect)
(require (lib "unitsig.ss") (require (lib "unit.ss")
(lib "async-channel.ss") (lib "async-channel.ss")
(lib "etc.ss") (lib "etc.ss")
"tcp-sig.ss") "tcp-sig.ss")
@ -24,9 +24,9 @@
; : (listof nat) -> (unit/sig () -> net:tcp^) ; : (listof nat) -> (unit/sig () -> net:tcp^)
(define tcp-redirect (define tcp-redirect
(opt-lambda (redirected-ports [redirected-address "127.0.0.1"]) (opt-lambda (redirected-ports [redirected-address "127.0.0.1"])
(unit/sig net:tcp^ (unit
(import) (import)
(export tcp^)
; : (make-pipe-listener nat (channel (cons iport oport))) ; : (make-pipe-listener nat (channel (cons iport oport)))
(define-struct pipe-listener (port channel)) (define-struct pipe-listener (port channel))

View File

@ -1,9 +1,5 @@
(module tcp-sig mzscheme (module tcp-sig (lib "a-signature.ss")
(provide net:tcp^) tcp-abandon-port
(require (lib "unitsig.ss"))
(define-signature net:tcp^
(tcp-abandon-port
tcp-accept tcp-accept
tcp-accept/enable-break tcp-accept/enable-break
tcp-accept-ready? tcp-accept-ready?
@ -12,4 +8,4 @@
tcp-connect tcp-connect
tcp-connect/enable-break tcp-connect/enable-break
tcp-listen tcp-listen
tcp-listener?))) tcp-listener?)

View File

@ -1,34 +1,7 @@
(module tcp-unit mzscheme (module tcp-unit mzscheme
(provide tcp@) (provide tcp@)
(require (lib "unitsig.ss")
(require (lib "unit.ss")
"tcp-sig.ss") "tcp-sig.ss")
; Okay, this file looks retarded. Something is clearly wrong. (define-unit-from-context tcp@ tcp^))
(define raw:tcp-abandon-port tcp-abandon-port)
(define raw:tcp-accept tcp-accept)
(define raw:tcp-accept/enable-break tcp-accept/enable-break)
(define raw:tcp-accept-ready? tcp-accept-ready?)
(define raw:tcp-addresses tcp-addresses)
(define raw:tcp-close tcp-close)
(define raw:tcp-connect tcp-connect)
(define raw:tcp-connect/enable-break tcp-connect/enable-break)
(define raw:tcp-listen tcp-listen)
(define raw:tcp-listener? tcp-listener?)
(define tcp@
(unit/sig net:tcp^
(import)
(define tcp-abandon-port raw:tcp-abandon-port)
(define tcp-accept raw:tcp-accept)
(define tcp-accept/enable-break raw:tcp-accept/enable-break)
(define tcp-accept-ready? raw:tcp-accept-ready?)
(define tcp-addresses raw:tcp-addresses)
(define tcp-close raw:tcp-close)
(define tcp-connect raw:tcp-connect)
(define tcp-connect/enable-break raw:tcp-connect/enable-break)
(define tcp-listen raw:tcp-listen)
(define tcp-listener? raw:tcp-listener?)
)))