make contract-stronger?
return #f for impersonator contracts that don't implement stronger
This commit is contained in:
parent
39dea70732
commit
ed5911e531
|
@ -101,14 +101,14 @@ Contracts in Racket are subdivided into three different categories:
|
|||
that the value had before being wrapped by the contract
|
||||
are preserved by the contract wrapper.
|
||||
|
||||
All @tech{flat contracts} are also @tech{chaperone contracts} (but
|
||||
not vice-versa).}
|
||||
All @tech{flat contracts} may be used where @tech{chaperone contracts} are expected
|
||||
(but not vice-versa).}
|
||||
@item{@deftech{Impersonator @tech{contracts}} do not provide any
|
||||
guarantees about values they check. Impersonator contracts
|
||||
may hide properties of values, or even make them completely
|
||||
opaque (e.g, @racket[new-∀/c]).
|
||||
|
||||
All @tech{contracts} are impersonator contracts.}]
|
||||
All @tech{contracts} may be used where impersonator contracts are expected.}]
|
||||
|
||||
For more about this hierarchy, see the section ``@secref["chaperones"]''
|
||||
as well as a research paper @cite{Strickland12} on chaperones, impersonators,
|
||||
|
@ -2231,7 +2231,10 @@ The @racket[stronger] argument is used to implement @racket[contract-stronger?].
|
|||
first argument is always the contract itself and the second argument is whatever
|
||||
was passed as the second argument to @racket[contract-stronger?]. If no
|
||||
@racket[stronger] argument is supplied, then a default that compares its arguments
|
||||
with @racket[equal?] is used.
|
||||
with @racket[equal?] is used for @tech{flat contracts} and @tech{chaperone contracts}.
|
||||
For @tech{impersonator contracts} constructed with @racket[make-contract] that do not
|
||||
supply the @racket[stronger] argument, @racket[contract-stronger?] returns @racket[#f].
|
||||
|
||||
|
||||
The @racket[is-list-contract?] argument is used by the @racket[list-contract?] predicate
|
||||
to determine if this is a contract that accepts only @racket[list?] values.
|
||||
|
@ -2957,8 +2960,9 @@ are below):
|
|||
Returns @racket[#t] if the contract @racket[c1] accepts either fewer
|
||||
or the same number of values as @racket[c2] does.
|
||||
|
||||
Contracts that are the same (i.e., where @racket[c1] is @racket[equal?]
|
||||
to @racket[c2]) are considered to always be stronger than each other.
|
||||
@tech{Chaperone contracts} and @tech{flat contracts} that are the same
|
||||
(i.e., where @racket[c1] is @racket[equal?] to @racket[c2]) are
|
||||
considered to always be stronger than each other.
|
||||
|
||||
This function is conservative, so it may return @racket[#f] when
|
||||
@racket[c1] does, in fact, accept fewer values.
|
||||
|
|
|
@ -687,4 +687,24 @@
|
|||
(define one (mk 1))
|
||||
(define two (mk 2))
|
||||
(,test #f contract-stronger? one two)
|
||||
(,test #t contract-stronger? two one))))
|
||||
(,test #t contract-stronger? two one)))
|
||||
|
||||
(contract-eval
|
||||
`(define imp-ctc
|
||||
(make-contract
|
||||
#:late-neg-projection (λ (blame) (λ (val neg) (add1 val))))))
|
||||
(contract-eval
|
||||
`(define imp-struct-ctc
|
||||
(let ()
|
||||
(struct imp-ctc-struct ()
|
||||
#:property prop:contract
|
||||
(build-contract-property
|
||||
#:late-neg-projection
|
||||
(λ (ctc)
|
||||
(λ (blame)
|
||||
(λ (val neg)
|
||||
(add1 val))))))
|
||||
(imp-ctc-struct))))
|
||||
|
||||
(ctest #f contract-stronger? imp-ctc imp-ctc)
|
||||
(ctest #f contract-stronger? imp-struct-ctc imp-struct-ctc))
|
||||
|
|
|
@ -118,7 +118,10 @@
|
|||
(define trail (make-parameter #f))
|
||||
(define (contract-struct-stronger? a b)
|
||||
(cond
|
||||
[(equal? a b) #t]
|
||||
[(and (equal? a b)
|
||||
(or (flat-contract-struct? a)
|
||||
(chaperone-contract-struct? a)))
|
||||
#t]
|
||||
[else
|
||||
(define prop (contract-struct-property a))
|
||||
(define stronger? (contract-property-stronger prop))
|
||||
|
@ -494,7 +497,7 @@
|
|||
(late-neg-first-order-projection name first-order)]
|
||||
[else #f])]
|
||||
[else late-neg-projection])
|
||||
(or stronger as-strong?)
|
||||
(or stronger weakest)
|
||||
generate exercise
|
||||
(and list-contract? #t)))
|
||||
|
||||
|
@ -510,12 +513,6 @@
|
|||
name
|
||||
v)))))
|
||||
|
||||
(define (as-strong? a b)
|
||||
(define late-neg-a (contract-struct-late-neg-projection a))
|
||||
(define late-neg-b (contract-struct-late-neg-projection b))
|
||||
(and late-neg-a late-neg-b
|
||||
(procedure-closure-contents-eq? late-neg-a late-neg-b)))
|
||||
|
||||
(define make-contract
|
||||
(procedure-rename
|
||||
(build-contract make-make-contract 'anonymous-contract 'make-contract #f)
|
||||
|
|
Loading…
Reference in New Issue
Block a user