diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt index f8026206d5..49ffa20f7e 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/base-env/prims.rkt @@ -174,10 +174,34 @@ This file defines two sorts of primitives. All of them are provided into any mod #,(ignore #'(require/contract nm.spec hidden cnt* lib))))])) (values (r/t-maker #t) (r/t-maker #f)))) -(define-syntax-rule (require/typed/provide lib [nm t] ...) - (begin - (require/typed lib [nm t] ...) - (provide nm ...))) +(define-syntax (require/typed/provide stx) + (unless (memq (syntax-local-context) '(module module-begin)) + (raise-syntax-error 'require/typed/provide + "can only be used at module top-level")) + (syntax-parse stx + [(_ lib) #'(begin)] + [(_ lib [r:id t] other-clause ...) + #'(begin (require/typed lib [r t]) + (provide r) + (require/typed/provide lib other-clause ...))] + [(_ lib (~and clause [#:struct name:id ([f:id (~datum :) t] ...) + option ...]) + other-clause ...) + #'(begin (require/typed lib clause) + (provide (struct-out name)) + (require/typed/provide lib other-clause ...))] + [(_ lib (~and clause [#:struct (name:id parent:id) + ([f:id (~datum :) t] ...) + option ...]) + other-clause ...) + #'(begin (require/typed lib clause) + (provide (struct-out name)) + (require/typed/provide lib other-clause ...))] + [(_ lib (~and clause [#:opaque t:id pred:id]) + other-clause ...) + #'(begin (require/typed lib clause) + (provide t pred) + (require/typed/provide lib other-clause ...))])) (define-syntax require-typed-struct/provide (syntax-rules () diff --git a/pkgs/typed-racket-pkgs/typed-racket-tests/tests/typed-racket/succeed/pr13901.rkt b/pkgs/typed-racket-pkgs/typed-racket-tests/tests/typed-racket/succeed/pr13901.rkt new file mode 100644 index 0000000000..17cb1526b7 --- /dev/null +++ b/pkgs/typed-racket-pkgs/typed-racket-tests/tests/typed-racket/succeed/pr13901.rkt @@ -0,0 +1,40 @@ +#lang racket/load + +;; This test ensures that require/typed/provide works for +;; all of the clauses that are documented for require/typed + +(require rackunit) + +(module a typed/racket + (require/typed/provide + racket/base + [#:opaque Evt evt?] + [never-evt Evt])) +(require 'a) + +(check-false (evt? 5)) +(check-true (evt? never-evt)) + +(module b-provider racket + (struct foo (value)) + (provide (struct-out foo))) + +(module b typed/racket + (require/typed/provide + 'b-provider + [#:struct foo ([value : Exact-Nonnegative-Integer])])) +(require 'b) + +(module c-provider racket + (struct bar (x)) + (struct baz bar (y z)) + (provide (struct-out bar) + (struct-out baz))) + +(module c typed/racket + (require/typed/provide + 'c-provider + [#:struct bar ([x : Integer])] + [#:struct (baz bar) ([y : String] [z : String])])) +(require 'c) +