add #:generate keyword to build-flat-contract-property

the public function was missing the `#:generate` keyword,
 added this and documented why `#:exercise` is missing
This commit is contained in:
Ben Greenman 2017-04-02 14:45:47 -04:00
parent d224da3105
commit 3bb131ecb2
3 changed files with 61 additions and 17 deletions

View File

@ -2666,16 +2666,6 @@ returns @racket[#f] but @racket[value-blame] returns @racket[#f].
(or/c (-> (or/c contract-random-generate-fail? c))
#f))]))
(λ (c) (λ (fuel) #f))]
[#:exercise
exercise
(->i ([c contract?])
([result
(c)
(-> (and/c positive? real?)
(values
(-> c void?)
(listof contract?)))]))
(λ (c) (λ (fuel) (values void '())))]
[#:list-contract? is-list-contract? (-> contract? boolean?) (λ (c) #f)])
flat-contract-property?]
@defproc[(build-chaperone-contract-property
@ -2832,15 +2822,21 @@ compared with the original, uncontracted value.
A @deftech{flat contract property} specifies the behavior of a structure when
used as a @tech{flat contract}. It is specified using
@racket[build-flat-contract-property], and accepts exactly the same set of
arguments as @racket[build-contract-property]. The only difference is that the
projection accessor is expected not to wrap its argument in a higher-order
fashion, analogous to the constraint on projections in
@racket[make-flat-contract].
@racket[build-flat-contract-property], and accepts similar
arguments as @racket[build-contract-property]. The differences are:
@itemlist[
@item{the projection accessor is expected not to wrap its argument in a
higher-order fashion, analogous to the constraint on projections in
@racket[make-flat-contract];}
@item{the @racket[#:exercise] keyword argument is omitted because it is not
relevant for flat contracts.}]
@history[#:changed "6.0.1.13" @list{Added the @racket[#:list-contract?] argument.}
#:changed "6.1.1.4"
@list{Allow @racket[generate] to return @racket[contract-random-generate-fail]}]
#:changed "6.1.1.4"
@list{Allow @racket[generate] to return @racket[contract-random-generate-fail].}
#:changed "6.8.0.2"
@list{Removed the @racket[#:exercise] keyword argument from
@racket[build-flat-contract-property].}]
}
@deftogether[(

View File

@ -364,3 +364,49 @@
(λ (x) (if x 'fail 11))
'pos
'neg))
(let () ;; test generate / exercise for `build-flat-contract-property contracts
(define even-list/c
(let ()
(struct ctc ()
#:property
prop:flat-contract
(build-flat-contract-property
#:name (λ (c) 'even-list/c)
#:first-order (λ (c) (λ (v) (and (list? v) (andmap even? v))))
#:late-neg-projection
(λ (c)
(λ (b)
(λ (v neg-party)
(unless (and (list? v) (andmap even? v))
(raise-blame-error b v
#:missing-party neg-party
"expected even list, got ~v" v))
(map values v))))))
(ctc)))
(define even-list/c/generate
(let ()
(struct ctc ()
#:property
prop:flat-contract
(build-flat-contract-property
#:name (λ (c) 'even-list/c)
#:first-order (λ (c) (λ (v) (and (list? v) (andmap even? v))))
#:late-neg-projection
(λ (c)
(λ (b)
(λ (v neg-party)
(unless (and (list? v) (andmap even? v))
(raise-blame-error b v
#:missing-party neg-party
"expected even list, got ~v" v))
(map values v))))
#:generate
(λ (c)
(λ (fuel)
(λ () '(2))))))
(ctc)))
(check-exn cannot-generate-exn? (λ () (test-contract-generation even-list/c)))
(check-not-exn (λ () (test-contract-generation even-list/c/generate)))
(check-exercise 2 void? even-list/c)
(check-exercise 2 void? even-list/c/generate))

View File

@ -238,6 +238,7 @@
#:val-first-projection [val-first-projection #f]
#:projection [projection #f]
#:stronger [stronger #f]
#:generate [generate (λ (ctc) (λ (fuel) #f))]
#:list-contract? [is-list-contract #f])
(:build-flat-contract-property
#:name name
@ -249,6 +250,7 @@
#:projection
(and projection (λ (c) (force-projection-eq (projection c))))
#:stronger stronger
#:generate generate
#:list-contract? is-list-contract))])
build-flat-contract-property))