diff --git a/typed-racket-doc/typed-racket/scribblings/reference/utilities.scrbl b/typed-racket-doc/typed-racket/scribblings/reference/utilities.scrbl index 1a1806442..6752a9b9a 100644 --- a/typed-racket-doc/typed-racket/scribblings/reference/utilities.scrbl +++ b/typed-racket-doc/typed-racket/scribblings/reference/utilities.scrbl @@ -110,8 +110,9 @@ syntax transformers that must expand differently in typed and untyped contexts. @history[#:changed "1.14" @elem{The module moved from @tt{typed-racket-more} to @tt{typed-racket-lib}.}] -@defform*/subs[[(require/untyped-contract maybe-begin module [name subtype] ...)] - ([maybe-begin code:blank (code:line (begin expr ...))])]{ +@defform*/subs[[(require/untyped-contract maybe-begin module maybe-language-spec [name subtype] ...)] + ([maybe-begin code:blank (code:line (begin expr ...))] + [maybe-language-spec identifier?])]{ Use this form to import typed identifiers whose types cannot be converted into contracts, but have @emph{subtypes} that can be converted into contracts. @@ -130,6 +131,17 @@ it can be imported and used in untyped code this way: The type @racket[(-> Integer Integer)] is converted into the contract used for @racket[negate]. +Additionally, if the defining module for the imported identifier uses a Typed Racket +variant such as Shallow Typed Racket, @racket[require/untyped-contract] can be directed +to use the appropriate language by providing a language specification: +@racketblock[(require/untyped-contract + "my-numerics.rkt" + typed/racket/shallow + [negate (-> Integer Integer)])] +The type @racket[(-> Integer Integer)] is then expanded to a contract in the context of the +chosen language variant. Omitting the language specification uses the default @racket[typed/racket/base] +language as the expansion context. + The @racket[require/untyped-contract] form expands into a submodule with language @racketmodname[typed/racket/base]. Identifiers used in @racket[subtype] expressions must be either in Typed Racket's base type diff --git a/typed-racket-lib/typed/untyped-utils.rkt b/typed-racket-lib/typed/untyped-utils.rkt index 4545aaafc..dc6fd5208 100644 --- a/typed-racket-lib/typed/untyped-utils.rkt +++ b/typed-racket-lib/typed/untyped-utils.rkt @@ -29,46 +29,52 @@ (stx-map (lambda (id) ((make-syntax-introducer) id)) ids)) (define-syntax (require/untyped-contract stx) - (syntax-parse stx #:literals (begin) - [(_ (begin form ...) from-module-spec:expr [name:id T:expr] ...) - (with-syntax* ([(typed-name ...) (generate-temporaries #'(name ...))] - [(untyped-name ...) (freshen #'(name ...))] - [(untyped2-name ...) (generate-temporaries #'(name ...))] - [(untyped3-name ...) (generate-temporaries #'(name ...))] - [(macro-name ...) (generate-temporaries #'(name ...))] - [typed-module (generate-temporary #'typed-module)] - [untyped-module (generate-temporary #'untyped-module)] - [*racket/base (datum->syntax #'from-module-spec 'racket/base)] - [*typed/racket/base (datum->syntax #'from-module-spec - 'typed/racket/base)] - [*require (datum->syntax #'from-module-spec - 'require)] - [from-module-spec-for-submod - (syntax-parse #'from-module-spec #:literals (submod) - [(submod (~and base (~or "." "..")) elem ...) - (syntax/loc #'from-module-spec (submod base ".." elem ...))] - [x #'x])]) - (syntax/loc stx - (begin - (module typed-module *typed/racket/base ; to bind in `T`s - (*require typed/racket/base) ; to bind introduced `begin`, etc. - (begin form ...) - (require (only-in from-module-spec-for-submod - [name untyped2-name] ...)) - (provide untyped-name ...) - (: untyped-name T) ... - (define untyped-name untyped2-name) ...) - - (module untyped-module *racket/base - (*require racket/base) - (require typed/untyped-utils - (only-in from-module-spec-for-submod - [name typed-name] ...) - (only-in (submod ".." typed-module) - [untyped-name untyped3-name] ...)) - (provide macro-name ...) - (define-typed/untyped-identifier macro-name typed-name untyped3-name) ...) - - (require (rename-in (submod "." untyped-module) [macro-name name] ...)))))] - [(_ from-module-spec:expr [name:id T:expr] ...) - (syntax/loc stx (require/untyped-contract (begin) from-module-spec [name T] ...))])) + (syntax-parse stx #:literals (begin quote) + [(_ (begin form ...) from-module-spec:expr language-spec:id [name:id T:expr] ...) + (with-syntax* ([(typed-name ...) (generate-temporaries #'(name ...))] + [(untyped-name ...) (freshen #'(name ...))] + [(untyped2-name ...) (generate-temporaries #'(name ...))] + [(untyped3-name ...) (generate-temporaries #'(name ...))] + [(macro-name ...) (generate-temporaries #'(name ...))] + [typed-module (generate-temporary #'typed-module)] + [untyped-module (generate-temporary #'untyped-module)] + [*racket/base (datum->syntax #'from-module-spec 'racket/base + )] + [*typed/racket (datum->syntax #'from-module-spec (syntax-e #'language-spec) + )] + [*require (datum->syntax #'from-module-spec 'require)] + [*language-spec (datum->syntax #'_ (syntax-e #'language-spec) + )] + [from-module-spec-for-submod + (syntax-parse #'from-module-spec #:literals (submod) + [(submod (~and base (~or "." "..")) elem ...) + (syntax/loc #'from-module-spec (submod base ".." elem ...))] + [x #'x])]) + (syntax/loc stx + (begin + (module typed-module *typed/racket ; to bind in `T`s + (*require *language-spec) ; to bind introduced `begin`, etc. + (begin form ...) + (require (only-in from-module-spec-for-submod + [name untyped2-name] ...)) + (provide untyped-name ...) + (: untyped-name T) ... + (define untyped-name untyped2-name) ...) + + (module untyped-module *racket/base + (*require racket/base) + (require typed/untyped-utils + (only-in from-module-spec-for-submod + [name typed-name] ...) + (only-in (submod ".." typed-module) + [untyped-name untyped3-name] ...)) + (provide macro-name ...) + (define-typed/untyped-identifier macro-name typed-name untyped3-name) ...) + + (require (rename-in (submod "." untyped-module) [macro-name name] ...)))))] + [(_ from-module-spec:expr language-spec:id [name:id T:expr] ...) + (syntax/loc stx (require/untyped-contract (begin) from-module-spec language-spec [name T] ...))] + [(_ (begin form ...) from-module-spec:expr [name:id T:expr] ...) + (syntax/loc stx (require/untyped-contract (begin form ...) from-module-spec typed/racket/base [name T] ...))] + [(_ from-module-spec:expr [name:id T:expr] ...) + (syntax/loc stx (require/untyped-contract (begin) from-module-spec typed/racket/base [name T] ...))]))