Support require/typed clauses in require/typed/provide

Closes PR 13901
This commit is contained in:
Asumu Takikawa 2013-07-02 15:57:15 -04:00
parent 270ca41e4a
commit 4dcfe9b8b9
2 changed files with 68 additions and 4 deletions

View File

@ -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 ()

View File

@ -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)