From f3692eae29d7b0582eb90cc4768786688b8ca438 Mon Sep 17 00:00:00 2001 From: Eric Dobson Date: Tue, 28 Jun 2011 10:43:10 -0400 Subject: [PATCH] Added support for configurable constructor names in require/typed. Closes PR11171. Closes PR11194. Closes PR11314. --- .../tests/typed-scheme/succeed/pr11171.rkt | 14 ++ .../tests/typed-scheme/succeed/pr11194.rkt | 14 ++ .../tests/typed-scheme/succeed/pr11314.rkt | 16 +++ .../typed-scheme/succeed/require-struct.rkt | 31 +++++ .../succeed/require-substruct.rkt | 4 +- .../tests/typed-scheme/succeed/rts-prov.rkt | 2 +- .../tests/typed-scheme/succeed/struct-out.rkt | 2 +- collects/typed-scheme/base-env/prims.rkt | 124 ++++++++++++------ .../scribblings/reference/special-forms.scrbl | 19 ++- .../typed-scheme/typecheck/tc-toplevel.rkt | 3 + collects/typed/net/cgi.rkt | 6 +- collects/typed/net/cookie.rkt | 2 +- collects/typed/net/mime.rkt | 3 + collects/typed/net/nntp.rkt | 31 +++-- collects/typed/net/pop3.rkt | 44 ++++--- 15 files changed, 235 insertions(+), 80 deletions(-) create mode 100644 collects/tests/typed-scheme/succeed/pr11171.rkt create mode 100644 collects/tests/typed-scheme/succeed/pr11194.rkt create mode 100644 collects/tests/typed-scheme/succeed/pr11314.rkt create mode 100644 collects/tests/typed-scheme/succeed/require-struct.rkt diff --git a/collects/tests/typed-scheme/succeed/pr11171.rkt b/collects/tests/typed-scheme/succeed/pr11171.rkt new file mode 100644 index 0000000000..0f66d023f4 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/pr11171.rkt @@ -0,0 +1,14 @@ +#lang racket/load + +(module UNTYPED racket/base + (struct IntTree + (elem left right)) + + (provide (struct-out IntTree))) + +(module TYPED typed/racket + (require/typed 'UNTYPED + [struct IntTree + ([elem : Integer] + [left : IntTree] + [right : IntTree])])) diff --git a/collects/tests/typed-scheme/succeed/pr11194.rkt b/collects/tests/typed-scheme/succeed/pr11194.rkt new file mode 100644 index 0000000000..a619a77f0e --- /dev/null +++ b/collects/tests/typed-scheme/succeed/pr11194.rkt @@ -0,0 +1,14 @@ +#lang racket/load + +(module untyped racket + (struct foo (bar baz)) + (define f (lambda (x) (+ (foo-baz x) 3))) + + (provide [struct-out foo] + f)) + +(module typed typed/racket + (require/typed 'untyped + [struct foo ([bar : Number] [baz : String])])) + +(require 'typed) diff --git a/collects/tests/typed-scheme/succeed/pr11314.rkt b/collects/tests/typed-scheme/succeed/pr11314.rkt new file mode 100644 index 0000000000..a6125a7a32 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/pr11314.rkt @@ -0,0 +1,16 @@ +#lang racket/load + +(module A racket + (define-struct point [x y]) + (point 1 2) + (provide (all-defined-out))) + +(module B typed/racket + (require/typed 'A + [struct point ([x : Integer] [y : Integer])]) + (point 1 2) + (struct: pt ([x : Integer] [y : Integer])) + (pt 1 2)) + +(require 'A) +(require 'B) diff --git a/collects/tests/typed-scheme/succeed/require-struct.rkt b/collects/tests/typed-scheme/succeed/require-struct.rkt new file mode 100644 index 0000000000..234f722aa6 --- /dev/null +++ b/collects/tests/typed-scheme/succeed/require-struct.rkt @@ -0,0 +1,31 @@ +#lang racket/load + +(module untyped racket + (provide (all-defined-out)) + (struct a (v)) + (struct b a (v)) + (struct c (v) #:constructor-name c-maker) + (struct d c (v) #:constructor-name d-maker) + (define-struct e (v)) + (define-struct (f e) (v))) + +(module typed typed/racket + (require/typed 'untyped + (struct a ((v : Integer))) + #;(struct (b a) ((v : String))) + (struct c ((v : Integer)) #:constructor-name c-maker) + #;(struct (d c) ((v : String)) #:constructor-name d-maker) + (struct e ((v : Integer)) #:extra-constructor-name make-e) + #;(struct (f e) ((v : String)) #:extra-constructor-name make-f)) + + (a 0) + ;(b 1 "2") + (c-maker 3) + ;(d-maker 4 "5") + (make-e 6) + ;(make-f 7 "8") + (e 9) + #;(f 10 "11")) + +(require 'typed) + diff --git a/collects/tests/typed-scheme/succeed/require-substruct.rkt b/collects/tests/typed-scheme/succeed/require-substruct.rkt index 3de92b353e..1461dde0b0 100644 --- a/collects/tests/typed-scheme/succeed/require-substruct.rkt +++ b/collects/tests/typed-scheme/succeed/require-substruct.rkt @@ -6,8 +6,8 @@ (provide (all-defined-out))) (module n typed-scheme - (require-typed-struct X ([x : Number]) 'm) - (require-typed-struct (Y X) ([y : Number]) 'm) + (require-typed-struct X ([x : Number]) #:extra-constructor-name make-X 'm) + (require-typed-struct (Y X) ([y : Number]) #:extra-constructor-name make-Y 'm) (make-X 43) (define: x : Any 3) (if (Y? x) diff --git a/collects/tests/typed-scheme/succeed/rts-prov.rkt b/collects/tests/typed-scheme/succeed/rts-prov.rkt index a900b54e28..f20b849eac 100644 --- a/collects/tests/typed-scheme/succeed/rts-prov.rkt +++ b/collects/tests/typed-scheme/succeed/rts-prov.rkt @@ -5,7 +5,7 @@ (provide (all-defined-out))) (module m typed-scheme - (require-typed-struct q () 'l) + (require-typed-struct q () #:extra-constructor-name make-q 'l) (provide (all-defined-out))) (module n typed-scheme diff --git a/collects/tests/typed-scheme/succeed/struct-out.rkt b/collects/tests/typed-scheme/succeed/struct-out.rkt index eff477ad28..6a8495f1db 100644 --- a/collects/tests/typed-scheme/succeed/struct-out.rkt +++ b/collects/tests/typed-scheme/succeed/struct-out.rkt @@ -1,3 +1,3 @@ #lang typed-scheme -(require-typed-struct posn ([x : Number] [y : Number]) lang/posn) +(require-typed-struct posn ([x : Number] [y : Number]) #:extra-constructor-name make-posn lang/posn) (provide (struct-out posn)) diff --git a/collects/typed-scheme/base-env/prims.rkt b/collects/typed-scheme/base-env/prims.rkt index 6829ab5d6b..e70264c343 100644 --- a/collects/typed-scheme/base-env/prims.rkt +++ b/collects/typed-scheme/base-env/prims.rkt @@ -67,11 +67,15 @@ This file defines two sorts of primitives. All of them are provided into any mod (define-syntax-class simple-clause #:attributes (nm ty) (pattern [nm:opt-rename ty])) + (define-splicing-syntax-class opt-constructor + (pattern (~optional (~seq (~or #:extra-constructor-name #:constructor-name) name:id)))) + (define-syntax-class struct-clause ;#:literals (struct) - #:attributes (nm (body 1)) - (pattern [struct nm:opt-rename (body ...)] - #:fail-unless (eq? 'struct (syntax-e #'struct)) #f)) + #:attributes (nm (body 1) (constructor-parts 1)) + (pattern [struct nm:opt-rename (body ...) constructor:opt-constructor] + #:fail-unless (eq? 'struct (syntax-e #'struct)) #f + #:with (constructor-parts ...) #'constructor)) (define-syntax-class opaque-clause ;#:literals (opaque) #:attributes (ty pred opt) @@ -85,10 +89,10 @@ This file defines two sorts of primitives. All of them are provided into any mod [(_ lib:expr (~or sc:simple-clause strc:struct-clause oc:opaque-clause) ...) (unless (< 0 (length (syntax->list #'(sc ... strc ... oc ...)))) (raise-syntax-error #f "at least one specification is required" stx)) - #'(begin + #`(begin (require/opaque-type oc.ty oc.pred lib . oc.opt) ... (require/typed #:internal sc.nm sc.ty lib) ... - (require-typed-struct strc.nm (strc.body ...) lib) ...)] + (require-typed-struct strc.nm (strc.body ...) strc.constructor-parts ... lib) ...)] [(_ nm:opt-rename ty lib (~optional [~seq #:struct-maker parent]) ...) #`(require/typed #:internal nm ty lib #,@(if (attribute parent) #'(#:struct-maker parent) @@ -377,48 +381,90 @@ This file defines two sorts of primitives. All of them are provided into any mod [dtsi (quasisyntax/loc stx (dtsi* (vars ...) nm.old-spec (fs ...) #:maker #,cname #,@mutable))]) #'(begin d-s dtsi)))]))))) + +;Copied from racket/private/define-struct +(define-for-syntax (self-ctor-transformer orig stx) + (define (transfer-srcloc orig stx) + (datum->syntax orig (syntax-e orig) stx orig)) + (syntax-case stx () + [(self arg ...) (datum->syntax stx + (cons (syntax-property (transfer-srcloc orig #'self) + 'constructor-for + (syntax-local-introduce #'self)) + (syntax-e (syntax (arg ...)))) + stx + stx)] + [_ (transfer-srcloc orig stx)])) + + +(define-for-syntax make-struct-info-self-ctor + (let () + (struct struct-info-self-ctor (id info) + #:property prop:procedure + (lambda (ins stx) + (self-ctor-transformer (struct-info-self-ctor-id ins) stx)) + #:property prop:struct-info (lambda (x) (extract-struct-info (struct-info-self-ctor-info x)))) + struct-info-self-ctor)) + + (define-syntax (require-typed-struct stx) + (define-syntax-class opt-parent + (pattern nm:id #:attr parent #'#f) + (pattern (nm:id parent:id))) + + (define-splicing-syntax-class constructor-term + (pattern (~seq) #:attr name #'#f #:attr extra #f) + (pattern (~seq #:constructor-name name:id) #:attr extra #f) + (pattern (~seq #:extra-constructor-name name:id) #:attr extra #t)) + (syntax-parse stx #:literals (:) - [(_ nm:id ([fld : ty] ...) lib) - (with-syntax* ([(struct-info maker pred sel ...) (build-struct-names #'nm (syntax->list #'(fld ...)) #f #t)] - [(mut ...) (map (lambda _ #'#f) (syntax->list #'(sel ...)))]) + [(_ name:opt-parent ([fld : ty] ...) input-maker:constructor-term lib) + (define has-parent? (and (syntax-e #'name.parent) #t)) + (with-syntax* ([nm #'name.nm] + [parent #'name.parent] + [spec (if has-parent? #'(nm parent) #'nm)] + [(struct-info _ pred sel ...) (build-struct-names #'nm (syntax->list #'(fld ...)) #f #t)] + [(mut ...) (map (lambda _ #'#f) (syntax->list #'(sel ...)))] + [maker-name (if (syntax-e #'input-maker.name) #'input-maker.name #'nm)] ;New default (corresponds to how struct works) + ;maker-name's symbolic form is used in the require form + [id-is-ctor? (or (attribute input-maker.extra) (bound-identifier=? #'maker-name #'nm))] + [internal-maker (generate-temporary #'maker-name)] ;Only used if id-is-ctor? is true + [real-maker (if (syntax-e #'id-is-ctor?) #'internal-maker #'maker-name)] ;The actual identifier bound to the constructor + [extra-maker (and (attribute input-maker.extra) + (not (bound-identifier=? #'make-name #'nm)) + #'maker-name)]) (quasisyntax/loc stx (begin (require (only-in lib struct-info)) - (define-syntax nm (make-struct-info - (lambda () - (list #'struct-info - #'maker - #'pred - (reverse (list #'sel ...)) - (list mut ...) - #f)))) - (dtsi* () nm ([fld : ty] ...) #:type-only) + + (define-for-syntax si + (make-struct-info + (lambda () + (list #'struct-info + #'real-maker + #'pred + (reverse (list #'sel ...)) + (list mut ...) + #f)))) + + (define-syntax nm + (if id-is-ctor? + (make-struct-info-self-ctor #'internal-maker si) + si)) + + (dtsi* () spec ([fld : ty] ...) #:maker maker-name #:type-only) #,(ignore #'(require/contract pred (any/c . c-> . boolean?) lib)) #,(internal #'(require/typed-internal pred (Any -> Boolean : nm))) - (require/typed maker nm lib #:struct-maker #f) + (require/typed (maker-name real-maker) nm lib #:struct-maker parent) + + ;This needs to be a different identifier to meet the specifications + ;of struct (the id constructor shouldn't expand to it) + #,(if (syntax-e #'extra-maker) + #'(require/typed (maker-name extra-maker) nm lib #:struct-maker #f) + #'(begin)) + (require/typed lib - [sel (nm -> ty)]) ...)))] - [(_ (nm parent) ([fld : ty] ...) lib) - (and (identifier? #'nm) (identifier? #'parent)) - (with-syntax* ([(struct-info maker pred sel ...) (build-struct-names #'nm (syntax->list #'(fld ...)) #f #t)] - [(mut ...) (map (lambda _ #'#f) (syntax->list #'(sel ...)))]) - #`(begin - (require (only-in lib struct-info)) - (define-syntax nm (make-struct-info - (lambda () - (list #'struct-info - #'maker - #'pred - (list #'sel ...) - (list mut ...) - #f)))) - (dtsi* () (nm parent) ([fld : ty] ...) #:type-only) - #,(ignore #'(require/contract pred (any/c . c-> . boolean?) lib)) - #,(internal #'(require/typed-internal pred (Any -> Boolean : nm))) - (require/typed maker nm lib #:struct-maker parent) - (require/typed lib - [sel (nm -> ty)]) ...))])) + [sel (nm -> ty)]) ...)))])) (define-syntax (do: stx) (syntax-parse stx #:literals (:) diff --git a/collects/typed-scheme/scribblings/reference/special-forms.scrbl b/collects/typed-scheme/scribblings/reference/special-forms.scrbl index a7ddceceec..a9a050316f 100644 --- a/collects/typed-scheme/scribblings/reference/special-forms.scrbl +++ b/collects/typed-scheme/scribblings/reference/special-forms.scrbl @@ -318,10 +318,15 @@ naming a predicate, and @racket[_r] is an optionally-renamed identifier. @defform/subs[#:literals (struct opaque) (require/typed m rt-clause ...) ([rt-clause [r t] - [struct name ([f : t] ...)] - [struct (name parent) ([f : t] ...)] - [opaque t pred]]) -]{This form requires identifiers from the module @racket[m], giving + [struct name ([f : t] ...) + struct-option ...] + [struct (name parent) ([f : t] ...) + struct-option ...] + [opaque t pred]] + [struct-option + (code:line #:constructor-name constructor-id) + (code:line #:extra-constructor-name constructor-id)])] +{This form requires identifiers from the module @racket[m], giving them the specified types. The first form requires @racket[r], giving it type @racket[t]. @@ -339,15 +344,15 @@ Racket. @ex[(module UNTYPED racket/base (define n 100) - (define-struct IntTree + (struct IntTree (elem left right)) (provide n (struct-out IntTree))) (module TYPED typed/racket - (require/typed 'UNTYPED + (require/typed 'UNTYPED [n Natural] - [struct IntTree + [struct IntTree ([elem : Integer] [left : IntTree] [right : IntTree])]))] diff --git a/collects/typed-scheme/typecheck/tc-toplevel.rkt b/collects/typed-scheme/typecheck/tc-toplevel.rkt index 4f82ea97e5..b658ac06fc 100644 --- a/collects/typed-scheme/typecheck/tc-toplevel.rkt +++ b/collects/typed-scheme/typecheck/tc-toplevel.rkt @@ -115,6 +115,9 @@ [(define-values () (begin (quote-syntax (define-typed-struct-internal nm ([fld : ty] ...) #:type-only)) (#%plain-app values))) (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) #:type-only #t)] + [(define-values () (begin (quote-syntax (define-typed-struct-internal nm ([fld : ty] ...) #:maker m #:type-only)) + (#%plain-app values))) + (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) #:maker #'m #:type-only #t)] ;; define-typed-struct w/ polymorphism [(define-values () (begin (quote-syntax (define-typed-struct-internal (vars ...) nm ([fld : ty] ...) #:mutable)) (#%plain-app values))) (tc/poly-struct (syntax->list #'(vars ...)) #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) #:mutable #t)] diff --git a/collects/typed/net/cgi.rkt b/collects/typed/net/cgi.rkt index ee070c7874..be05003bb2 100644 --- a/collects/typed/net/cgi.rkt +++ b/collects/typed/net/cgi.rkt @@ -2,10 +2,10 @@ (require typed/private/utils) -(require-typed-struct cgi-error () net/cgi) +(require-typed-struct cgi-error () #:extra-constructor-name make-cgi-error net/cgi) -(require-typed-struct (incomplete-%-suffix cgi-error) ([chars : (Listof Char)]) net/cgi) -(require-typed-struct (invalid-%-suffix cgi-error) ([char : Char]) net/cgi) +(require-typed-struct (incomplete-%-suffix cgi-error) ([chars : (Listof Char)]) #:extra-constructor-name make-incomplete-%-suffix net/cgi) +(require-typed-struct (invalid-%-suffix cgi-error) ([char : Char]) #:extra-constructor-name make-invalid-%-suffix net/cgi) (require/typed/provide net/cgi diff --git a/collects/typed/net/cookie.rkt b/collects/typed/net/cookie.rkt index fd55ea08d8..7381d7f2e3 100644 --- a/collects/typed/net/cookie.rkt +++ b/collects/typed/net/cookie.rkt @@ -18,6 +18,6 @@ [get-cookie (String String -> (Listof String))] [get-cookie/single (String String -> (Option String))]) -(require-typed-struct (cookie-error exn:fail) () net/cookie) +(require-typed-struct (cookie-error exn:fail) () #:extra-constructor-name make-cookie-error net/cookie) (provide Cookie cookie? (struct-out cookie-error)) diff --git a/collects/typed/net/mime.rkt b/collects/typed/net/mime.rkt index 8abfaddb75..d86e674a29 100644 --- a/collects/typed/net/mime.rkt +++ b/collects/typed/net/mime.rkt @@ -10,6 +10,7 @@ [read : String] [size : Number] [params : (Listof (Pair Symbol String))]) + #:extra-constructor-name make-disposition net/mime) (require-typed-struct entity ([type : (U Symbol String)] [subtype : (U Symbol String)] @@ -23,9 +24,11 @@ [fields : (Listof String)] [parts : (Listof String) ] [body : (Output-Port -> Void)]) + #:extra-constructor-name make-entity net/mime) (require-typed-struct message ([version : String] [entity : entity] [fields : (Listof Symbol)]) + #:extra-constructor-name make-message net/mime) diff --git a/collects/typed/net/nntp.rkt b/collects/typed/net/nntp.rkt index b66b7a53a1..e4002ac897 100644 --- a/collects/typed/net/nntp.rkt +++ b/collects/typed/net/nntp.rkt @@ -4,6 +4,7 @@ (require-typed-struct/provide communicator ([sender : Number] [receiver : Number] [server : String] [port : Number]) + #:extra-constructor-name make-communicator net/nntp) (require/typed/provide net/nntp @@ -18,14 +19,24 @@ [make-desired-header (String -> String)] [extract-desired-headers ((Listof String) (Listof String) -> (Listof String))]) -(require-typed-struct/provide (nntp exn:fail) () net/nntp) -(require-typed-struct/provide (unexpected-response nntp) ([code : Number] [text : String]) net/nntp) -(require-typed-struct/provide (bad-status-line nntp) ([line : String]) net/nntp) -(require-typed-struct/provide (premature-close nntp) ([communicator : communicator]) net/nntp) -(require-typed-struct/provide (bad-newsgroup-line nntp) ([line : String]) net/nntp) -(require-typed-struct/provide (non-existent-group nntp) ([group : String]) net/nntp) -(require-typed-struct/provide (article-not-in-group nntp) ([article : Number]) net/nntp) -(require-typed-struct/provide (no-group-selected nntp) () net/nntp) -(require-typed-struct/provide (article-not-found nntp) ([article : Number]) net/nntp) -(require-typed-struct/provide (authentication-rejected nntp) () net/nntp) +(require-typed-struct/provide (nntp exn:fail) + () #:extra-constructor-name make-nntp net/nntp) +(require-typed-struct/provide (unexpected-response nntp) + ([code : Number] [text : String]) #:extra-constructor-name make-unexpected-response net/nntp) +(require-typed-struct/provide (bad-status-line nntp) + ([line : String]) #:extra-constructor-name make-bad-status-line net/nntp) +(require-typed-struct/provide (premature-close nntp) + ([communicator : communicator]) #:extra-constructor-name make-premature-close net/nntp) +(require-typed-struct/provide (bad-newsgroup-line nntp) + ([line : String]) #:extra-constructor-name make-bad-newsgroup-line net/nntp) +(require-typed-struct/provide (non-existent-group nntp) + ([group : String]) #:extra-constructor-name make-non-existent-group net/nntp) +(require-typed-struct/provide (article-not-in-group nntp) + ([article : Number]) #:extra-constructor-name make-article-not-in-group net/nntp) +(require-typed-struct/provide (no-group-selected nntp) + () #:extra-constructor-name make-no-group-selected net/nntp) +(require-typed-struct/provide (article-not-found nntp) + ([article : Number]) #:extra-constructor-name make-article-not-found net/nntp) +(require-typed-struct/provide (authentication-rejected nntp) + () #:extra-constructor-name make-authentication-rejected net/nntp) diff --git a/collects/typed/net/pop3.rkt b/collects/typed/net/pop3.rkt index 03020a7508..41b296e164 100644 --- a/collects/typed/net/pop3.rkt +++ b/collects/typed/net/pop3.rkt @@ -4,6 +4,7 @@ (require-typed-struct/provide communicator ([sender : Number] [receiver : Number] [server : String] [port : Number] [state : Symbol]) + #:extra-constructor-name make-communicator net/pop3) (require/typed/provide net/pop3 @@ -23,20 +24,31 @@ [extract-desired-headers ((Listof String)(Listof String)-> (Listof String))]) -(require-typed-struct/provide (pop3 exn) () net/pop3) -(require-typed-struct/provide (cannot-connect pop3) () net/pop3) -(require-typed-struct/provide (username-rejected pop3) () net/pop3) -(require-typed-struct/provide (password-rejected pop3) () net/pop3) -(require-typed-struct/provide (not-ready-for-transaction pop3) - ([communicator : communicator]) net/pop3) -(require-typed-struct/provide (not-given-headers pop3) - ([communicator : communicator] [message : Integer]) net/pop3) -(require-typed-struct/provide (illegal-message-number pop3) - ([communicator : communicator] [message : Integer]) net/pop3) -(require-typed-struct/provide (cannot-delete-message pop3) - ([communicator : communicator] [message : Integer]) net/pop3) -(require-typed-struct/provide (disconnect-not-quiet pop3) - ([communicator : communicator]) net/pop3) -(require-typed-struct/provide (malformed-server-response pop3) - ([communicator : communicator]) net/pop3) +(require-typed-struct/provide (pop3 exn) + () #:extra-constructor-name make-pop3 net/pop3) +(require-typed-struct/provide (cannot-connect pop3) + () #:extra-constructor-name make-cannot-connect net/pop3) +(require-typed-struct/provide (username-rejected pop3) + () #:extra-constructor-name make-username-rejected net/pop3) +(require-typed-struct/provide (password-rejected pop3) + () #:extra-constructor-name make-password-rejected net/pop3) + +(require-typed-struct/provide (not-ready-for-transaction pop3) + ([communicator : communicator]) + #:extra-constructor-name make-not-ready-for-transaction net/pop3) +(require-typed-struct/provide (not-given-headers pop3) + ([communicator : communicator] [message : Integer]) + #:extra-constructor-name make-not-given-headers net/pop3) +(require-typed-struct/provide (illegal-message-number pop3) + ([communicator : communicator] [message : Integer]) + #:extra-constructor-name make-illegal-message-number net/pop3) +(require-typed-struct/provide (cannot-delete-message pop3) + ([communicator : communicator] [message : Integer]) + #:extra-constructor-name make-cannot-delete-message net/pop3) +(require-typed-struct/provide (disconnect-not-quiet pop3) + ([communicator : communicator]) + #:extra-constructor-name make-disconnect-not-quiet net/pop3) +(require-typed-struct/provide (malformed-server-response pop3) + ([communicator : communicator]) + #:extra-constructor-name make-malformed-server-response net/pop3)