added the #:generator argument to the contract property maker
This commit is contained in:
parent
4587795d40
commit
bcbdcc2eaf
|
@ -27,7 +27,7 @@
|
||||||
;;
|
;;
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define-struct contract-property [ name first-order projection stronger ]
|
(define-struct contract-property [ name first-order projection stronger generator ]
|
||||||
#:omit-define-syntaxes)
|
#:omit-define-syntaxes)
|
||||||
|
|
||||||
(define (contract-property-guard prop info)
|
(define (contract-property-guard prop info)
|
||||||
|
@ -112,7 +112,8 @@
|
||||||
#:name [get-name #f]
|
#:name [get-name #f]
|
||||||
#:first-order [get-first-order #f]
|
#:first-order [get-first-order #f]
|
||||||
#:projection [get-projection #f]
|
#:projection [get-projection #f]
|
||||||
#:stronger [stronger #f])
|
#:stronger [stronger #f]
|
||||||
|
#:generator [generator #f])
|
||||||
|
|
||||||
(let* ([get-name (or get-name (lambda (c) default-name))]
|
(let* ([get-name (or get-name (lambda (c) default-name))]
|
||||||
[get-first-order (or get-first-order get-any?)]
|
[get-first-order (or get-first-order get-any?)]
|
||||||
|
@ -121,7 +122,7 @@
|
||||||
get-name get-first-order))]
|
get-name get-first-order))]
|
||||||
[stronger (or stronger weakest)])
|
[stronger (or stronger weakest)])
|
||||||
|
|
||||||
(mk get-name get-first-order get-projection stronger)))
|
(mk get-name get-first-order get-projection stronger generator)))
|
||||||
|
|
||||||
(define build-contract-property
|
(define build-contract-property
|
||||||
(build-property make-contract-property 'anonymous-contract))
|
(build-property make-contract-property 'anonymous-contract))
|
||||||
|
@ -156,7 +157,8 @@
|
||||||
(lambda (c) (make-contract-name c))
|
(lambda (c) (make-contract-name c))
|
||||||
(lambda (c) (make-contract-first-order c))
|
(lambda (c) (make-contract-first-order c))
|
||||||
(lambda (c) (make-contract-projection c))
|
(lambda (c) (make-contract-projection c))
|
||||||
(lambda (a b) ((make-contract-stronger a) a b))))
|
(lambda (a b) ((make-contract-stronger a) a b))
|
||||||
|
#f))
|
||||||
|
|
||||||
(define-struct make-flat-contract [ name first-order projection stronger ]
|
(define-struct make-flat-contract [ name first-order projection stronger ]
|
||||||
#:omit-define-syntaxes
|
#:omit-define-syntaxes
|
||||||
|
@ -166,7 +168,8 @@
|
||||||
(lambda (c) (make-flat-contract-name c))
|
(lambda (c) (make-flat-contract-name c))
|
||||||
(lambda (c) (make-flat-contract-first-order c))
|
(lambda (c) (make-flat-contract-first-order c))
|
||||||
(lambda (c) (make-flat-contract-projection c))
|
(lambda (c) (make-flat-contract-projection c))
|
||||||
(lambda (a b) ((make-flat-contract-stronger a) a b)))))
|
(lambda (a b) ((make-flat-contract-stronger a) a b))
|
||||||
|
#f)))
|
||||||
|
|
||||||
(define ((build-contract mk default-name)
|
(define ((build-contract mk default-name)
|
||||||
#:name [name #f]
|
#:name [name #f]
|
||||||
|
|
|
@ -1246,7 +1246,15 @@ constructed by @scheme[build-flat-contract-property].
|
||||||
(if ((get-first-order c) x)
|
(if ((get-first-order c) x)
|
||||||
x
|
x
|
||||||
(raise-blame-error
|
(raise-blame-error
|
||||||
b x "expected <~a>, given: ~e" (get-name c) x)))))])
|
b x "expected <~a>, given: ~e" (get-name c) x)))))]
|
||||||
|
[#:stronger
|
||||||
|
stronger
|
||||||
|
(or/c (-> contract? contract? boolean?) #f)
|
||||||
|
#f]
|
||||||
|
[#:generator
|
||||||
|
generator
|
||||||
|
(or/c (-> number? (listof (list any/c contract?)) any/c) #f)
|
||||||
|
#f])
|
||||||
flat-contract-property?]
|
flat-contract-property?]
|
||||||
@defproc[(build-contract-property
|
@defproc[(build-contract-property
|
||||||
[#:name
|
[#:name
|
||||||
|
@ -1266,7 +1274,15 @@ constructed by @scheme[build-flat-contract-property].
|
||||||
(if ((get-first-order c) x)
|
(if ((get-first-order c) x)
|
||||||
x
|
x
|
||||||
(raise-blame-error
|
(raise-blame-error
|
||||||
b x "expected <~a>, given: ~e" (get-name c) x)))))])
|
b x "expected <~a>, given: ~e" (get-name c) x)))))]
|
||||||
|
[#:stronger
|
||||||
|
stronger
|
||||||
|
(or/c (-> contract? contract? boolean?) #f)
|
||||||
|
#f]
|
||||||
|
[#:generator
|
||||||
|
generator
|
||||||
|
(or/c (-> number? (listof (list any/c contract?)) any/c) #f)
|
||||||
|
#f])
|
||||||
contract-property?]
|
contract-property?]
|
||||||
)]{
|
)]{
|
||||||
|
|
||||||
|
@ -1274,11 +1290,16 @@ These functions build the arguments for @scheme[prop:contract] and
|
||||||
@scheme[prop:flat-contract], respectively.
|
@scheme[prop:flat-contract], respectively.
|
||||||
|
|
||||||
A @deftech{contract property} specifies the behavior of a structure when used as
|
A @deftech{contract property} specifies the behavior of a structure when used as
|
||||||
a contract. It is specified in terms of three accessors: @scheme[get-name],
|
a contract. It is specified in terms of five accessors: @scheme[get-name],
|
||||||
which produces a description to @scheme[display] during a contract violation;
|
which produces a description to @scheme[write] as part of a contract violation;
|
||||||
@scheme[get-first-order], which produces a first order predicate to be used by
|
@scheme[get-first-order], which produces a first order predicate to be used by
|
||||||
@scheme[contract-first-order-passes?]; and @scheme[get-projection], which
|
@scheme[contract-first-order-passes?]; @scheme[get-projection], which
|
||||||
produces a blame-tracking projection defining the behavior of the contract.
|
produces a blame-tracking projection defining the behavior of the contract;
|
||||||
|
@scheme[stronger], which is a predicate that determines if one contract this contract
|
||||||
|
(passed in the first argument) is stronger than some other contract (passed in the second argument);
|
||||||
|
and @scheme[generator], which makes a random value that matches the contract,
|
||||||
|
given a size bound and an environment from which to draw interesting values.
|
||||||
|
|
||||||
These accessors are passed as (optional) keyword arguments to
|
These accessors are passed as (optional) keyword arguments to
|
||||||
@scheme[build-contract-property], and are applied to instances of the
|
@scheme[build-contract-property], and are applied to instances of the
|
||||||
appropriate structure type by the contract system. Their results are used
|
appropriate structure type by the contract system. Their results are used
|
||||||
|
|
Loading…
Reference in New Issue
Block a user