From 78a113d76f7f244c7ea78687cae2d038b63c9a5e Mon Sep 17 00:00:00 2001 From: Raoul Schorer Date: Sun, 11 Jun 2023 22:49:05 +0200 Subject: [PATCH 1/4] Patched require/untyped-contract to accept a language spec. --- typed-racket-lib/typed/untyped-utils.rkt | 19 +++++++++---------- 1 file changed, 9 insertions(+), 10 deletions(-) diff --git a/typed-racket-lib/typed/untyped-utils.rkt b/typed-racket-lib/typed/untyped-utils.rkt index 4545aaafc..f0c939a7a 100644 --- a/typed-racket-lib/typed/untyped-utils.rkt +++ b/typed-racket-lib/typed/untyped-utils.rkt @@ -29,8 +29,8 @@ (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] ...) + (syntax-parse stx #:literals (begin quote) + [(_ (begin form ...) from-module-spec:expr (quote language-spec:id) [name:id T:expr] ...) (with-syntax* ([(typed-name ...) (generate-temporaries #'(name ...))] [(untyped-name ...) (freshen #'(name ...))] [(untyped2-name ...) (generate-temporaries #'(name ...))] @@ -39,10 +39,9 @@ [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)] + [*typed/racket (datum->syntax #'from-module-spec (format-symbol "~a" (syntax-e #'language-spec)))] + [*require (datum->syntax #'from-module-spec 'require)] + [*language-spec (datum->syntax #'racket/base (format-symbol "~a" (syntax-e #'language-spec)))] [from-module-spec-for-submod (syntax-parse #'from-module-spec #:literals (submod) [(submod (~and base (~or "." "..")) elem ...) @@ -50,8 +49,8 @@ [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. + (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] ...)) @@ -70,5 +69,5 @@ (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] ...))])) + [(_ from-module-spec:expr (quote language-spec:id) [name:id T:expr] ...) + (syntax/loc stx (require/untyped-contract (begin) from-module-spec (quote language-spec) [name T] ...))])) From e79447f0187f95fb11f32dedac5cbe8af5e46f20 Mon Sep 17 00:00:00 2001 From: Raoul Schorer Date: Wed, 14 Jun 2023 23:41:37 +0200 Subject: [PATCH 2/4] fix: make language spec optional in require/untyped-contract Added cases to allow optional language spec, and removed redundant format-symbol --- typed-racket-lib/typed/untyped-utils.rkt | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) diff --git a/typed-racket-lib/typed/untyped-utils.rkt b/typed-racket-lib/typed/untyped-utils.rkt index f0c939a7a..717ef742e 100644 --- a/typed-racket-lib/typed/untyped-utils.rkt +++ b/typed-racket-lib/typed/untyped-utils.rkt @@ -30,7 +30,7 @@ (define-syntax (require/untyped-contract stx) (syntax-parse stx #:literals (begin quote) - [(_ (begin form ...) from-module-spec:expr (quote language-spec:id) [name:id T:expr] ...) + [(_ (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 ...))] @@ -39,9 +39,9 @@ [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 (format-symbol "~a" (syntax-e #'language-spec)))] + [*typed/racket (datum->syntax #'from-module-spec (syntax-e #'language-spec))] [*require (datum->syntax #'from-module-spec 'require)] - [*language-spec (datum->syntax #'racket/base (format-symbol "~a" (syntax-e #'language-spec)))] + [*language-spec (datum->syntax #'racket/base (syntax-e #'language-spec))] [from-module-spec-for-submod (syntax-parse #'from-module-spec #:literals (submod) [(submod (~and base (~or "." "..")) elem ...) @@ -69,5 +69,9 @@ (define-typed/untyped-identifier macro-name typed-name untyped3-name) ...) (require (rename-in (submod "." untyped-module) [macro-name name] ...)))))] - [(_ from-module-spec:expr (quote language-spec:id) [name:id T:expr] ...) - (syntax/loc stx (require/untyped-contract (begin) from-module-spec (quote language-spec) [name T] ...))])) + [(_ 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] ...))])) From 6c91bf3bca2eba2882d08a720f97c1525c4c6568 Mon Sep 17 00:00:00 2001 From: Raoul Schorer Date: Thu, 15 Jun 2023 00:13:21 +0200 Subject: [PATCH 3/4] Update: require/untyped-contract docs mention optional language spec --- .../scribblings/reference/utilities.scrbl | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) 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 From 40b0fa5568ba58686eddb7a0c0595ea7d09496d2 Mon Sep 17 00:00:00 2001 From: Raoul Schorer Date: Wed, 12 Jun 2024 01:02:24 +0200 Subject: [PATCH 4/4] fix: datum->syntax syntax context is now #'_ (don't care context) --- typed-racket-lib/typed/untyped-utils.rkt | 93 ++++++++++++------------ 1 file changed, 48 insertions(+), 45 deletions(-) diff --git a/typed-racket-lib/typed/untyped-utils.rkt b/typed-racket-lib/typed/untyped-utils.rkt index 717ef742e..dc6fd5208 100644 --- a/typed-racket-lib/typed/untyped-utils.rkt +++ b/typed-racket-lib/typed/untyped-utils.rkt @@ -30,48 +30,51 @@ (define-syntax (require/untyped-contract stx) (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 #'racket/base (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] ...))])) + [(_ (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] ...))]))