diff --git a/pkgs/racket-doc/scribblings/reference/contracts.scrbl b/pkgs/racket-doc/scribblings/reference/contracts.scrbl index e2faf40e23..a4ad175e57 100644 --- a/pkgs/racket-doc/scribblings/reference/contracts.scrbl +++ b/pkgs/racket-doc/scribblings/reference/contracts.scrbl @@ -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. diff --git a/pkgs/racket-test/tests/racket/contract/stronger.rkt b/pkgs/racket-test/tests/racket/contract/stronger.rkt index 43076baaa4..809c2b0318 100644 --- a/pkgs/racket-test/tests/racket/contract/stronger.rkt +++ b/pkgs/racket-test/tests/racket/contract/stronger.rkt @@ -687,4 +687,24 @@ (define one (mk 1)) (define two (mk 2)) (,test #f contract-stronger? one two) - (,test #t contract-stronger? two one)))) \ No newline at end of file + (,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)) diff --git a/racket/collects/racket/contract/private/prop.rkt b/racket/collects/racket/contract/private/prop.rkt index 923d1c5f04..89daa2e962 100644 --- a/racket/collects/racket/contract/private/prop.rkt +++ b/racket/collects/racket/contract/private/prop.rkt @@ -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)