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:
parent
d224da3105
commit
3bb131ecb2
|
@ -2666,16 +2666,6 @@ returns @racket[#f] but @racket[value-blame] returns @racket[#f].
|
||||||
(or/c (-> (or/c contract-random-generate-fail? c))
|
(or/c (-> (or/c contract-random-generate-fail? c))
|
||||||
#f))]))
|
#f))]))
|
||||||
(λ (c) (λ (fuel) #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)])
|
[#:list-contract? is-list-contract? (-> contract? boolean?) (λ (c) #f)])
|
||||||
flat-contract-property?]
|
flat-contract-property?]
|
||||||
@defproc[(build-chaperone-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
|
A @deftech{flat contract property} specifies the behavior of a structure when
|
||||||
used as a @tech{flat contract}. It is specified using
|
used as a @tech{flat contract}. It is specified using
|
||||||
@racket[build-flat-contract-property], and accepts exactly the same set of
|
@racket[build-flat-contract-property], and accepts similar
|
||||||
arguments as @racket[build-contract-property]. The only difference is that the
|
arguments as @racket[build-contract-property]. The differences are:
|
||||||
projection accessor is expected not to wrap its argument in a higher-order
|
@itemlist[
|
||||||
fashion, analogous to the constraint on projections in
|
@item{the projection accessor is expected not to wrap its argument in a
|
||||||
@racket[make-flat-contract].
|
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.}
|
@history[#:changed "6.0.1.13" @list{Added the @racket[#:list-contract?] argument.}
|
||||||
#:changed "6.1.1.4"
|
#:changed "6.1.1.4"
|
||||||
@list{Allow @racket[generate] to return @racket[contract-random-generate-fail]}]
|
@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[(
|
@deftogether[(
|
||||||
|
|
|
@ -364,3 +364,49 @@
|
||||||
(λ (x) (if x 'fail 11))
|
(λ (x) (if x 'fail 11))
|
||||||
'pos
|
'pos
|
||||||
'neg))
|
'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))
|
||||||
|
|
|
@ -238,6 +238,7 @@
|
||||||
#:val-first-projection [val-first-projection #f]
|
#:val-first-projection [val-first-projection #f]
|
||||||
#:projection [projection #f]
|
#:projection [projection #f]
|
||||||
#:stronger [stronger #f]
|
#:stronger [stronger #f]
|
||||||
|
#:generate [generate (λ (ctc) (λ (fuel) #f))]
|
||||||
#:list-contract? [is-list-contract #f])
|
#:list-contract? [is-list-contract #f])
|
||||||
(:build-flat-contract-property
|
(:build-flat-contract-property
|
||||||
#:name name
|
#:name name
|
||||||
|
@ -249,6 +250,7 @@
|
||||||
#:projection
|
#:projection
|
||||||
(and projection (λ (c) (force-projection-eq (projection c))))
|
(and projection (λ (c) (force-projection-eq (projection c))))
|
||||||
#:stronger stronger
|
#:stronger stronger
|
||||||
|
#:generate generate
|
||||||
#:list-contract? is-list-contract))])
|
#:list-contract? is-list-contract))])
|
||||||
build-flat-contract-property))
|
build-flat-contract-property))
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user