Allow #:opaque and #:struct in require/typed.

(cherry picked from commit 9054d0db7d)
This commit is contained in:
Sam Tobin-Hochstadt 2012-10-08 16:28:54 -04:00 committed by Ryan Culpepper
parent 2bd1d9f123
commit 9086e14b5e
2 changed files with 7 additions and 10 deletions

View File

@ -101,18 +101,15 @@ This file defines two sorts of primitives. All of them are provided into any mod
(define-syntax-class (struct-clause legacy) (define-syntax-class (struct-clause legacy)
;#:literals (struct) ;#:literals (struct)
#:attributes (nm (body 1) (constructor-parts 1)) #:attributes (nm (body 1) (constructor-parts 1))
(pattern [struct nm:opt-parent (body ...) (~var constructor (opt-constructor legacy #'nm.nm))] (pattern [(~or (~datum struct) #:struct) nm:opt-parent (body ...) (~var constructor (opt-constructor legacy #'nm.nm))]
#:fail-unless (eq? 'struct (syntax-e #'struct)) #f
#:with (constructor-parts ...) #'constructor.value)) #:with (constructor-parts ...) #'constructor.value))
(define-syntax-class opaque-clause (define-syntax-class opaque-clause
;#:literals (opaque) ;#:literals (opaque)
#:attributes (ty pred opt) #:attributes (ty pred opt)
(pattern [opaque ty:id pred:id] (pattern [(~or (~datum opaque) #:opaque) ty:id pred:id]
#:fail-unless (eq? 'opaque (syntax-e #'opaque)) #f
#:with opt #'()) #:with opt #'())
(pattern [opaque ty:id pred:id #:name-exists] (pattern [(~or (~datum opaque) #:opaque) opaque ty:id pred:id #:name-exists]
#:fail-unless (eq? 'opaque (syntax-e #'opaque)) #f
#:with opt #'(#:name-exists))) #:with opt #'(#:name-exists)))
(define-syntax-class (clause legacy lib) (define-syntax-class (clause legacy lib)

View File

@ -340,14 +340,14 @@ contexts.
Here, @racket[_m] is a module spec, @racket[_pred] is an identifier Here, @racket[_m] is a module spec, @racket[_pred] is an identifier
naming a predicate, and @racket[_r] is an optionally-renamed identifier. naming a predicate, and @racket[_r] is an optionally-renamed identifier.
@defform/subs[#:literals (struct opaque) @defform/subs[#:literals (struct)
(require/typed m rt-clause ...) (require/typed m rt-clause ...)
([rt-clause [r t] ([rt-clause [r t]
[struct name ([f : t] ...) [#:struct name ([f : t] ...)
struct-option ...] struct-option ...]
[struct (name parent) ([f : t] ...) [#:struct (name parent) ([f : t] ...)
struct-option ...] struct-option ...]
[opaque t pred]] [#:opaque t pred]]
[struct-option [struct-option
(code:line #:constructor-name constructor-id) (code:line #:constructor-name constructor-id)
(code:line #:extra-constructor-name constructor-id)])] (code:line #:extra-constructor-name constructor-id)])]