allow #:chaperone specification in struct/dc

related to PR 13734
This commit is contained in:
Robby Findler 2013-05-06 18:14:46 -05:00
parent d8a444dfef
commit 2648542a6c
3 changed files with 21 additions and 9 deletions

View File

@ -562,7 +562,7 @@
(syntax-case stuff ()
[(exp) (values #'exp lazy? type depends-on-state?)]
[(flat/impersonator-kwd . more-stuff)
(memq (syntax-e #'flat/impersonator-kwd) '(#:flat #:impersonator))
(memq (syntax-e #'flat/impersonator-kwd) '(#:flat #:chaperone #:impersonator))
(begin
(check-not-both type (stx-car stuff))
(loop #'more-stuff lazy? (stx-car stuff) depends-on-state?))]

View File

@ -417,14 +417,14 @@ produced. Otherwise, an impersonator contract is produced.
([field-spec [field-name maybe-lazy contract-expr]
[field-name (dep-field-name ...)
maybe-lazy
maybe-flat-or-impersonator
maybe-contract-type
maybe-dep-state
contract-expr]]
[field-name field-id
(#:selector selector-id)
(field-id #:parent struct-id)]
[maybe-lazy (code:line) #:lazy]
[maybe-flat-or-impersonator (code:line) #:flat #:impersonator]
[maybe-contract-type (code:line) #:flat #:chaperone #:impersonator]
[maybe-dep-state (code:line) #:depends-on-state])]{
Produces a contract that recognizes instances of the structure
type named by @racket[struct-id], and whose field values match the
@ -435,7 +435,8 @@ then the contract depends on values in those fields, and the @racket[contract-ex
expression is evaluated each time a selector is applied, building a new contract
for the fields based on the values of the @racket[dep-field-name] fields (the
@racket[dep-field-name] syntax is the same as the @racket[field-name] syntax).
If the field is a dependent field, then it is assumed that the contract is
If the field is a dependent field and no @racket[contract-type] annotation
appears, then it is assumed that the contract is
a chaperone, but not always a flat contract (and thus the entire @racket[struct/dc]
contract is not a flat contract).
If this is not the case, and the contract is

View File

@ -9973,11 +9973,22 @@
'(let ()
(struct s (a b))
(contract (struct/dc s
[a () number?]
[b (a) boolean?])
(s 1 #f)
'pos
'neg)))
[a () number?]
[b (a) boolean?])
(s 1 #f)
'pos
'neg)))
(test/spec-passed
'struct/dc-1a
'(let ()
(struct s (a b))
(contract (struct/dc s
[a () number?]
[b (a) #:chaperone boolean?])
(s 1 #f)
'pos
'neg)))
(test/spec-passed
'struct/dc-2