Support require/typed clauses in require/typed/provide
Closes PR 13901
This commit is contained in:
parent
270ca41e4a
commit
4dcfe9b8b9
|
@ -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 ()
|
||||
|
|
|
@ -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)
|
||||
|
Loading…
Reference in New Issue
Block a user