Skip to content

Patched require/untyped-contract to accept a language spec. #1330

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Open
wants to merge 4 commits into
base: master
Choose a base branch
from
Open

Patched require/untyped-contract to accept a language spec. #1330

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
4 commits
Select commit Hold shift + click to select a range
78a113d
Patched require/untyped-contract to accept a language spec.
Rscho314 Jun 11, 2023
e79447f
fix: make language spec optional in require/untyped-contract
Rscho314 Jun 14, 2023
6c91bf3
Update: require/untyped-contract docs mention optional language spec
Rscho314 Jun 14, 2023
40b0fa5
fix: datum->syntax syntax context is now #'_ (don't care context)
Rscho314 Jun 11, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
16 changes: 14 additions & 2 deletions typed-racket-doc/typed-racket/scribblings/reference/utilities.scrbl
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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.

Expand All @@ -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
Expand Down
92 changes: 49 additions & 43 deletions typed-racket-lib/typed/untyped-utils.rkt
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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] ...)
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

keep the indentation like it was

(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] ...))]))