From 8ec3edaa9597223f152f5ca12799c8c669e471bb Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 9 May 2018 21:31:12 -0500
Subject: [PATCH] add contract-equivalent?

and use it to get rid of the change in 4de050552,
avoiding the exponential blowup in a way that
doesn't compromise on contract-stronger?'s result
---
 .../scribblings/reference/contracts.scrbl     |  52 +-
 .../tests/racket/contract/equivalent.rkt      | 830 ++++++++++++++++++
 .../collects/racket/contract/combinator.rkt   |   1 +
 .../collects/racket/contract/private/and.rkt  |  24 +-
 .../racket/contract/private/arr-d.rkt         |   5 +-
 .../racket/contract/private/arr-i.rkt         |   1 +
 .../contract/private/arrow-val-first.rkt      |  24 +
 .../collects/racket/contract/private/base.rkt |  11 +-
 .../collects/racket/contract/private/box.rkt  |  31 +-
 .../collects/racket/contract/private/ds.rkt   |  14 +-
 .../racket/contract/private/exists.rkt        |   1 +
 .../collects/racket/contract/private/guts.rkt |  54 +-
 .../collects/racket/contract/private/hash.rkt |  27 +-
 .../collects/racket/contract/private/list.rkt |  73 ++
 .../collects/racket/contract/private/misc.rkt | 133 ++-
 .../racket/contract/private/object.rkt        |  11 +
 .../collects/racket/contract/private/orc.rkt  |  42 +-
 .../racket/contract/private/parametric.rkt    |  19 +
 .../collects/racket/contract/private/prop.rkt | 158 ++--
 .../racket/contract/private/struct-dc.rkt     |  42 +-
 .../racket/contract/private/vector.rkt        |  25 +-
 .../collects/racket/private/class-c-old.rkt   |  84 +-
 22 files changed, 1544 insertions(+), 118 deletions(-)
 create mode 100644 pkgs/racket-test/tests/racket/contract/equivalent.rkt

diff --git a/pkgs/racket-doc/scribblings/reference/contracts.scrbl b/pkgs/racket-doc/scribblings/reference/contracts.scrbl
index 9b6fbfa20a..a2e7544759 100644
--- a/pkgs/racket-doc/scribblings/reference/contracts.scrbl
+++ b/pkgs/racket-doc/scribblings/reference/contracts.scrbl
@@ -2125,6 +2125,9 @@ where the violation was detected.
           [#:stronger stronger
                       (or/c #f (-> contract? contract? boolean?))
                       #f]
+          [#:equivalent equivalent
+           (or/c #f (-> contract? contract? boolean?))
+           #f]
           [#:list-contract? is-list-contract? boolean? #f])
          contract?]
 @defproc[(make-chaperone-contract
@@ -2150,6 +2153,9 @@ where the violation was detected.
           [#:stronger stronger
                       (or/c #f (-> contract? contract? boolean?))
                       #f]
+          [#:equivalent equivalent
+           (or/c #f (-> contract? contract? boolean?))
+           #f]
           [#:list-contract? is-list-contract? boolean? #f])
          chaperone-contract?]
 @defproc[(make-flat-contract
@@ -2175,6 +2181,9 @@ where the violation was detected.
           [#:stronger stronger
                       (or/c #f (-> contract? contract? boolean?))
                       #f]
+          [#:equivalent equivalent
+           (or/c #f (-> contract? contract? boolean?))
+           #f]
           [#:list-contract? is-list-contract? boolean? #f])
          flat-contract?]
 )]{
@@ -2250,6 +2259,9 @@ with @racket[equal?] is used for @tech{flat contracts} and @tech{chaperone contr
 For @tech{impersonator contracts} constructed with @racket[make-contract] that do not
 supply the @racket[stronger] argument, @racket[contract-stronger?] returns @racket[#f].
 
+Similarly, the @racket[equivalent] argument is used to implement @racket[contract-equivalent?].
+If it isn't supplied or @racket[#false] is supplied, then @racket[equal?] is used
+for chaperone and flat contracts, and @racket[(λ (x y) #f)] is used otherwise.
 
 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.
@@ -2717,6 +2729,9 @@ returns @racket[#f] but @racket[value-blame] returns @racket[#f].
            stronger
            (or/c (-> contract? contract? boolean?) #f)
            #f]
+          [#:equivalent equivalent
+           (or/c #f (-> contract? contract? boolean?))
+           #f]
           [#:generate
            generate
            (->i ([c contract?])
@@ -2760,6 +2775,9 @@ returns @racket[#f] but @racket[value-blame] returns @racket[#f].
            stronger
            (or/c (-> contract? contract? boolean?) #f)
            #f]
+          [#:equivalent equivalent
+           (or/c #f (-> contract? contract? boolean?))
+           #f]
           [#:generate
            generate
            (->i ([c contract?])
@@ -2813,6 +2831,9 @@ returns @racket[#f] but @racket[value-blame] returns @racket[#f].
            stronger
            (or/c (-> contract? contract? boolean?) #f)
            #f]
+          [#:equivalent equivalent
+           (or/c #f (-> contract? contract? boolean?))
+           #f]
           [#:generate
            generate
            (->i ([c contract?])
@@ -2834,7 +2855,7 @@ returns @racket[#f] but @racket[value-blame] returns @racket[#f].
            (λ (c) (λ (fuel) (values void '())))]
           [#:list-contract? is-list-contract? (-> contract? boolean?) (λ (c) #f)])
          contract-property?])]{
-   
+
 These functions build the arguments for @racket[prop:contract],
 @racket[prop:chaperone-contract], and @racket[prop:flat-contract], respectively.
 
@@ -2853,6 +2874,11 @@ a contract.  It is specified in terms of seven properties:
    contract (passed in the first argument) is stronger than some other
    contract (passed in the second argument) and whose default always
    returns @racket[#f];}
+  @item{@racket[equivalent], a predicate that determines whether this
+   contract (passed in the first argument) is equivalent to some other
+   contract (passed in the second argument); the default for flat
+   and chaperone contracts is @racket[equal?] and for impersonator contracts
+   returns @racket[#f];}
   @item{@racket[generate], which returns a thunk that generates random values
    matching the contract (using @racket[contract-random-generate-fail])
    to indicate failure) or @racket[#f] to indicate that random
@@ -3010,7 +3036,7 @@ are below):
 
 @defproc[(contract-stronger? [c1 contract?] [c2 contract?]) boolean?]{
   Returns @racket[#t] if the contract @racket[c1] accepts either fewer
-  or the same number of values as @racket[c2] does.
+  or the same set of values that @racket[c2] does.
 
   @tech{Chaperone contracts} and @tech{flat contracts} that are the same
   (i.e., where @racket[c1] is @racket[equal?] to @racket[c2]) are
@@ -3029,6 +3055,28 @@ are below):
                                      (λ (x) (and (real? x) (<= x 100))))]
 
 
+}
+
+@defproc[(contract-equivalent? [c1 contract?] [c2 contract?]) boolean?]{
+  Returns @racket[#t] if the contract @racket[c1] accepts the same
+  set of values that @racket[c2] does.
+
+  @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 equivalent to each other.
+
+  This function is conservative, so it may return @racket[#f] when
+  @racket[c1] does, in fact, accept the same set of values that @racket[c2] does.
+
+@examples[#:eval (contract-eval) #:once
+                 (contract-equivalent? integer? integer?)
+                 (contract-equivalent? (non-empty-listof integer?)
+                                       (cons/c integer? (listof integer?)))
+
+                 (contract-equivalent? (λ (x) (and (real? x) (and (number? x) (>= (sqr x) 0))))
+                                       (λ (x) (and (real? x) (real? x))))]
+
+
 }
 
 @defproc[(contract-first-order-passes? [contract contract?]
diff --git a/pkgs/racket-test/tests/racket/contract/equivalent.rkt b/pkgs/racket-test/tests/racket/contract/equivalent.rkt
new file mode 100644
index 0000000000..25e6046b3e
--- /dev/null
+++ b/pkgs/racket-test/tests/racket/contract/equivalent.rkt
@@ -0,0 +1,830 @@
+#lang racket/base
+(require "test-util.rkt")
+
+(parameterize ([current-contract-namespace
+                (make-basic-contract-namespace 'racket/contract
+                                               'racket/list
+                                               'racket/class
+                                               'racket/math)])
+  
+  (contract-eval '(define-contract-struct couple (hd tl)))
+  (contract-eval '(define-contract-struct triple (a b c)))
+
+  (ctest #t contract-equivalent? any/c any/c)
+  (ctest #f contract-equivalent? integer? any/c)
+
+  (ctest #t contract-equivalent? (integer-in 0 4) (integer-in 0 4))
+  (ctest #f contract-equivalent? (integer-in 1 3) (integer-in 0 4))
+  (ctest #f contract-equivalent? (integer-in 0 4) (integer-in 1 3))
+  (ctest #f contract-equivalent? (integer-in 0 4) (integer-in 1 #f))
+  (ctest #f contract-equivalent? (integer-in 0 4) (integer-in #f 3))
+  (ctest #f contract-equivalent? (integer-in 0 4) (integer-in #f 4))
+  (ctest #f contract-equivalent? (integer-in 0 #f) (integer-in #f #f))
+  (ctest #f contract-equivalent? (integer-in #f 0) (integer-in #f #f))
+  (ctest #t contract-equivalent? (integer-in #f #f) (integer-in #f #f))
+  (ctest #t contract-equivalent? (integer-in 0 0) (and/c 0 exact?))
+  (ctest #t contract-equivalent? (and/c 0 exact?) (integer-in 0 0))
+  (ctest #t contract-equivalent? exact-integer? (integer-in #f #f))
+  (ctest #t contract-equivalent? (integer-in #f #f) exact-integer?)
+  (ctest #t contract-equivalent? (integer-in 0 #f) exact-nonnegative-integer?)
+  (ctest #t contract-equivalent? (integer-in 0 #f) natural?)
+  (ctest #t contract-equivalent? natural? (integer-in 0 #f))
+  (ctest #t contract-equivalent? (integer-in 1 #f) exact-positive-integer?)
+  (ctest #t contract-equivalent? exact-positive-integer? (integer-in 1 #f))
+  (ctest #f contract-equivalent? natural? exact-integer?) ;; this actually is `integer-in`
+
+  (ctest #t contract-equivalent? (integer-in 0 5) (and/c natural? (<=/c 5)))
+  (ctest #t contract-equivalent? (and/c natural? (<=/c 5)) (integer-in 0 5))
+  (ctest #t contract-equivalent? (integer-in 0 5) (and/c exact-nonnegative-integer? (<=/c 5)))
+  (ctest #t contract-equivalent? (and/c exact-nonnegative-integer? (<=/c 5)) (integer-in 0 5))
+  (ctest #t contract-equivalent? (integer-in 5 #f) (and/c natural? (>=/c 5)))
+  (ctest #t contract-equivalent? (and/c natural? (>=/c 5)) (integer-in 5 #f))
+  (ctest #t contract-equivalent? (integer-in 0 #f) (and/c exact-nonnegative-integer? (>=/c -4)))
+  (ctest #t contract-equivalent? (and/c exact-nonnegative-integer? (>=/c -4)) (integer-in 0 #f))
+
+  (ctest #t contract-equivalent? #\a #\a)
+  (ctest #t contract-equivalent? #\a (char-in #\a #\a))
+  (ctest #t contract-equivalent? (char-in #\a #\a) (char-in #\a #\a))
+  (ctest #f contract-equivalent? #\a (char-in #\a #\c))
+  (ctest #f contract-equivalent? #\a (char-in #\b #\c))
+  (ctest #f contract-equivalent? (char-in #\f #\q) (char-in #\a #\z))
+  (ctest #f contract-equivalent? (char-in #\a #\z) (char-in #\f #\q))
+  (ctest #f contract-equivalent? (between/c 1 3) (between/c 0 4))
+  (ctest #f contract-equivalent? (between/c 0 4) (between/c 1 3))
+  (ctest #t contract-equivalent? (between/c 0 4) (between/c 0 4))
+  (ctest #t contract-equivalent? (between/c -inf.0 +inf.0) real?)
+  (ctest #t contract-equivalent? real? (between/c -inf.0 +inf.0))
+  (ctest #f contract-equivalent? (>=/c 3) (>=/c 2))
+  (ctest #f contract-equivalent? (>=/c 2) (>=/c 3))
+  (ctest #t contract-equivalent? (>=/c 2) (>=/c 2))
+  (ctest #f contract-equivalent? (<=/c 3) (<=/c 2))
+  (ctest #f contract-equivalent? (<=/c 2) (<=/c 3))
+  (ctest #t contract-equivalent? (<=/c 2) (<=/c 2))
+  (ctest #f contract-equivalent? (>/c 3) (>/c 2))
+  (ctest #f contract-equivalent? (>/c 2) (>/c 3))
+  (ctest #t contract-equivalent? (>/c 2) (>/c 2))
+  (ctest #f contract-equivalent? (</c 3) (</c 2))
+  (ctest #f contract-equivalent? (</c 2) (</c 3))
+  (ctest #t contract-equivalent? (</c 2) (</c 2))
+  (ctest #f contract-equivalent? (</c 2) (>/c 2))
+  (ctest #f contract-equivalent? (</c 2) (<=/c 2))
+  (ctest #f contract-equivalent? (</c 2) (>=/c 2))
+  (ctest #f contract-equivalent? (>/c 2) (<=/c 2))
+  (ctest #f contract-equivalent? (>/c 2) (>=/c 2))
+  (ctest #f contract-equivalent? (</c 2) (<=/c 200))
+  (ctest #f contract-equivalent? (<=/c 2) (</c 2))
+  (ctest #f contract-equivalent? (<=/c 1) (</c 2))
+  (ctest #f contract-equivalent? (>=/c 2) (</c 2))
+  (ctest #f contract-equivalent? (<=/c 2) (>/c 2))
+  (ctest #f contract-equivalent? (>=/c 2) (>/c 2))
+  (ctest #f contract-equivalent? (>=/c 3) (>/c 2))
+
+  (ctest #t contract-equivalent? (>/c 0) (and/c real? positive?))
+  (ctest #t contract-equivalent? (and/c real? positive?) (>/c 0))
+  (ctest #t contract-equivalent? (</c 0) (and/c real? negative?))
+  (ctest #t contract-equivalent? (and/c real? negative?) (</c 0))
+  (ctest #t contract-equivalent? (<=/c 0) (and/c real? (not/c positive?)))
+  (ctest #t contract-equivalent? (and/c real? (not/c positive?)) (<=/c 0))
+  (ctest #t contract-equivalent? (>=/c 0) (and/c real? (not/c negative?)))
+  (ctest #t contract-equivalent? (and/c real? (not/c negative?)) (>=/c 0))
+
+  (ctest #t contract-equivalent? (recursive-contract (<=/c 2)) (recursive-contract (<=/c 2)))
+  (ctest #f contract-equivalent? (recursive-contract (<=/c 2)) (recursive-contract (<=/c 3)))
+  (ctest #f contract-equivalent? (recursive-contract (<=/c 3)) (recursive-contract (<=/c 2)))
+  (let ([f (contract-eval '(λ (x) (recursive-contract (<=/c x))))])
+    (ctest #t contract-equivalent? (,f 1) (,f 1)))
+  (ctest #f contract-equivalent?
+         (letrec ([c (recursive-contract (-> (<=/c 5) c))]) c)
+         (letrec ([c (recursive-contract (-> (<=/c 3) c))]) c))
+  (ctest #t contract-equivalent?
+         (letrec ([c (recursive-contract (-> (<=/c 3) c))]) c)
+         (letrec ([c (recursive-contract (-> (<=/c 3) c))]) c))
+  (ctest #f contract-equivalent?
+         (letrec ([c (recursive-contract (-> (<=/c 3) c))]) c)
+         (letrec ([c (recursive-contract (-> (<=/c 1) c))]) c))
+  (ctest #t contract-equivalent?
+         (letrec ([c (recursive-contract (-> (<=/c 1) c))]) c)
+         (letrec ([c (recursive-contract (-> (<=/c 1) (-> (<=/c 1) c)))]) c))
+  (ctest #t contract-equivalent?
+         (letrec ([c (recursive-contract (-> (<=/c 1) (-> (<=/c 1) c)))]) c)
+         (letrec ([c (recursive-contract (-> (<=/c 1) (-> (<=/c 1) (-> (<=/c 1) c))))]) c))
+  (ctest #t contract-equivalent? (-> integer? integer?) (-> integer? integer?))
+  (ctest #f contract-equivalent? (-> boolean? boolean?) (-> integer? integer?))
+  (ctest #f contract-equivalent? (-> (>=/c 3) (>=/c 3)) (-> (>=/c 4) (>=/c 3)))
+  (ctest #f contract-equivalent? (-> (>=/c 4) (>=/c 3)) (-> (>=/c 3) (>=/c 3)))
+  (ctest #f contract-equivalent? (-> (>=/c 3) (>=/c 3)) (-> (>=/c 3) (>=/c 2)))
+  (ctest #f contract-equivalent? (-> (>=/c 3) (>=/c 2)) (-> (>=/c 3) (>=/c 3)))
+  (ctest #f contract-equivalent? (-> (>=/c 2)) (-> (>=/c 3) (>=/c 3)))
+  (ctest #f contract-equivalent? 
+         (-> integer? #:x integer? integer?)
+         (-> integer? #:y integer? integer?))
+  (ctest #f contract-equivalent?
+         (-> integer? #:y integer? integer?)
+         (-> integer? #:x integer? integer?))
+  (ctest #t contract-equivalent?
+         (-> integer? #:x integer? integer?)
+         (-> integer? #:x integer? integer?))
+  (ctest #t contract-equivalent? (-> #:x (>=/c 3) (>=/c 3)) (-> #:x (>=/c 3) (>=/c 3)))
+  (ctest #f contract-equivalent? (-> #:x (>=/c 3) (>=/c 3)) (-> #:x (>=/c 3) (>=/c 2)))
+  (ctest #t contract-equivalent? (-> any/c any/c any) (-> any/c any/c any))
+  (ctest #f contract-equivalent? (-> any/c any/c any/c any) (-> any/c any/c any))
+  (ctest #f contract-equivalent? (-> (-> any/c) integer?) (-> (-> any/c) any/c))
+  (ctest #t contract-equivalent? (-> (-> any/c) integer?) (-> (-> any/c) integer?))
+  (ctest #f contract-equivalent? (-> (-> any/c) any/c) (-> (-> any/c) integer?))
+
+  (let ([c (contract-eval '(->* () () any))])
+    (ctest #t contract-equivalent? ,c ,c))
+  (let ([c (contract-eval '(->d () () any))])
+    (ctest #t contract-equivalent? ,c ,c))
+  (let ([c (contract-eval '(->i () () any))])
+    (ctest #t contract-equivalent? ,c ,c))
+
+  (ctest #f contract-equivalent?
+         (->* () #:pre (zero? (random 10)) any) 
+         (->* () #:pre (zero? (random 10)) any))
+  (ctest #f contract-equivalent? 
+         (->* () integer? #:post (zero? (random 10))) 
+         (->* () integer? #:post (zero? (random 10))))
+  
+  (ctest #t contract-equivalent? (or/c null? #f) (or/c null? #f))
+  (ctest #f contract-equivalent? (or/c null? #f) (or/c boolean? #f))
+  (ctest #t contract-equivalent? (or/c null? boolean?) (or/c null? boolean?))
+  (ctest #t contract-equivalent? (or/c null? boolean?) (or/c boolean? null?))
+  (ctest #t contract-equivalent? 
+         (or/c null? (-> integer? integer?))
+         (or/c null? (-> integer? integer?)))
+  (ctest #f contract-equivalent?
+         (or/c null? (-> boolean? boolean?))
+         (or/c null? (-> integer? integer?)))
+  (ctest #f contract-equivalent? (or/c number? #f) number?)
+  (ctest #f contract-equivalent? number? (or/c number? #f))
+  (ctest #f contract-equivalent? (or/c (-> number? number?) #f) (-> number? number?))
+  (ctest #f contract-equivalent? (-> number? number?) (or/c (-> number? number?) #f))
+  (ctest #f contract-equivalent? (or/c (-> number? number?) (-> number? number? number?) #f) #f)
+  (ctest #f contract-equivalent? #f (or/c (-> number? number?) (-> number? number? number?) #f))
+  (ctest #f contract-equivalent? (or/c real?) (or/c integer? real?))
+  (ctest #f contract-equivalent? (-> number?) (-> (or/c #f number?)))
+  (ctest #f contract-equivalent? (-> (or/c #f number?) any/c) (-> number? any/c))
+  (ctest #f contract-equivalent? (-> (or/c #f number?)) (-> number?))
+  (ctest #f contract-equivalent? (-> number? any/c) (-> (or/c #f number?) any/c))
+  (ctest #t contract-equivalent? (first-or/c null? #f) (first-or/c null? #f))
+  (ctest #f contract-equivalent? (first-or/c null? #f) (first-or/c boolean? #f))
+  (ctest #t contract-equivalent? (first-or/c null? boolean?) (first-or/c null? boolean?))
+  (ctest #t contract-equivalent? (first-or/c null? boolean?) (first-or/c boolean? null?))
+  (ctest #t contract-equivalent? 
+         (first-or/c null? (-> integer? integer?))
+         (first-or/c null? (-> integer? integer?)))
+  (ctest #f contract-equivalent?
+         (first-or/c null? (-> boolean? boolean?))
+         (first-or/c null? (-> integer? integer?)))
+  (ctest #f contract-equivalent? (first-or/c number? #f) number?)
+  (ctest #f contract-equivalent? number? (first-or/c number? #f))
+  (ctest #f contract-equivalent? (first-or/c (-> number? number?) #f) (-> number? number?))
+  (ctest #f contract-equivalent? (-> number? number?) (first-or/c (-> number? number?) #f))
+  (ctest #f contract-equivalent? (first-or/c (-> number? number?) (-> number? number? number?) #f) #f)
+  (ctest #f contract-equivalent? #f (first-or/c (-> number? number?) (-> number? number? number?) #f))
+  (ctest #f contract-equivalent? (first-or/c real?) (first-or/c integer? real?))
+  (ctest #f contract-equivalent? (-> number?) (-> (first-or/c #f number?)))
+  (ctest #f contract-equivalent? (-> (first-or/c #f number?) any/c) (-> number? any/c))
+  (ctest #f contract-equivalent? (-> (first-or/c #f number?)) (-> number?))
+  (ctest #f contract-equivalent? (-> number? any/c) (-> (first-or/c #f number?) any/c))
+
+  (ctest #t contract-equivalent? (first-or/c null? #f) (or/c null? #f))
+  (ctest #f contract-equivalent? (first-or/c null? #f) (or/c boolean? #f))
+  (ctest #t contract-equivalent? (first-or/c null? boolean?) (or/c null? boolean?))
+  (ctest #t contract-equivalent? (first-or/c null? boolean?) (or/c boolean? null?))
+
+  (ctest #t contract-equivalent? (or/c null? #f) (first-or/c null? #f))
+  (ctest #f contract-equivalent? (or/c null? #f) (first-or/c boolean? #f))
+  (ctest #t contract-equivalent? (or/c null? boolean?) (first-or/c null? boolean?))
+  (ctest #t contract-equivalent? (or/c null? boolean?) (first-or/c boolean? null?))
+  
+  (ctest #t contract-equivalent? number? number?)
+  (ctest #f contract-equivalent? boolean? number?)
+
+  (ctest #t contract-equivalent? (parameter/c (between/c 0 5)) (parameter/c (between/c 0 5)))
+  (ctest #f contract-equivalent? (parameter/c (between/c 0 5)) (parameter/c (between/c 1 4)))
+  (ctest #f contract-equivalent? (parameter/c (between/c 1 4)) (parameter/c (between/c 0 5)))
+
+  (ctest #f contract-equivalent?
+         (parameter/c (between/c 1 4) (between/c 0 5))
+         (parameter/c (between/c 0 5)))
+  (ctest #f contract-equivalent?
+         (parameter/c (between/c 0 5) (between/c 1 4))
+         (parameter/c (between/c 1 4)))
+  (ctest #f contract-equivalent?
+         (parameter/c (between/c 0 5))
+         (parameter/c (between/c 1 4) (between/c 0 5)))
+  (ctest #f contract-equivalent?
+         (parameter/c (between/c 1 4))
+         (parameter/c (between/c 0 5) (between/c 0 5)))
+  (ctest #f contract-equivalent?
+         (parameter/c (between/c 0 5) (between/c 1 4))
+         (parameter/c (between/c 1 4) (between/c 0 5)))
+  (ctest #f contract-equivalent?
+         (parameter/c (between/c 1 4) (between/c 0 5))
+         (parameter/c (between/c 0 5) (between/c 1 4)))
+
+  (ctest #f contract-equivalent? (symbols 'x 'y) (symbols 'x 'y 'z))
+  (ctest #f contract-equivalent? (symbols 'x 'y 'z) (symbols 'x 'y))
+  (ctest #f contract-equivalent? (symbols 'x 'y) (symbols 'z 'x 'y))
+  (ctest #f contract-equivalent? (symbols 'z 'x 'y) (symbols 'x 'y))
+  (ctest #t contract-equivalent? (symbols 'z 'x 'y) (symbols 'z 'x 'y))
+  (ctest #t contract-equivalent? (symbols 'z 'x 'y) (symbols 'y 'z 'x))
+  (ctest #f contract-equivalent? (one-of/c (expt 2 100)) (one-of/c (expt 2 100) 12))
+
+  (ctest #f contract-equivalent?
+         (or/c (-> (>=/c 3) (>=/c 3)) (-> string?))
+         (or/c (-> (>=/c 4) (>=/c 3)) (-> string?)))
+  (ctest #t contract-equivalent?
+         (or/c (-> (>=/c 4) (>=/c 3)) (-> string?))
+         (or/c (-> (>=/c 4) (>=/c 3)) (-> string?)))
+  (ctest #f contract-equivalent?
+         (or/c (-> string?) (-> integer? integer?))
+         (or/c (-> string?) (-> any/c integer?)))
+  (ctest #f contract-equivalent?
+         (or/c (-> string?) (-> #f integer?))
+         (or/c (-> string?) (-> integer? integer?)))
+  (ctest #t contract-equivalent?
+         (or/c (-> string?) (-> integer? integer?) integer? boolean?)
+         (or/c (-> string?) (-> integer? integer?) integer? boolean?))
+  (ctest #f contract-equivalent?
+         (or/c (-> string?) (-> integer? integer?) integer? char?)
+         (or/c (-> string?) (-> integer? integer?) integer? boolean?))
+  (ctest #f contract-equivalent?
+         (or/c (-> string?) (-> integer? integer?) integer?)
+         (or/c (-> string?) (-> integer? integer?) integer? boolean?))
+  (ctest #f contract-equivalent?
+         (or/c (-> string?) (-> integer? integer?) integer?)
+         (or/c (-> integer? integer?) integer?))
+  
+  (ctest #t contract-equivalent? (list/c) '())
+  (ctest #t contract-equivalent? '() (list/c))
+  (ctest #t contract-equivalent? (cons/c boolean? integer?) (cons/c boolean? integer?))
+  (ctest #f contract-equivalent? (cons/c boolean? integer?) (cons/c integer? boolean?))
+  (ctest #t contract-equivalent? (cons/c number? (listof number?)) (non-empty-listof number?))
+  (ctest #t contract-equivalent? (and/c pair? (listof number?)) (non-empty-listof number?))
+  (ctest #t contract-equivalent? (non-empty-listof number?) (and/c (listof number?) pair?))
+  (ctest #t contract-equivalent? (non-empty-listof number?) (cons/c number? (listof number?)))
+  (ctest #f contract-equivalent? (cons/c number? (list/c number? number?)) (non-empty-listof number?))
+  (ctest #f contract-equivalent? (cons/c number? (cons/c number? (listof number?))) (listof number?))
+  (ctest #f contract-equivalent?
+         (cons/c (<=/c 1) (cons/c (<=/c 2) (listof (<=/c 3)))) 
+         (listof (<=/c 4)))
+  (ctest #f contract-equivalent? (listof number?) (cons/c number? (cons/c number? (listof any/c))))
+  (ctest #f contract-equivalent? (list*of (<=/c 2)) (list*of (<=/c 3)))
+  (ctest #f contract-equivalent? (list*of (<=/c 3)) (list*of (<=/c 2)))
+  (ctest #t contract-equivalent? (list*of (<=/c 3)) (list*of (<=/c 3)))
+  (ctest #f contract-equivalent? (list*of (<=/c 2) char?) (list*of (<=/c 3) char?))
+  (ctest #t contract-equivalent? (list*of (<=/c 3) char?) (list*of (<=/c 3) char?))
+  (ctest #f contract-equivalent? (list*of (<=/c 3) char?) (list*of (<=/c 2) char?))
+  (ctest #f contract-equivalent? (list*of char? (<=/c 2)) (list*of char? (<=/c 3)))
+  (ctest #t contract-equivalent? (list*of char? (<=/c 2)) (list*of char? (<=/c 2)))
+  (ctest #f contract-equivalent? (list*of char? (<=/c 3)) (list*of char? (<=/c 2)))
+  (ctest #t contract-equivalent? (list*of char? null?) (listof char?))
+  (ctest #t contract-equivalent? (listof char?) (list*of char? null?))
+  (ctest #f contract-equivalent? (list*of char? any/c) (listof char?))
+  
+  (ctest #f contract-equivalent? (vectorof (<=/c 3)) (vectorof (<=/c 4)))
+  (ctest #f contract-equivalent? (vectorof (<=/c 3)) (vectorof (<=/c 4)))
+  (ctest #t contract-equivalent? (vectorof (<=/c 3)) (vectorof (<=/c 3)))
+  (ctest #f contract-equivalent? (vectorof (<=/c 3) #:immutable #t) (vectorof (<=/c 4) #:immutable #t))
+  (ctest #f contract-equivalent? (vectorof (<=/c 3) #:immutable #t) (vectorof (<=/c 3)))
+  (ctest #f contract-equivalent? (vectorof (<=/c 3)) (vectorof (<=/c 3) #:immutable #t))
+  (ctest #f contract-equivalent? (vectorof (<=/c 3)) (vectorof (<=/c 3) #:immutable #f))
+  (ctest #f contract-equivalent? (vectorof (<=/c 3) #:immutable #f) (vectorof (<=/c 3)))
+  (ctest #t contract-equivalent? (vectorof (<=/c 3) #:immutable #f) (vectorof (<=/c 3) #:immutable #f))
+  (ctest #t contract-equivalent? (vectorof (<=/c 3)) (vectorof (<=/c 3)))
+  
+  (ctest #f contract-equivalent? (vector/c (<=/c 3) (<=/c 3) (<=/c 3)) (vectorof (<=/c 3)))
+  (ctest #f contract-equivalent? (vector/c (<=/c 3) (<=/c 3) (<=/c 3)) (vectorof (<=/c 4)))
+  (ctest #f contract-equivalent? (vector/c (<=/c 3) (<=/c 3) (<=/c 3)) (vectorof (<=/c 2)))
+  (ctest #t contract-equivalent? (vector/c (<=/c 3) (<=/c 2)) (vector/c (<=/c 3) (<=/c 2)))
+  (ctest #f contract-equivalent? (vector/c (<=/c 3) (<=/c 3)) (vector/c (<=/c 3) (<=/c 2)))
+  (ctest #f contract-equivalent? (vector/c (<=/c 3) (<=/c 2)) (vector/c (<=/c 3) (<=/c 3)))
+  (ctest #f contract-equivalent? (vector/c (<=/c 3) #:immutable #t) (vector/c (<=/c 3)))
+  (ctest #f contract-equivalent? (vector/c (<=/c 3) #:immutable #f) (vector/c (<=/c 3)))
+  (ctest #t contract-equivalent? (vector/c (<=/c 3) #:immutable #f) (vector/c (<=/c 3) #:immutable #f))
+  (ctest #f contract-equivalent? (vector/c (<=/c 3)) (vector/c (<=/c 3) #:immutable #t))
+  (ctest #f contract-equivalent? (vector/c (<=/c 3)) (vector/c (<=/c 3) #:immutable #f))
+  (ctest #f contract-equivalent? (vector/c (<=/c 2) #:immutable #t) (vector/c (<=/c 3) #:immutable #t))
+  (ctest #f contract-equivalent? (vector/c (<=/c 3) #:immutable #t) (vector/c (<=/c 2) #:immutable #t))
+  
+  (ctest #t contract-equivalent? (box/c (<=/c 3)) (box/c (<=/c 3)))
+  (ctest #f contract-equivalent? (box/c (<=/c 3)) (box/c (<=/c 2)))
+  (ctest #f contract-equivalent? (box/c (<=/c 2)) (box/c (<=/c 3)))
+  (ctest #t contract-equivalent? (box/c (<=/c 3) #:immutable #t) (box/c (<=/c 3) #:immutable #t))
+  (ctest #f contract-equivalent? (box/c (<=/c 2) #:immutable #t) (box/c (<=/c 3) #:immutable #t))
+  (ctest #f contract-equivalent? (box/c (<=/c 3) #:immutable #t) (box/c (<=/c 2) #:immutable #t))
+  (ctest #f contract-equivalent? (box/c (<=/c 3) #:immutable #t) (box/c (<=/c 3)))
+  (ctest #f contract-equivalent? (box/c (<=/c 3) #:immutable #f) (box/c (<=/c 3)))
+  (ctest #f contract-equivalent? (box/c (<=/c 3)) (box/c (<=/c 3) #:immutable #t))
+  (ctest #f contract-equivalent? (box/c (<=/c 3)) (box/c (<=/c 3) #:immutable #f))
+  
+  (ctest #t contract-equivalent? (hash/c integer? symbol?) (hash/c integer? symbol?))
+  (ctest #f contract-equivalent? (hash/c integer? symbol?) (hash/c symbol? integer?))
+  (ctest #f contract-equivalent? (hash/c (<=/c 2) symbol?) (hash/c (<=/c 3) symbol?))
+  (ctest #f contract-equivalent?
+         (hash/c (<=/c 2) symbol? #:immutable #t)
+         (hash/c (<=/c 3) symbol? #:immutable #t))
+  (ctest #t contract-equivalent?
+         (hash/c (<=/c 2) symbol? #:immutable #t)
+         (hash/c (<=/c 2) symbol? #:immutable #t))
+  (ctest #f contract-equivalent?
+         (hash/c (<=/c 3) symbol? #:immutable #t)
+         (hash/c (<=/c 2) symbol? #:immutable #t))
+  (ctest #t contract-equivalent?
+         (hash/c (<=/c 2) symbol? #:immutable #f)
+         (hash/c (<=/c 2) symbol? #:immutable #f))
+  (ctest #f contract-equivalent?
+         (hash/c (<=/c 2) symbol? #:immutable #f)
+         (hash/c (<=/c 2) symbol?))
+  (ctest #f contract-equivalent?
+         (hash/c (<=/c 2) symbol?)
+         (hash/c (<=/c 2) symbol? #:immutable #f))
+  
+  (contract-eval
+   `(let ()
+      (define x (flat-rec-contract x (or/c (cons/c x '()) '())))
+      (,test #:test-case-name 'flat-rec.1 #t contract-equivalent? x (or/c (cons/c x '()) '()))))
+  (contract-eval
+   `(let ()
+      (define x (flat-rec-contract x (first-or/c (cons/c x '()) '())))
+      (,test #:test-case-name 'flat-rec.2 #t contract-equivalent? x (first-or/c (cons/c x '()) '()))))
+  
+  (ctest #f contract-equivalent? "x" string?)
+  (ctest #f contract-equivalent? string? "x")
+
+  (ctest #f contract-equivalent? 1 real?)
+  (ctest #f contract-equivalent? 1 (between/c -10 10))
+  (ctest #f contract-equivalent? real? 1)
+  (ctest #t contract-equivalent? real? real?)
+  (ctest #t contract-equivalent? 1 1)
+
+  (ctest #f contract-equivalent? 'x symbol?)
+  (ctest #f contract-equivalent? symbol? 'x)
+  
+  (ctest #t contract-equivalent?
+         (flat-named-contract 'name1 #f)
+         (flat-named-contract 'name2 #f))
+  (ctest #t contract-equivalent?
+         (flat-named-contract 'name1 (flat-named-contract 'name2 #f))
+         (flat-named-contract 'name3 (flat-named-contract 'name4 #f)))
+  (ctest #t contract-equivalent? (flat-named-contract 'name1 1) (flat-named-contract 'name2 1))
+  (ctest #t contract-equivalent? (flat-named-contract 'name1 "x") (flat-named-contract 'name2 "x"))
+  (ctest #t contract-equivalent? 
+         (flat-named-contract 'name2 (regexp "x"))
+         (flat-named-contract 'name2 (regexp "x")))
+  
+  (ctest #f contract-equivalent? (listof (<=/c 3)) (listof (<=/c 5)))
+  (ctest #t contract-equivalent? (listof (<=/c 5)) (listof (<=/c 5)))
+  (ctest #t contract-equivalent? (list/c (<=/c 3) (<=/c 3)) (list/c (<=/c 3) (<=/c 3)))
+  (ctest #f contract-equivalent? (list/c (<=/c 3) (<=/c 3)) (list/c (<=/c 3) (<=/c 3) (<=/c 3)))
+  (ctest #f contract-equivalent? (list/c (<=/c 3) (<=/c 3) (<=/c 3)) (list/c (<=/c 3) (<=/c 3)))
+  (ctest #f contract-equivalent? (list/c (<=/c 3) (<=/c 3)) (listof (<=/c 5)))
+  (ctest #f contract-equivalent? (list/c (<=/c 3) (<=/c 3)) (non-empty-listof (<=/c 5)))
+  (ctest #f contract-equivalent? (list/c (<=/c 3)) (non-empty-listof (<=/c 5)))
+  (ctest #f contract-equivalent? (list/c) (non-empty-listof (<=/c 5)))
+  (ctest #f contract-equivalent? (list/c) (listof (<=/c 5)))
+  (ctest #t contract-equivalent? (list/c) (list/c))
+  (ctest #t contract-equivalent? (listof (<=/c 5)) (listof (<=/c 5)))
+
+  (ctest #t contract-equivalent? (*list/c integer? boolean? char?) (*list/c integer? boolean? char?))
+  (ctest #f contract-equivalent? (list/c integer? boolean? char?) (listof (or/c integer? boolean? char?)))
+  (ctest #t contract-equivalent? (list/c integer? boolean? char?) (list/c integer? boolean? char?))
+  (ctest #t contract-equivalent? (listof (or/c integer? boolean? char?)) (listof (or/c integer? boolean? char?)))
+  
+  (ctest #f contract-equivalent? (promise/c (<=/c 2)) (promise/c (<=/c 3)))
+  (ctest #f contract-equivalent? (promise/c (<=/c 3)) (promise/c (<=/c 2)))
+  (ctest #t contract-equivalent? (promise/c (<=/c 2)) (promise/c (<=/c 2)))
+  
+  (ctest #f contract-equivalent? (syntax/c (<=/c 3)) (syntax/c (<=/c 4)))
+  (ctest #f contract-equivalent? (syntax/c (<=/c 4)) (syntax/c (<=/c 3)))
+  (ctest #t contract-equivalent? (syntax/c (<=/c 4)) (syntax/c (<=/c 4)))
+  
+  (ctest #t contract-equivalent? (parametric->/c (x) (-> x x)) (parametric->/c (x) (-> x x)))
+  (ctest #f contract-equivalent? (parametric->/c (x) (-> x x)) (parametric->/c (x) (-> x (or/c x #f))))
+  (ctest #f contract-equivalent? (parametric->/c (x) (-> x x)) (parametric->/c (x) (-> x (first-or/c x #f))))
+  (ctest #f contract-equivalent? (parametric->/c (x y) (-> x y)) (parametric->/c (x y) (-> x x y)))
+  (contract-eval `(define α (new-∀/c)))
+  (ctest #f contract-equivalent? (-> α α) (-> α (or/c #f α)))
+  (ctest #t contract-equivalent? (-> α α) (-> α α))
+  (ctest #f contract-equivalent? (-> α (or/c #f α)) (-> α α))
+  (ctest #f contract-equivalent? (-> α α) (-> α (first-or/c #f α)))
+  (ctest #f contract-equivalent? (-> α (first-or/c #f α)) (-> α α))
+  
+  (ctest #t contract-equivalent?
+         (class/c (m (-> any/c (<=/c 3))))
+         (class/c (m (-> any/c (<=/c 3)))))
+  (ctest #f contract-equivalent?
+         (class/c (m (-> any/c (<=/c 3))))
+         (class/c (m (-> any/c (<=/c 4)))))
+  (ctest #f contract-equivalent?
+         (class/c (m (-> any/c (<=/c 4))))
+         (class/c (m (-> any/c (<=/c 3)))))
+  (ctest #t contract-equivalent?
+         (class/c (field [f integer?]))
+         (class/c (field [f integer?])))
+  (ctest #f contract-equivalent?
+         (class/c (field [f (<=/c 3)]))
+         (class/c (field [f (<=/c 4)])))
+  (ctest #f contract-equivalent?
+         (class/c (field [f (<=/c 4)]))
+         (class/c (field [f (<=/c 3)])))
+  (ctest #t contract-equivalent?
+         (class/c (init [f (<=/c 3)]))
+         (class/c (init [f (<=/c 3)])))
+  (ctest #f contract-equivalent?
+         (class/c (init [f (<=/c 3)]))
+         (class/c (init [f (<=/c 4)])))
+  (ctest #f contract-equivalent?
+         (class/c (init [f (<=/c 4)]))
+         (class/c (init [f (<=/c 3)])))
+  (ctest #t contract-equivalent?
+         (class/c (inherit [m (-> any/c (<=/c 3))]))
+         (class/c (inherit [m (-> any/c (<=/c 3))])))
+  (ctest #f contract-equivalent?
+         (class/c (inherit [m (-> any/c (<=/c 3))]))
+         (class/c (inherit [m (-> any/c (<=/c 4))])))
+  (ctest #f contract-equivalent?
+         (class/c (inherit [m (-> any/c (<=/c 4))]))
+         (class/c (inherit [m (-> any/c (<=/c 3))])))
+  (ctest #t contract-equivalent?
+         (class/c (super [m (-> any/c (<=/c 3))]))
+         (class/c (super [m (-> any/c (<=/c 3))])))
+  (ctest #f contract-equivalent?
+         (class/c (super [m (-> any/c (<=/c 3))]))
+         (class/c (super [m (-> any/c (<=/c 4))])))
+  (ctest #f contract-equivalent?
+         (class/c (super [m (-> any/c (<=/c 4))]))
+         (class/c (super [m (-> any/c (<=/c 3))])))
+  (ctest #t contract-equivalent?
+         (class/c (inner [m (-> any/c (<=/c 3))]))
+         (class/c (inner [m (-> any/c (<=/c 3))])))
+  (ctest #f contract-equivalent?
+         (class/c (inner [m (-> any/c (<=/c 3))]))
+         (class/c (inner [m (-> any/c (<=/c 4))])))
+  (ctest #f contract-equivalent?
+         (class/c (inner [m (-> any/c (<=/c 4))]))
+         (class/c (inner [m (-> any/c (<=/c 3))])))
+  (ctest #t contract-equivalent?
+         (class/c (override [m (-> any/c (<=/c 3))]))
+         (class/c (override [m (-> any/c (<=/c 3))])))
+  (ctest #f contract-equivalent?
+         (class/c (override [m (-> any/c (<=/c 3))]))
+         (class/c (override [m (-> any/c (<=/c 4))])))
+  (ctest #f contract-equivalent?
+         (class/c (override [m (-> any/c (<=/c 4))]))
+         (class/c (override [m (-> any/c (<=/c 3))])))
+  (ctest #t contract-equivalent?
+         (class/c (augment [m (-> any/c (<=/c 3))]))
+         (class/c (augment [m (-> any/c (<=/c 3))])))
+  (ctest #f contract-equivalent?
+         (class/c (augment [m (-> any/c (<=/c 3))]))
+         (class/c (augment [m (-> any/c (<=/c 4))])))
+  (ctest #f contract-equivalent?
+         (class/c (augment [m (-> any/c (<=/c 4))]))
+         (class/c (augment [m (-> any/c (<=/c 3))])))
+  (ctest #t contract-equivalent?
+         (class/c (augride [m (-> any/c (<=/c 3))]))
+         (class/c (augride [m (-> any/c (<=/c 3))])))
+  (ctest #f contract-equivalent?
+         (class/c (augride [m (-> any/c (<=/c 3))]))
+         (class/c (augride [m (-> any/c (<=/c 4))])))
+  (ctest #f contract-equivalent?
+         (class/c (augride [m (-> any/c (<=/c 4))]))
+         (class/c (augride [m (-> any/c (<=/c 3))])))
+  (ctest #t contract-equivalent?
+         (class/c (absent m))
+         (class/c (absent m)))
+  (ctest #f contract-equivalent?
+         (class/c (absent m n))
+         (class/c (absent m)))
+  (ctest #f contract-equivalent?
+         (class/c (absent m))
+         (class/c (absent m n)))
+  (ctest #t contract-equivalent?
+         (class/c (absent (field f)))
+         (class/c (absent (field f))))
+  (ctest #f contract-equivalent?
+         (class/c (absent (field f g)))
+         (class/c (absent (field f))))
+  (ctest #f contract-equivalent?
+         (class/c (absent (field f)))
+         (class/c (absent (field f g))))
+  (ctest #f contract-equivalent?
+         (class/c (absent (field x)))
+         (class/c (absent x)))
+  (ctest #f contract-equivalent?
+         (class/c (absent x))
+         (class/c (absent (field x))))
+  
+  (ctest #t contract-equivalent?
+         (instanceof/c (class/c (m (-> any/c (<=/c 3)))))
+         (instanceof/c (class/c (m (-> any/c (<=/c 3))))))
+  (ctest #f contract-equivalent?
+         (instanceof/c (class/c (m (-> any/c (<=/c 3)))))
+         (instanceof/c (class/c (m (-> any/c (<=/c 4))))))
+  (ctest #f contract-equivalent?
+         (instanceof/c (class/c (m (-> any/c (<=/c 4)))))
+         (instanceof/c (class/c (m (-> any/c (<=/c 3))))))
+
+  (ctest #t contract-equivalent?
+         (object/c (m (-> any/c (<=/c 3))))
+         (object/c (m (-> any/c (<=/c 3)))))
+  (ctest #f contract-equivalent?
+         (object/c (m (-> any/c (<=/c 3))))
+         (object/c (m (-> any/c (<=/c 4)))))
+  (ctest #t contract-equivalent?
+         (object/c (field (f (<=/c 4))))
+         (object/c (field (f (<=/c 4)))))
+  (ctest #f contract-equivalent?
+         (object/c (m (-> any/c (<=/c 3)))
+                   (n (-> any/c any/c)))
+         (object/c (m (-> any/c (<=/c 4)))))
+  (ctest #f contract-equivalent?
+         (object/c (m (-> any/c (<=/c 4))))
+         (object/c (m (-> any/c (<=/c 3)))))
+  (ctest #f contract-equivalent?
+         (object/c (field (f (<=/c 4))))
+         (object/c (field (f (<=/c 3)))))
+  (ctest #f contract-equivalent?
+         (object/c (m (-> any/c (<=/c 3))))
+         (object/c (n (-> any/c (<=/c 4)))))
+  (ctest #f contract-equivalent?
+         (object/c (field (x any/c)))
+         (object/c (field (y any/c))))
+  (ctest #f contract-equivalent?
+         (object/c (m (-> any/c (<=/c 4))))
+         (object/c (m (-> any/c (<=/c 3)))
+                   (n (-> any/c any/c))))
+  
+  (ctest #t contract-equivalent? (is-a?/c object%) (is-a?/c object%))
+  (ctest #f contract-equivalent? (is-a?/c (class object% (super-new))) (is-a?/c object%))
+  (ctest #f contract-equivalent? (is-a?/c object%) (is-a?/c (class object% (super-new))))
+  (contract-eval `(define one-interface<%> (interface ())))
+  (contract-eval `(define another-interface<%> (interface (one-interface<%>))))
+  (ctest #t contract-equivalent? (is-a?/c one-interface<%>) (is-a?/c one-interface<%>))
+  (ctest #f contract-equivalent? (is-a?/c another-interface<%>) (is-a?/c one-interface<%>))
+  (ctest #f contract-equivalent? (is-a?/c one-interface<%>) (is-a?/c another-interface<%>))
+  (ctest #f contract-equivalent? 
+         (is-a?/c (class* object% (one-interface<%>) (super-new)))
+         (is-a?/c one-interface<%>))
+  (ctest #f contract-equivalent?
+         (is-a?/c one-interface<%>) 
+         (is-a?/c (class* object% (one-interface<%>) (super-new))))
+  
+  (ctest #t contract-equivalent? (subclass?/c object%) (subclass?/c object%))
+  (ctest #f contract-equivalent? (subclass?/c (class object% (super-new))) (subclass?/c object%))
+  (ctest #f contract-equivalent? (subclass?/c object%) (subclass?/c (class object% (super-new))))
+  (ctest #t contract-equivalent?
+         (implementation?/c one-interface<%>)
+         (implementation?/c one-interface<%>))
+  (ctest #f contract-equivalent?
+         (implementation?/c another-interface<%>)
+         (implementation?/c one-interface<%>))
+  (ctest #f contract-equivalent?
+         (implementation?/c one-interface<%>)
+         (implementation?/c another-interface<%>))
+
+  (ctest #t contract-equivalent? (evt/c integer?) (evt/c integer?))
+  (ctest #f contract-equivalent? (evt/c integer?) (evt/c boolean?))
+  
+  ;; chances are, this predicate will accept "x", but
+  ;; we don't want to consider it stronger, since it 
+  ;; will not always accept "x".
+  (ctest #f contract-equivalent? "x" (λ (x) (not (zero? (random 10000)))))
+
+  (contract-eval
+   `(let ()
+      (define (non-zero? x) (not (zero? x)))
+      (define list-of-numbers
+        (or/c null?
+              (couple/c number?
+                        (recursive-contract list-of-numbers))))
+      (define (short-list/less-than n)
+        (or/c null?
+              (couple/c (<=/c n)
+                        (or/c null?
+                              (couple/c (<=/c n)
+                                        any/c)))))
+      (define (short-sorted-list/less-than n)
+        (or/c null?
+              (couple/dc
+               [hd (<=/c n)]
+               [tl (hd) (or/c null?
+                              (couple/c (<=/c hd)
+                                        any/c))])))
+
+      (define (sorted-list/less-than n)
+        (or/c null?
+              (couple/dc
+               [hd (<=/c n)]
+               [tl (hd) (sorted-list/less-than hd)])))
+
+      ;; for some reason, the `n' makes it harder to optimize. 
+      ;; without it, this test isn't as good a test
+      (define (closure-comparison-test n)
+        (couple/dc
+         [hd any/c]
+         [tl (hd) (if (< (random n) -1) none/c any/c)]))
+
+      (,test #:test-case-name 'dsc.1 #t contract-equivalent? (couple/c any/c any/c) (couple/c any/c any/c))
+      (,test #:test-case-name 'dsc.2 #f contract-equivalent? (couple/c (>=/c 2) (>=/c 3)) (couple/c (>=/c 4) (>=/c 5)))
+      (,test #:test-case-name 'dsc.3 #f contract-equivalent? (couple/c (>=/c 4) (>=/c 5)) (couple/c (>=/c 2) (>=/c 3)))
+      (,test #:test-case-name 'dsc.4 #f contract-equivalent? (couple/c (>=/c 1) (>=/c 5)) (couple/c (>=/c 5) (>=/c 1)))
+      (let ([ctc (couple/dc [hd any/c] [tl (hd) any/c])])
+        (,test #:test-case-name 'dsc.5 #t contract-equivalent? ctc ctc))
+      (let ([ctc (couple/dc [hd any/c] [tl (hd) (<=/c hd)])])
+        (,test #:test-case-name 'dsc.6 #t contract-equivalent? ctc ctc))
+      (,test #:test-case-name 'dsc.7 #t contract-equivalent? list-of-numbers list-of-numbers)
+      (,test #:test-case-name 'dsc.8 #t contract-equivalent? (short-list/less-than 4) (short-list/less-than 4))
+      (,test #:test-case-name 'dsc.9 #f contract-equivalent? (short-list/less-than 4) (short-list/less-than 5))
+      (,test #:test-case-name 'dsc.10 #f contract-equivalent? (short-list/less-than 5) (short-list/less-than 4))
+      (,test #:test-case-name 'dsc.11 #t contract-equivalent? (short-sorted-list/less-than 4) (short-sorted-list/less-than 4))
+      (,test #:test-case-name 'dsc.12 #f contract-equivalent? (short-sorted-list/less-than 4) (short-sorted-list/less-than 5))
+      (,test #:test-case-name 'dsc.13 #f contract-equivalent? (short-sorted-list/less-than 5) (short-sorted-list/less-than 4))
+      (,test #:test-case-name 'dsc.14 #t contract-equivalent? (sorted-list/less-than 4) (sorted-list/less-than 4))
+      (,test #:test-case-name 'dsc.15 #f contract-equivalent? (sorted-list/less-than 4) (sorted-list/less-than 5))
+      (,test #:test-case-name 'dsc.16 #f contract-equivalent? (sorted-list/less-than 5) (sorted-list/less-than 4))
+      (,test #:test-case-name 'dsc.17 #t contract-equivalent? (closure-comparison-test 4) (closure-comparison-test 4))
+      (,test #:test-case-name 'dsc.18 #f contract-equivalent? (closure-comparison-test 4) (closure-comparison-test 5))
+
+      (letrec ([mk-c
+                (λ (x)
+                  (triple/dc [a (<=/c x)]
+                             [b any/c]
+                             [c (a b) (or/c #f (mk-c a))]))])
+        (,test #:test-case-name 'dsc.19 #t contract-equivalent? (mk-c 1) (mk-c 1)))
+      (letrec ([mk-c
+                (λ (x)
+                  (triple/dc [a (<=/c x)]
+                             [b any/c]
+                             [c (a b) (or/c #f (mk-c a))]))])
+        (,test #:test-case-name 'dsc.20 #f contract-equivalent? (mk-c 1) (mk-c 2)))))
+
+  (contract-eval
+   `(let ()
+      (define (non-zero? x) (not (zero? x)))
+      (define list-of-numbers
+        (first-or/c null?
+                    (couple/c number?
+                              (recursive-contract list-of-numbers))))
+      (define (short-list/less-than n)
+        (first-or/c null?
+                    (couple/c (<=/c n)
+                              (first-or/c null?
+                                          (couple/c (<=/c n)
+                                                    any/c)))))
+      (define (short-sorted-list/less-than n)
+        (first-or/c null?
+                    (couple/dc
+                     [hd (<=/c n)]
+                     [tl (hd) (first-or/c null?
+                                          (couple/c (<=/c hd)
+                                                    any/c))])))
+
+      (define (sorted-list/less-than n)
+        (first-or/c null?
+                    (couple/dc
+                     [hd (<=/c n)]
+                     [tl (hd) (sorted-list/less-than hd)])))
+
+      (define (closure-comparison-test n)
+        (couple/dc
+         [hd any/c]
+         [tl (hd) (if (< (random 10) (- n)) none/c  any/c)]))
+
+      (,test #:test-case-name 'couple.1
+             #t contract-equivalent? (couple/c any/c any/c) (couple/c any/c any/c))
+      (,test #:test-case-name 'couple.2
+             #f contract-equivalent? (couple/c (>=/c 2) (>=/c 3)) (couple/c (>=/c 4) (>=/c 5)))
+      (,test #:test-case-name 'couple.3
+             #f contract-equivalent? (couple/c (>=/c 4) (>=/c 5)) (couple/c (>=/c 2) (>=/c 3)))
+      (,test #:test-case-name 'couple.4
+             #f contract-equivalent? (couple/c (>=/c 1) (>=/c 5)) (couple/c (>=/c 5) (>=/c 1)))
+      (let ([ctc (couple/dc [hd any/c] [tl (hd) any/c])])
+        (,test #:test-case-name 'couple.5 #t contract-equivalent? ctc ctc))
+      (let ([ctc (couple/dc [hd any/c] [tl (hd) (<=/c hd)])])
+        (,test #:test-case-name 'couple.6 #t contract-equivalent? ctc ctc))
+      (,test #:test-case-name 'couple.7 #t contract-equivalent? list-of-numbers list-of-numbers)
+      (,test #:test-case-name 'couple.8 #f contract-equivalent? (short-list/less-than 4) (short-list/less-than 5))
+      (,test #:test-case-name 'couple.9 #f contract-equivalent? (short-list/less-than 5) (short-list/less-than 4))
+      (,test #:test-case-name 'couple.10 #t contract-equivalent? (short-sorted-list/less-than 4) (short-sorted-list/less-than 4))
+      (,test #:test-case-name 'couple.11 #f contract-equivalent? (short-sorted-list/less-than 4) (short-sorted-list/less-than 5))
+      (,test #:test-case-name 'couple.12 #f contract-equivalent? (short-sorted-list/less-than 5) (short-sorted-list/less-than 4))
+      (,test #:test-case-name 'couple.13 #t contract-equivalent? (sorted-list/less-than 4) (sorted-list/less-than 4))
+      (,test #:test-case-name 'couple.14 #f contract-equivalent? (sorted-list/less-than 4) (sorted-list/less-than 5))
+      (,test #:test-case-name 'couple.15 #f contract-equivalent? (sorted-list/less-than 5) (sorted-list/less-than 4))
+      (,test #:test-case-name 'couple.16 #t contract-equivalent? (closure-comparison-test 4) (closure-comparison-test 4))
+      (,test #:test-case-name 'couple.17 #f contract-equivalent? (closure-comparison-test 4) (closure-comparison-test 5))
+
+      (letrec ([mk-c
+                (λ (x)
+                  (triple/dc [a (<=/c x)]
+                             [b any/c]
+                             [c (a b) (or/c #f (mk-c a))]))])
+        (,test #:test-case-name 'couple.18 #t contract-equivalent? (mk-c 1) (mk-c 1)))
+
+      (letrec ([mk-c
+                (λ (x)
+                  (triple/dc [a (<=/c x)]
+                             [b any/c]
+                             [c (a b) (or/c #f (mk-c a))]))])
+        (,test #:test-case-name 'couple.19 #f contract-equivalent? (mk-c 1) (mk-c 2)))))
+
+
+  (contract-eval
+   `(let ()
+
+      (struct s (a b))
+      (struct t (a b))
+
+      (,test #:test-case-name 'struct/dc.1 #f contract-equivalent?
+             (struct/dc s
+                        [a (>=/c 1)]
+                        [b (>=/c 2)])
+             (struct/dc s
+                        [a (>=/c 2)]
+                        [b (>=/c 3)]))
+      (,test #:test-case-name 'struct/dc.2 #t contract-equivalent?
+             (struct/dc s
+                        [a (>=/c 2)]
+                        [b (>=/c 3)])
+             (struct/dc s
+                        [a (>=/c 2)]
+                        [b (>=/c 3)]))
+      (,test #:test-case-name 'struct/dc.3 #f contract-equivalent?
+             (struct/dc s
+                        [a (>=/c 2)]
+                        [b (>=/c 3)])
+             (struct/dc s
+                        [a (>=/c 1)]
+                        [b (>=/c 2)]))
+
+      (,test #:test-case-name 'struct/dc.4 #f contract-equivalent?
+             (struct/dc s
+                        [a number?]
+                        [b number?])
+             (struct/dc t
+                        [a number?]
+                        [b number?]))
+
+      (,test #:test-case-name 'struct/dc.5 #f contract-equivalent?
+             (struct/dc t
+                        [a number?]
+                        [b number?])
+             (struct/dc s
+                        [a number?]
+                        [b number?]))
+      
+      (,test #:test-case-name 'struct/dc.6 #f
+             contract-equivalent?
+             (struct/dc s
+                        [a integer?]
+                        [b integer?])
+             (struct/dc s
+                        [a integer?]
+                        [b integer?]
+                        #:inv (a b) #f))
+      
+      (,test #:test-case-name 'struct/dc.7 #f
+             contract-equivalent?
+             (struct/dc s
+                        [a integer?]
+                        [b integer?]
+                        #:inv (a b) #f)
+             (struct/dc s
+                        [a integer?]
+                        [b integer?]))
+      
+
+      (define (mk c)
+        (struct/dc s
+                   [a (>=/c c)]
+                   [b (a) (>=/c a)]))
+      (define one (mk 1))
+      (define two (mk 2))
+      (,test #:test-case-name 'struct/dc.8 #t contract-equivalent? one one)
+      (,test #:test-case-name 'struct/dc.9 #f contract-equivalent? one two)
+      (,test #:test-case-name 'struct/dc.10 #f contract-equivalent? 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-equivalent? imp-ctc imp-ctc)
+  (ctest #f contract-equivalent? imp-struct-ctc imp-struct-ctc))
diff --git a/racket/collects/racket/contract/combinator.rkt b/racket/collects/racket/contract/combinator.rkt
index 7f1b198303..cbb2e0d677 100644
--- a/racket/collects/racket/contract/combinator.rkt
+++ b/racket/collects/racket/contract/combinator.rkt
@@ -51,6 +51,7 @@
  build-compound-type-name
  
  contract-stronger?
+ contract-equivalent?
  list-contract?
  
  contract-first-order
diff --git a/racket/collects/racket/contract/private/and.rkt b/racket/collects/racket/contract/private/and.rkt
index aac193ad1d..843f65ebff 100644
--- a/racket/collects/racket/contract/private/and.rkt
+++ b/racket/collects/racket/contract/private/and.rkt
@@ -62,6 +62,11 @@
        (pairwise-stronger-contracts? (base-and/c-ctcs this)
                                      (base-and/c-ctcs that))))
 
+(define (and-equivalent? this that)
+  (and (base-and/c? that)
+       (pairwise-equivalent-contracts? (base-and/c-ctcs this)
+                                       (base-and/c-ctcs that))))
+
 (define (and/c-generate? ctc)
   (cond
     [(and/c-check-nonneg ctc real?) => values]
@@ -147,6 +152,7 @@
    #:name and-name
    #:first-order and-first-order
    #:stronger and-stronger?
+   #:equivalent and-equivalent?
    #:generate and/c-generate?))
 (define-struct (chaperone-and/c base-and/c) ()
   #:property prop:custom-write custom-write-property-proc
@@ -156,6 +162,7 @@
    #:name and-name
    #:first-order and-first-order
    #:stronger and-stronger?
+   #:equivalent and-equivalent?
    #:generate and/c-generate?))
 (define-struct (impersonator-and/c base-and/c) ()
   #:property prop:custom-write custom-write-property-proc
@@ -165,6 +172,7 @@
    #:name and-name
    #:first-order and-first-order
    #:stronger and-stronger?
+   #:equivalent and-equivalent?
    #:generate and/c-generate?))
 
 (define-syntax (and/c stx)
@@ -274,15 +282,25 @@
     [else exact-integer?]))
 
 (define (integer-in-stronger this that)
-  (define this-start (or (integer-in-ctc-start this) -inf.0))
-  (define this-end (or (integer-in-ctc-end this) +inf.0))
   (cond
     [(integer-in-ctc? that)
+     (define this-start (or (integer-in-ctc-start this) -inf.0))
+     (define this-end (or (integer-in-ctc-end this) +inf.0))
      (define that-start (or (integer-in-ctc-start that) -inf.0))
      (define that-end (or (integer-in-ctc-end that) +inf.0))
      (<= that-start this-start this-end that-end)]
     [else #f]))
 
+(define (integer-in-equivalent this that)
+  (cond
+    [(integer-in-ctc? that)
+     (define this-start (or (integer-in-ctc-start this) -inf.0))
+     (define this-end (or (integer-in-ctc-end this) +inf.0))
+     (define that-start (or (integer-in-ctc-start that) -inf.0))
+     (define that-end (or (integer-in-ctc-end that) +inf.0))
+     (and (= that-start this-start) (= this-end that-end))]
+    [else #f]))
+
 (define (integer-in-generate ctc)
   (define start (integer-in-ctc-start ctc))
   (define end (integer-in-ctc-end ctc))
@@ -311,6 +329,7 @@
    #:name integer-in-name
    #:first-order integer-in-first-order
    #:stronger integer-in-stronger
+   #:equivalent integer-in-equivalent
    #:generate integer-in-generate))
 
 (struct renamed-integer-in integer-in-ctc (name)
@@ -319,6 +338,7 @@
    #:name (λ (ctc) (renamed-integer-in-name ctc))
    #:first-order integer-in-first-order
    #:stronger integer-in-stronger
+   #:equivalent integer-in-equivalent
    #:generate integer-in-generate))
 
 (define (geo-dist p)
diff --git a/racket/collects/racket/contract/private/arr-d.rkt b/racket/collects/racket/contract/private/arr-d.rkt
index b37559c6f4..d5fd00fec1 100644
--- a/racket/collects/racket/contract/private/arr-d.rkt
+++ b/racket/collects/racket/contract/private/arr-d.rkt
@@ -545,7 +545,7 @@
       (if (base-->d-rest-ctc ctc)
           (check-procedure/more val mtd? dom-length mandatory-kwds optional-kwds #f #f)
           (check-procedure val mtd? dom-length optionals mandatory-kwds optional-kwds #f #f)))))
-(define (->d-stronger? this that) (eq? this that))
+(define (->d-equivalent? this that) (eq? this that))
 
 ;; in the struct type descriptions "d???" refers to the arguments (domain) of the function that
 ;; is under the contract, and "dr???" refers to the arguments & the results of the function that 
@@ -580,4 +580,5 @@
    #:late-neg-projection (late-neg-->d-proj impersonate-procedure)
    #:name (->d-name #|print-as-method-if-method?|# #t)
    #:first-order ->d-first-order
-   #:stronger ->d-stronger?))
+   #:equivalent ->d-equivalent?
+   #:stronger ->d-equivalent?))
diff --git a/racket/collects/racket/contract/private/arr-i.rkt b/racket/collects/racket/contract/private/arr-i.rkt
index 1edf9a03f0..b18715d000 100644
--- a/racket/collects/racket/contract/private/arr-i.rkt
+++ b/racket/collects/racket/contract/private/arr-i.rkt
@@ -317,6 +317,7 @@
              (check-procedure/more val mtd? mand-args mand-kwds opt-kwds #f #f)
              (check-procedure val mtd? mand-args opt-args mand-kwds opt-kwds #f #f)))))
    #:exercise exercise->i
+   #:equivalent (λ (this that) (eq? this that))
    #:stronger (λ (this that) (eq? this that)))) ;; WRONG
 
 (struct chaperone->i ->i () #:property prop:chaperone-contract (mk-prop #t))
diff --git a/racket/collects/racket/contract/private/arrow-val-first.rkt b/racket/collects/racket/contract/private/arrow-val-first.rkt
index 37a05de5f7..9428b938c6 100644
--- a/racket/collects/racket/contract/private/arrow-val-first.rkt
+++ b/racket/collects/racket/contract/private/arrow-val-first.rkt
@@ -1558,6 +1558,7 @@
        (λ (val)
          ((cblame val) #f))))
    #:stronger ->-stronger
+   #:equivalent ->-equivalent
    #:generate ->-generate
    #:exercise ->-exercise
    #:val-first-projection val-first-proj
@@ -1585,6 +1586,29 @@
        (not (base->-pre? that))
        (not (base->-post? this))
        (not (base->-post? that))))
+
+(define (->-equivalent this that)
+  (and (base->? that)
+       (= (length (base->-doms that))
+          (length (base->-doms this)))
+       (= (base->-min-arity this) (base->-min-arity that))
+       (andmap contract-struct-equivalent? (base->-doms that) (base->-doms this))
+       (= (length (base->-kwd-infos this))
+          (length (base->-kwd-infos that)))
+       (for/and ([this-kwd-info (base->-kwd-infos this)]
+                 [that-kwd-info (base->-kwd-infos that)])
+         (and (equal? (kwd-info-kwd this-kwd-info)
+                      (kwd-info-kwd that-kwd-info))
+              (contract-struct-equivalent? (kwd-info-ctc that-kwd-info)
+                                           (kwd-info-ctc this-kwd-info))))
+       (if (base->-rngs this)
+           (and (base->-rngs that)
+                (andmap contract-struct-equivalent? (base->-rngs this) (base->-rngs that)))
+           (not (base->-rngs that)))
+       (not (base->-pre? this))
+       (not (base->-pre? that))
+       (not (base->-post? this))
+       (not (base->-post? that))))
      
 (define-struct (-> base->) ()
   #:property prop:chaperone-contract (make-property #f))
diff --git a/racket/collects/racket/contract/private/base.rkt b/racket/collects/racket/contract/private/base.rkt
index 44e7815aa4..d169fdddfb 100644
--- a/racket/collects/racket/contract/private/base.rkt
+++ b/racket/collects/racket/contract/private/base.rkt
@@ -259,7 +259,7 @@
             ((f blame-known) val neg-party)))])]
     [else (recursive-contract-late-neg-projection ctc)]))
   
-(define (recursive-contract-stronger this that) (equal? this that))
+(define (recursive-contract-equivalent this that) (equal? this that))
 
 (define ((recursive-contract-first-order ctc) val)
   (cond
@@ -288,7 +288,8 @@
    #:name recursive-contract-name
    #:first-order recursive-contract-first-order
    #:late-neg-projection flat-recursive-contract-late-neg-projection
-   #:stronger recursive-contract-stronger
+   #:stronger recursive-contract-equivalent
+   #:equivalent recursive-contract-equivalent
    #:generate recursive-contract-generate
    #:list-contract? recursive-contract-list-contract?))
 (struct chaperone-recursive-contract recursive-contract ()
@@ -298,7 +299,8 @@
    #:name recursive-contract-name
    #:first-order recursive-contract-first-order
    #:late-neg-projection recursive-contract-late-neg-projection
-   #:stronger recursive-contract-stronger
+   #:stronger recursive-contract-equivalent
+   #:equivalent recursive-contract-equivalent
    #:generate recursive-contract-generate
    #:list-contract? recursive-contract-list-contract?))
 (struct impersonator-recursive-contract recursive-contract ()
@@ -308,6 +310,7 @@
    #:name recursive-contract-name
    #:first-order recursive-contract-first-order
    #:late-neg-projection recursive-contract-late-neg-projection
-   #:stronger recursive-contract-stronger
+   #:stronger recursive-contract-equivalent
+   #:equivalent recursive-contract-equivalent
    #:generate recursive-contract-generate
    #:list-contract? recursive-contract-list-contract?))
diff --git a/racket/collects/racket/contract/private/box.rkt b/racket/collects/racket/contract/private/box.rkt
index 619f397e0f..070dcd86a9 100644
--- a/racket/collects/racket/contract/private/box.rkt
+++ b/racket/collects/racket/contract/private/box.rkt
@@ -101,11 +101,35 @@
         (contract-struct-stronger? this-content-r that-content-r)]
        [(or (equal? that-immutable 'dont-care)
             (equal? this-immutable that-immutable))
-        (and (contract-struct-stronger? this-content-r that-content-r)
-             (contract-struct-stronger? that-content-w this-content-w))]
+        (if (and (eq? this-content-r this-content-w)
+                 (eq? that-content-r that-content-w))
+            ;; if the original box/c didn't specify a separate read and write
+            ;; contract, we end up in this case
+            (contract-struct-equivalent? this-content-r that-content-r)
+            (and (contract-struct-stronger? this-content-r that-content-r)
+                 (contract-struct-stronger? that-content-w this-content-w)))]
        [else #f])]
     [else #f]))
 
+(define (box/c-equivalent this that)
+  (cond
+    [(base-box/c? that)
+     (define this-content-w (base-box/c-content-w this))
+     (define this-content-r (base-box/c-content-r this))
+     (define this-immutable (base-box/c-immutable this))
+     (define that-content-w (base-box/c-content-w that))
+     (define that-content-r (base-box/c-content-r that))
+     (define that-immutable (base-box/c-immutable that))
+     (and (equal? this-immutable that-immutable)
+          (cond
+            [(or (equal? this-immutable 'immutable)
+                 (and (eq? this-content-r this-content-w)
+                      (eq? that-content-r that-content-w)))
+             (contract-struct-equivalent? this-content-r that-content-r)]
+            [else
+             (and (contract-struct-equivalent? this-content-r that-content-r)
+                  (contract-struct-equivalent? that-content-w this-content-w))]))]
+    [else #f]))
 
 (define-struct (flat-box/c base-box/c) ()
   #:property prop:custom-write custom-write-property-proc
@@ -114,6 +138,7 @@
    #:name box/c-name
    #:first-order box/c-first-order
    #:stronger box/c-stronger
+   #:equivalent box/c-equivalent
    #:late-neg-projection
    (λ (ctc)
      (define content-ctc (get/build-late-neg-projection (base-box/c-content-w ctc)))
@@ -184,6 +209,7 @@
    #:name box/c-name
    #:first-order box/c-first-order
    #:stronger box/c-stronger
+   #:equivalent box/c-equivalent
    #:late-neg-projection (ho-late-neg-projection chaperone-box)))
 
 (define-struct (impersonator-box/c base-box/c) ()
@@ -193,6 +219,7 @@
    #:name box/c-name
    #:first-order box/c-first-order
    #:stronger box/c-stronger
+   #:equivalent box/c-equivalent
    #:late-neg-projection (ho-late-neg-projection impersonate-box)))
 
 (define-syntax (box/c stx)
diff --git a/racket/collects/racket/contract/private/ds.rkt b/racket/collects/racket/contract/private/ds.rkt
index 8dc55bf60b..ad334918c7 100644
--- a/racket/collects/racket/contract/private/ds.rkt
+++ b/racket/collects/racket/contract/private/ds.rkt
@@ -229,13 +229,15 @@ it around flattened out.
                           ctc-field-val)] ...)
               (values f-x ...)))
           
-          (define (stronger-lazy-contract? a b)
+          (define (stronger/equivalent-lazy-contract?
+                   a b
+                   contract-struct-stronger/equivalent?)
             (and (contract-predicate b)
                  (let ([a-sel (contract-get a selector-indices)]
                        [b-sel (contract-get b selector-indices)])
                    (if (contract-struct? a-sel)
                        (if (contract-struct? b-sel)
-                           (contract-struct-stronger? a-sel b-sel)
+                           (contract-struct-stronger/equivalent? a-sel b-sel)
                            #f)
                        (if (contract-struct? b-sel)
                            #f
@@ -321,7 +323,13 @@ it around flattened out.
              #:projection lazy-contract-proj
              #:name lazy-contract-name
              #:first-order (lambda (ctc) predicate)
-             #:stronger stronger-lazy-contract?))
+             #:equivalent (λ (this that)
+                            (stronger/equivalent-lazy-contract?
+                             this that
+                             contract-struct-equivalent?))
+             #:stronger (λ (this that) (stronger/equivalent-lazy-contract?
+                                        this that
+                                        contract-struct-stronger?))))
           
           (define-values (contract-type contract-maker contract-predicate contract-get contract-set)
             (make-struct-type 'the-contract
diff --git a/racket/collects/racket/contract/private/exists.rkt b/racket/collects/racket/contract/private/exists.rkt
index 8fbfda0f6a..a84a3f9507 100644
--- a/racket/collects/racket/contract/private/exists.rkt
+++ b/racket/collects/racket/contract/private/exists.rkt
@@ -36,6 +36,7 @@
    #:first-order (λ (ctc) (λ (x) #t)) ;; ???
    #:late-neg-projection ∀∃-late-neg-proj
    #:stronger (λ (this that) (equal? this that))
+   #:equivalent (λ (this that) (equal? this that))
    #:generate (λ (ctc)
                 (cond
                   [(∀∃/c-neg? ctc)
diff --git a/racket/collects/racket/contract/private/guts.rkt b/racket/collects/racket/contract/private/guts.rkt
index f80d329b78..295a5fd479 100644
--- a/racket/collects/racket/contract/private/guts.rkt
+++ b/racket/collects/racket/contract/private/guts.rkt
@@ -22,6 +22,7 @@
          build-compound-type-name
          
          contract-stronger?
+         contract-equivalent?
          list-contract?
          
          contract-first-order
@@ -229,6 +230,10 @@
   (contract-struct-stronger? (coerce-contract 'contract-stronger? a)
                              (coerce-contract 'contract-stronger? b)))
 
+(define (contract-equivalent? a b)
+  (contract-struct-equivalent? (coerce-contract 'contract-equivalent? a)
+                               (coerce-contract 'contract-equivalent? b)))
+
 ;; coerce-flat-contract : symbol any/c -> contract
 (define (coerce-flat-contract name x)
   (define ctc (coerce-contract/f x))
@@ -557,6 +562,11 @@
          (and (predicate-contract? that)
               (predicate-contract-sane? that)
               ((predicate-contract-pred that) this-val))))
+   #:equivalent
+   (λ (this that)
+     (define this-val (eq-contract-val this))
+     (and (eq-contract? that)
+          (eq? this-val (eq-contract-val that))))
    #:list-contract? (λ (c) (null? (eq-contract-val c)))))
 
 (define false/c-contract (make-eq-contract #f #f))
@@ -576,6 +586,11 @@
          (and (predicate-contract? that)
               (predicate-contract-sane? that)
               ((predicate-contract-pred that) this-val))))
+   #:equivalent
+   (λ (this that)
+     (define this-val (equal-contract-val this))
+     (and (equal-contract? that)
+          (equal? this-val (equal-contract-val that))))
    #:generate
    (λ (ctc) 
      (define v (equal-contract-val ctc))
@@ -597,6 +612,13 @@
          (and (predicate-contract? that)
               (predicate-contract-sane? that)
               ((predicate-contract-pred that) this-val))))
+   #:equivalent
+   (λ (this that)
+     (define this-val (=-contract-val this))
+     (or (and (=-contract? that)
+              (= this-val (=-contract-val that)))
+         (and (between/c-s? that)
+              (= (between/c-s-low that) this-val (between/c-s-high that)))))
    #:generate
    (λ (ctc) 
      (define v (=-contract-val ctc))
@@ -659,6 +681,17 @@
         (and (char<=? that-low this-low)
              (char<=? this-high that-high))]
        [else #f]))
+   #:equivalent
+   (λ (this that)
+     (cond
+       [(char-in/c? that)
+        (define this-low (char-in/c-low this))
+        (define this-high (char-in/c-high this))
+        (define that-low (char-in/c-low that))
+        (define that-high (char-in/c-high that))
+        (and (char=? that-low this-low)
+             (char=? this-high that-high))]
+       [else #f]))
    #:generate
    (λ (ctc)
      (define low (char->integer (char-in/c-low ctc)))
@@ -668,6 +701,10 @@
        (λ ()
          (integer->char (+ low (random delta))))))))
 
+(define (regexp/c-equivalent this that)
+  (and (regexp/c? that)
+       (equal? (regexp/c-reg this) (regexp/c-reg that))))
+
 (define-struct regexp/c (reg name)
   #:property prop:custom-write contract-custom-write-property-proc
   #:property prop:flat-contract
@@ -679,9 +716,13 @@
          (and (or (string? x) (bytes? x))
               (regexp-match? reg x))))
    #:name (λ (ctc) (regexp/c-reg ctc))
-   #:stronger
-   (λ (this that)
-      (and (regexp/c? that) (equal? (regexp/c-reg this) (regexp/c-reg that))))))
+   #:stronger regexp/c-equivalent
+   #:equivalent regexp/c-equivalent))
+
+(define (predicate-contract-equivalent this that)
+  (and (predicate-contract? that)
+       (procedure-closure-contents-eq? (predicate-contract-pred this)
+                                       (predicate-contract-pred that))))
 
 ;; sane? : boolean -- indicates if we know that the predicate is well behaved
 ;; (for now, basically amounts to trusting primitive procedures)
@@ -689,11 +730,8 @@
   #:property prop:custom-write contract-custom-write-property-proc
   #:property prop:flat-contract
   (build-flat-contract-property
-   #:stronger
-   (λ (this that) 
-     (and (predicate-contract? that)
-          (procedure-closure-contents-eq? (predicate-contract-pred this)
-                                          (predicate-contract-pred that))))
+   #:stronger predicate-contract-equivalent
+   #:equivalent predicate-contract-equivalent
    #:name (λ (ctc) (predicate-contract-name ctc))
    #:first-order (λ (ctc) (predicate-contract-pred ctc))
    #:late-neg-projection
diff --git a/racket/collects/racket/contract/private/hash.rkt b/racket/collects/racket/contract/private/hash.rkt
index b7436e2880..b5223962a2 100644
--- a/racket/collects/racket/contract/private/hash.rkt
+++ b/racket/collects/racket/contract/private/hash.rkt
@@ -169,13 +169,25 @@
              (contract-struct-stronger? this-rng that-rng))]
        [(or (equal? that-immutable 'dont-care)
             (equal? this-immutable that-immutable))
-        (and (contract-struct-stronger? this-dom that-dom)
-             (contract-struct-stronger? that-dom this-dom)
-             (contract-struct-stronger? this-rng that-rng)
-             (contract-struct-stronger? that-rng this-rng))]
+        (and (contract-struct-equivalent? this-dom that-dom)
+             (contract-struct-equivalent? this-rng that-rng))]
        [else #f])]
     [else #f]))
 
+(define (hash/c-equivalent this that)
+  (cond
+    [(base-hash/c? that)
+     (define this-dom (base-hash/c-dom this))
+     (define this-rng (base-hash/c-rng this))
+     (define this-immutable (base-hash/c-immutable this))
+     (define that-dom (base-hash/c-dom that))
+     (define that-rng (base-hash/c-rng that))
+     (define that-immutable (base-hash/c-immutable that))
+     (and (equal? this-immutable that-immutable)
+          (contract-struct-equivalent? this-dom that-dom)
+          (contract-struct-equivalent? this-rng that-rng))]
+    [else #f]))
+
 (define-struct (flat-hash/c base-hash/c) ()
   #:omit-define-syntaxes
   #:property prop:custom-write custom-write-property-proc
@@ -184,6 +196,7 @@
    #:name hash/c-name
    #:first-order hash/c-first-order
    #:stronger hash/c-stronger
+   #:equivalent hash/c-equivalent
    #:late-neg-projection
    (λ (ctc)
      (define dom-ctc (base-hash/c-dom ctc))
@@ -299,6 +312,7 @@
    #:name hash/c-name
    #:first-order hash/c-first-order
    #:stronger hash/c-stronger
+   #:equivalent hash/c-equivalent
    #:late-neg-projection (ho-projection chaperone-hash)))
 
 (define-struct (impersonator-hash/c base-hash/c) ()
@@ -309,6 +323,7 @@
    #:name hash/c-name
    #:first-order hash/c-first-order
    #:stronger hash/c-stronger
+   #:equivalent hash/c-equivalent
    #:late-neg-projection (ho-projection impersonate-hash)))
 
 
@@ -337,6 +352,7 @@
                 (contract-first-order-passes? (rng-f k) v))))))
 
 (define (hash/dc-stronger this that) #f)
+(define (hash/dc-equivalent this that) #f)
 
 (define ((hash/dc-late-neg-projection chaperone-or-impersonate-hash) ctc)
   (define dom-ctc (base-hash/dc-dom ctc))
@@ -371,6 +387,7 @@
   (build-flat-contract-property
    #:name hash/dc-name
    #:first-order hash/dc-first-order
+   #:equivalent hash/dc-equivalent
    #:stronger hash/dc-stronger))
 
 (struct chaperone-hash/dc base-hash/dc ()
@@ -380,6 +397,7 @@
    #:name hash/dc-name
    #:first-order hash/dc-first-order
    #:stronger hash/dc-stronger
+   #:equivalent hash/dc-equivalent
    #:late-neg-projection (hash/dc-late-neg-projection chaperone-hash)))
 (struct impersonator-hash/dc base-hash/dc ()
   #:property prop:custom-write custom-write-property-proc
@@ -388,6 +406,7 @@
    #:name hash/dc-name
    #:first-order hash/dc-first-order
    #:stronger hash/dc-stronger
+   #:equivalent hash/dc-equivalent
    #:late-neg-projection (hash/dc-late-neg-projection impersonate-hash)))
 
 (define (build-hash/dc dom dep-rng here name-info immutable kind)
diff --git a/racket/collects/racket/contract/private/list.rkt b/racket/collects/racket/contract/private/list.rkt
index 299f454a6d..4cb7d12f81 100644
--- a/racket/collects/racket/contract/private/list.rkt
+++ b/racket/collects/racket/contract/private/list.rkt
@@ -107,6 +107,28 @@
           (contract-struct-stronger? this-elem hd-ctc)
           (contract-struct-stronger? (ne->pe-ctc this) tl-ctc))]
     [else #f]))
+
+(define (listof-equivalent this that)
+  (define this-elem (listof-ctc-elem-c this))
+  (cond
+    [(listof-ctc? that)
+     (define that-elem (listof-ctc-elem-c that))
+     (cond
+       [(pe-listof-ctc? this) (and (pe-listof-ctc? that)
+                                   (contract-struct-equivalent? this-elem that-elem))]
+       [(im-listof-ctc? this)
+        (and (im-listof-ctc? that)
+             (contract-struct-equivalent? this-elem that-elem)
+             (contract-struct-equivalent? (im-listof-ctc-last-c this)
+                                          (im-listof-ctc-last-c that)))]
+       [else (contract-struct-equivalent? this-elem that-elem)])]
+    [(the-cons/c? that)
+     (define hd-ctc (the-cons/c-hd-ctc that))
+     (define tl-ctc (the-cons/c-tl-ctc that))
+     (and (ne-listof-ctc? this)
+          (contract-struct-equivalent? this-elem hd-ctc)
+          (contract-struct-equivalent? (ne->pe-ctc this) tl-ctc))]
+    [else #f]))
            
 (define (raise-listof-blame-error blame val empty-ok? neg-party)
   (raise-blame-error blame #:missing-party neg-party val
@@ -219,6 +241,7 @@
    #:generate listof-generate
    #:exercise listof-exercise
    #:stronger listof-stronger
+   #:equivalent listof-equivalent
    #:list-contract? (λ (c) (not (im-listof-ctc? c)))))
 (define chap-prop
   (build-chaperone-contract-property
@@ -228,6 +251,7 @@
    #:generate listof-generate
    #:exercise listof-exercise
    #:stronger listof-stronger
+   #:equivalent listof-equivalent
    #:list-contract? (λ (c) (not (im-listof-ctc? c)))))
 (define full-prop
   (build-contract-property
@@ -237,6 +261,7 @@
    #:generate listof-generate
    #:exercise listof-exercise
    #:stronger listof-stronger
+   #:equivalent listof-equivalent
    #:list-contract? (λ (c) (not (im-listof-ctc? c)))))
 
 (struct listof-ctc (elem-c))
@@ -382,6 +407,20 @@
           (contract-struct-stronger? this-tl that))]
     [else #f]))
 
+(define (cons/c-equivalent? this that)
+  (define this-hd (the-cons/c-hd-ctc this))
+  (define this-tl (the-cons/c-tl-ctc this))
+  (cond
+    [(the-cons/c? that)
+     (define that-hd (the-cons/c-hd-ctc that))
+     (define that-tl (the-cons/c-tl-ctc that))
+     (and (contract-struct-equivalent? this-hd that-hd)
+          (contract-struct-equivalent? this-tl that-tl))]
+    [(ne-listof-ctc? that)
+     (define elem-ctc (listof-ctc-elem-c that))
+     (and (contract-struct-equivalent? this-hd elem-ctc)
+          (contract-struct-equivalent? this-tl (ne->pe-ctc that)))]
+    [else #f]))
 
 (define (cons/c-generate ctc)
   (define ctc-car (the-cons/c-hd-ctc ctc))
@@ -405,6 +444,7 @@
    #:name cons/c-name
    #:first-order cons/c-first-order
    #:stronger cons/c-stronger?
+   #:equivalent cons/c-equivalent?
    #:generate cons/c-generate
    #:list-contract? cons/c-list-contract?))
 (define-struct (chaperone-cons/c the-cons/c) ()
@@ -415,6 +455,7 @@
    #:name cons/c-name
    #:first-order cons/c-first-order
    #:stronger cons/c-stronger?
+   #:equivalent cons/c-equivalent?
    #:generate cons/c-generate
    #:list-contract? cons/c-list-contract?))
 (define-struct (impersonator-cons/c the-cons/c) ()
@@ -425,6 +466,7 @@
    #:name cons/c-name
    #:first-order cons/c-first-order
    #:stronger cons/c-stronger?
+   #:equivalent cons/c-equivalent?
    #:generate cons/c-generate
    #:list-contract? cons/c-list-contract?))
 
@@ -496,6 +538,7 @@
                  dep-val))))))
 
 (define (cons/dc-stronger? this that) #f)
+(define (cons/dc-equivalent? this that) #f)
 
 (define (cons/dc-generate ctc)
   (define undep-ctc (the-cons/dc-undep ctc))
@@ -526,6 +569,7 @@
    #:name cons/dc-name
    #:first-order cons/dc-first-order
    #:stronger cons/dc-stronger?
+   #:equivalent cons/dc-equivalent?
    #:generate cons/dc-generate))
 
 (struct chaperone-cons/dc the-cons/dc ()
@@ -536,6 +580,7 @@
    #:name cons/dc-name
    #:first-order cons/dc-first-order
    #:stronger cons/dc-stronger?
+   #:equivalent cons/dc-equivalent?
    #:generate cons/dc-generate))
 
 (struct impersonator-cons/dc the-cons/dc ()
@@ -546,6 +591,7 @@
    #:name cons/dc-name
    #:first-order cons/dc-first-order
    #:stronger cons/dc-stronger?
+   #:equivalent cons/dc-equivalent?
    #:generate cons/dc-generate))
 
 (define-syntax (cons/dc stx)
@@ -669,6 +715,13 @@
             (contract-struct-stronger? this-s that-elem-ctc)))]
     [else #f]))
 
+(define (list/c-equivalent this that)
+  (cond
+    [(generic-list/c? that)
+     (pairwise-equivalent-contracts? (generic-list/c-args this)
+                                     (generic-list/c-args that))]
+    [else #f]))
+
 (struct generic-list/c (args))
 
 (struct flat-list/c generic-list/c ()
@@ -680,6 +733,7 @@
    #:generate list/c-generate
    #:exercise list/c-exercise
    #:stronger list/c-stronger
+   #:equivalent list/c-equivalent
    #:late-neg-projection
    (λ (c) 
      (λ (blame)
@@ -774,6 +828,7 @@
    #:generate list/c-generate
    #:exercise list/c-exercise
    #:stronger list/c-stronger
+   #:equivalent list/c-equivalent
    #:late-neg-projection list/c-chaperone/other-late-neg-projection
    #:list-contract? (λ (c) #t)))
 
@@ -786,6 +841,7 @@
    #:generate list/c-generate
    #:exercise list/c-exercise
    #:stronger list/c-stronger
+   #:equivalent list/c-equivalent
    #:late-neg-projection list/c-chaperone/other-late-neg-projection
    #:list-contract? (λ (c) #t)))
 
@@ -882,6 +938,17 @@
             (contract-struct-stronger? suf that-elem)))]
     [else #f]))
 
+(define (*list/c-equivalent this that)
+  (define this-prefix (*list-ctc-prefix this))
+  (define this-suffix (*list-ctc-suffix this))
+  (cond
+    [(*list-ctc? that)
+     (define that-prefix (*list-ctc-prefix that))
+     (define that-suffix (*list-ctc-suffix that))
+     (and (contract-struct-equivalent? this-prefix that-prefix)
+          (pairwise-equivalent-contracts? this-suffix that-suffix))]
+    [else #f]))
+
 (define (*list/c-late-neg-projection ctc start-index flat?)
   (define prefix-lnp (contract-late-neg-projection (*list-ctc-prefix ctc)))
   (define suffix-lnps (map contract-late-neg-projection (*list-ctc-suffix ctc)))
@@ -959,6 +1026,7 @@
    #:generate *list/c-generate
    #:exercise *list/c-exercise
    #:stronger *list/c-stronger
+   #:equivalent *list/c-equivalent
    #:late-neg-projection (λ (ctc) (*list/c-late-neg-projection ctc #f #t))
    #:list-contract? (λ (c) #t)))
 (struct chaperone-*list/c *list-ctc ()
@@ -969,6 +1037,7 @@
    #:generate *list/c-generate
    #:exercise *list/c-exercise
    #:stronger *list/c-stronger
+   #:equivalent *list/c-equivalent
    #:late-neg-projection (λ (ctc) (*list/c-late-neg-projection ctc #f #f))
    #:list-contract? (λ (c) #t)))
 (struct impersonator-*list/c *list-ctc ()
@@ -979,6 +1048,7 @@
    #:generate *list/c-generate
    #:exercise *list/c-exercise
    #:stronger *list/c-stronger
+   #:equivalent *list/c-equivalent
    #:late-neg-projection (λ (ctc) (*list/c-late-neg-projection ctc #f #f))
    #:list-contract? (λ (c) #t)))
 
@@ -1022,6 +1092,7 @@
    #:generate *list/c-generate
    #:exercise *list/c-exercise
    #:stronger *list/c-stronger
+   #:equivalent *list/c-equivalent
    #:late-neg-projection
    (λ (ctc) (*list/c-late-neg-projection ctc (ellipsis-rest-arg-ctc-start-index ctc) #t))
    #:list-contract? (λ (c) #t)))
@@ -1033,6 +1104,7 @@
    #:generate *list/c-generate
    #:exercise *list/c-exercise
    #:stronger *list/c-stronger
+   #:equivalent *list/c-equivalent
    #:late-neg-projection
    (λ (ctc) (*list/c-late-neg-projection ctc (ellipsis-rest-arg-ctc-start-index ctc) #f))
    #:list-contract? (λ (c) #t)))
@@ -1044,6 +1116,7 @@
    #:generate *list/c-generate
    #:exercise *list/c-exercise
    #:stronger *list/c-stronger
+   #:equivalent *list/c-equivalent
    #:late-neg-projection
    (λ (ctc) (*list/c-late-neg-projection ctc (ellipsis-rest-arg-ctc-start-index ctc) #f))
    #:list-contract? (λ (c) #t)))
diff --git a/racket/collects/racket/contract/private/misc.rkt b/racket/collects/racket/contract/private/misc.rkt
index afd28207b5..93c596d086 100644
--- a/racket/collects/racket/contract/private/misc.rkt
+++ b/racket/collects/racket/contract/private/misc.rkt
@@ -50,6 +50,7 @@
          if/c
 
          pairwise-stronger-contracts?
+         pairwise-equivalent-contracts?
          check-two-args
 
          suggest/c
@@ -119,6 +120,15 @@
              (< that-x this-low))])]
     [else #f]))
 
+(define (between/c-equivalent this that)
+  (define this-low (between/c-s-low this))
+  (define this-high (between/c-s-high this))
+  (cond
+    [(between/c-s? that)
+     (and (= (between/c-s-low that) this-low)
+          (= this-high (between/c-s-high that)))]
+    [else #f]))
+
 (define (between/c-first-order ctc)
   (define n (between/c-s-low ctc))
   (define m (between/c-s-high ctc))
@@ -193,6 +203,7 @@
           [(= n m) `(=/c ,n)]
           [else ])]))
    #:stronger between/c-stronger
+   #:equivalent between/c-equivalent
    #:first-order between/c-first-order
    #:generate between/c-generate))
 (define-struct (renamed-between/c between/c-s) (name))
@@ -253,7 +264,8 @@
           [1/10 (-/+ x 0.01)]
           [4/10 (-/+ x (random))]
           [else (-/+ x (random 4294967087))]))))
-   #:stronger </>-ctc-stronger))
+   #:stronger </>-ctc-stronger
+   #:equivalent </>-ctc-equivalent))
 
 (define (</>-ctc-stronger this that)
   (define this-x (</>-ctc-x this))
@@ -274,6 +286,17 @@
         (and (= (between/c-s-high that) +inf.0)
              (<= (between/c-s-low that) this-x))])]))
 
+(define (</>-ctc-equivalent this that)
+  (define this-x (</>-ctc-x this))
+  (cond
+    [(</>-ctc? that)
+     (cond
+       [(and (<-ctc? this) (<-ctc? that))
+        (= this-x (</>-ctc-x that))]
+       [(and (>-ctc? this) (>-ctc? that))
+        (= this-x (</>-ctc-x that))]
+       [else #f])]
+    [else #f]))
 
 (struct </>-ctc (x))
 (struct <-ctc </>-ctc ()
@@ -331,6 +354,10 @@
                 (and (syntax-ctc? that)
                      (contract-struct-stronger? (syntax-ctc-ctc this)
                                                 (syntax-ctc-ctc that))))
+   #:equivalent (λ (this that)
+                  (and (syntax-ctc? that)
+                       (contract-struct-equivalent? (syntax-ctc-ctc this)
+                                                    (syntax-ctc-ctc that))))
    #:first-order (λ (ctc) 
                    (define ? (flat-contract-predicate (syntax-ctc-ctc ctc)))
                    (λ (v)
@@ -406,6 +433,11 @@
        (contract-struct-stronger? (promise-base-ctc-ctc this)
                                   (promise-base-ctc-ctc that))))
 
+(define (promise-ctc-equivalent? this that)
+  (and (promise-base-ctc? that)
+       (contract-struct-equivalent? (promise-base-ctc-ctc this)
+                                    (promise-base-ctc-ctc that))))
+
 (struct promise-base-ctc (ctc))
 (struct chaperone-promise-ctc promise-base-ctc ()
   #:property prop:custom-write custom-write-property-proc
@@ -414,6 +446,7 @@
    #:name promise-contract-name
    #:late-neg-projection promise-contract-late-neg-proj
    #:stronger promise-ctc-stronger?
+   #:equivalent promise-ctc-equivalent?
    #:first-order (λ (ctc) promise?)))
 (struct promise-ctc promise-base-ctc ()
   #:property prop:custom-write custom-write-property-proc
@@ -422,6 +455,7 @@
    #:name promise-contract-name
    #:late-neg-projection promise-contract-late-neg-proj
    #:stronger promise-ctc-stronger?
+   #:equivalent promise-ctc-equivalent?
    #:first-order (λ (ctc) promise?)))
 
 ;; (parameter/c in/out-ctc)
@@ -488,16 +522,26 @@
            (and (contract-struct-stronger? (parameter/c-out this)
                                            (parameter/c-out that))
                 (contract-struct-stronger? (parameter/c-in that)
-                                           (parameter/c-in this)))))))
+                                           (parameter/c-in this)))))
+   #:equivalent
+   (λ (this that)
+      (and (parameter/c? that)
+           (and (contract-struct-equivalent? (parameter/c-out this)
+                                             (parameter/c-out that))
+                (contract-struct-equivalent? (parameter/c-in that)
+                                             (parameter/c-in this)))))))
 
+(define (procedure-arity-includes-equivalent? this that)
+  (and (procedure-arity-includes/c? that)
+       (= (procedure-arity-includes/c-n this)
+          (procedure-arity-includes/c-n that))))
 (define-struct procedure-arity-includes/c (n)
   #:property prop:custom-write custom-write-property-proc
   #:omit-define-syntaxes
   #:property prop:flat-contract
   (build-flat-contract-property
-   #:stronger (λ (this that) (and (procedure-arity-includes/c? that)
-                                  (= (procedure-arity-includes/c-n this)
-                                     (procedure-arity-includes/c-n that))))
+   #:stronger procedure-arity-includes-equivalent?
+   #:equivalent procedure-arity-includes-equivalent?
    #:name (λ (ctc) `(procedure-arity-includes/c ,(procedure-arity-includes/c-n ctc)))
    #:first-order (λ (ctc)
                    (define n (procedure-arity-includes/c-n ctc))
@@ -557,6 +601,7 @@
   (build-flat-contract-property
    #:late-neg-projection (λ (ctc) any/c-blame->neg-party-fn)
    #:stronger (λ (this that) (any/c? that))
+   #:equivalent (λ (this that) (any/c? that))
    #:name (λ (ctc) 'any/c)
    #:generate (λ (ctc) 
                 (λ (fuel) 
@@ -584,6 +629,7 @@
   (build-flat-contract-property
    #:late-neg-projection none-curried-late-neg-proj
    #:stronger (λ (this that) #t)
+   #:equivalent (λ (this that) (none/c? that))
    #:name (λ (ctc) (none/c-name ctc))
    #:first-order (λ (ctc) (λ (val) #f))))
 
@@ -666,12 +712,21 @@
 
 (define (prompt-tag/c-stronger? this that)
   (and (base-prompt-tag/c? that)
-       (andmap (λ (this that) (contract-struct-stronger? this that))
-               (base-prompt-tag/c-ctcs this)
-               (base-prompt-tag/c-ctcs that))
-       (andmap (λ (this that) (contract-struct-stronger? this that))
-               (base-prompt-tag/c-call/ccs this)
-               (base-prompt-tag/c-call/ccs that))))
+       (pairwise-stronger-contracts?
+        (base-prompt-tag/c-ctcs this)
+        (base-prompt-tag/c-ctcs that))
+       (pairwise-stronger-contracts?
+        (base-prompt-tag/c-call/ccs this)
+        (base-prompt-tag/c-call/ccs that))))
+
+(define (prompt-tag/c-equivalent? this that)
+  (and (base-prompt-tag/c? that)
+       (pairwise-equivalent-contracts?
+        (base-prompt-tag/c-ctcs this)
+        (base-prompt-tag/c-ctcs that))
+       (pairwise-equivalent-contracts?
+        (base-prompt-tag/c-call/ccs this)
+        (base-prompt-tag/c-call/ccs that))))
 
 ;; (listof contract) (listof contract)
 (define-struct base-prompt-tag/c (ctcs call/ccs))
@@ -683,6 +738,7 @@
    #:late-neg-projection (prompt-tag/c-late-neg-proj #t)
    #:first-order (λ (ctc) continuation-prompt-tag?)
    #:stronger prompt-tag/c-stronger?
+   #:equivalent prompt-tag/c-equivalent?
    #:name prompt-tag/c-name))
 
 (define-struct (impersonator-prompt-tag/c base-prompt-tag/c) ()
@@ -692,6 +748,7 @@
    #:late-neg-projection (prompt-tag/c-late-neg-proj #f)
    #:first-order (λ (ctc) continuation-prompt-tag?)
    #:stronger prompt-tag/c-stronger?
+   #:equivalent prompt-tag/c-equivalent?
    #:name prompt-tag/c-name))
 
 
@@ -743,6 +800,12 @@
         (base-continuation-mark-key/c-ctc this)
         (base-continuation-mark-key/c-ctc that))))
 
+(define (continuation-mark-key/c-equivalent? this that)
+  (and (base-continuation-mark-key/c? that)
+       (contract-struct-equivalent?
+        (base-continuation-mark-key/c-ctc this)
+        (base-continuation-mark-key/c-ctc that))))
+
 (define-struct base-continuation-mark-key/c (ctc))
 
 (define-struct (chaperone-continuation-mark-key/c
@@ -754,6 +817,7 @@
    #:late-neg-projection (continuation-mark-key/c-late-neg-proj chaperone-continuation-mark-key)
    #:first-order (λ (ctc) continuation-mark-key?)
    #:stronger continuation-mark-key/c-stronger?
+   #:equivalent continuation-mark-key/c-equivalent?
    #:name continuation-mark-key/c-name))
 
 (define-struct (impersonator-continuation-mark-key/c
@@ -765,6 +829,7 @@
    #:late-neg-projection (continuation-mark-key/c-late-neg-proj impersonate-continuation-mark-key)
    #:first-order (λ (ctc) continuation-mark-key?)
    #:stronger continuation-mark-key/c-stronger?
+   #:equivalent continuation-mark-key/c-equivalent?
    #:name continuation-mark-key/c-name))
 
 ;; evt/c : Contract * -> Contract
@@ -823,9 +888,20 @@
 
 ;; evt/c-stronger? : Contract Contract -> Boolean
 (define (evt/c-stronger? this that)
-  (define this-ctcs (chaperone-evt/c-ctcs this))
-  (define that-ctcs (chaperone-evt/c-ctcs that))
-  (pairwise-stronger-contracts? this-ctcs that-ctcs))
+  (cond
+    [(chaperone-evt/c? that)
+     (define this-ctcs (chaperone-evt/c-ctcs this))
+     (define that-ctcs (chaperone-evt/c-ctcs that))
+     (pairwise-stronger-contracts? this-ctcs that-ctcs)]
+    [else #f]))
+
+(define (evt/c-equivalent? this that)
+  (cond
+    [(chaperone-evt/c? that)
+     (define this-ctcs (chaperone-evt/c-ctcs this))
+     (define that-ctcs (chaperone-evt/c-ctcs that))
+     (pairwise-equivalent-contracts? this-ctcs that-ctcs)]
+    [else #f]))
 
 ;; ctcs - Listof<Contract>
 (define-struct chaperone-evt/c (ctcs)
@@ -834,6 +910,7 @@
    #:late-neg-projection evt/c-proj
    #:first-order evt/c-first-order
    #:stronger evt/c-stronger?
+   #:equivalent evt/c-equivalent?
    #:name evt/c-name))
 
 ;; channel/c
@@ -891,6 +968,12 @@
         (base-channel/c-ctc this)
         (base-channel/c-ctc that))))
 
+(define (channel/c-equivalent? this that)
+  (and (base-channel/c? that)
+       (contract-struct-equivalent?
+        (base-channel/c-ctc this)
+        (base-channel/c-ctc that))))
+
 (define-struct base-channel/c (ctc))
 
 (define-struct (chaperone-channel/c base-channel/c)
@@ -901,6 +984,7 @@
    #:late-neg-projection (channel/c-late-neg-proj chaperone-channel)
    #:first-order channel/c-first-order
    #:stronger channel/c-stronger?
+   #:equivalent channel/c-equivalent?
    #:name channel/c-name))
 
 (define-struct (impersonator-channel/c base-channel/c)
@@ -911,6 +995,7 @@
    #:late-neg-projection (channel/c-late-neg-proj impersonate-channel)
    #:first-order channel/c-first-order
    #:stronger channel/c-stronger?
+   #:equivalent channel/c-equivalent?
    #:name channel/c-name))
 
 
@@ -980,12 +1065,15 @@
     (if (flat-contract? ctc)
         (flat-named-contract name (flat-contract-predicate ctc))
         (let* ([make-contract (if (chaperone-contract? ctc) make-chaperone-contract make-contract)])
-          (define (stronger? this other)
+          (define (rename-contract-stronger? this other)
             (contract-struct-stronger? ctc other))
+          (define (rename-contract-equivalent? this other)
+            (contract-struct-equivalent? ctc other))
           (make-contract #:name name
                          #:late-neg-projection (get/build-late-neg-projection ctc)
                          #:first-order (contract-first-order ctc)
-                         #:stronger stronger?
+                         #:stronger rename-contract-stronger?
+                         #:equivalent rename-contract-equivalent?
                          #:list-contract? (list-contract? ctc))))))
 
 (define (if/c predicate then/c else/c)
@@ -1063,6 +1151,16 @@
             (loop (cdr c1s) (cdr c2s)))]
       [else #f])))
 
+(define (pairwise-equivalent-contracts? c1s c2s)
+  (let loop ([c1s c1s]
+             [c2s c2s])
+    (cond
+      [(and (null? c1s) (null? c2s)) #t]
+      [(and (pair? c1s) (pair? c2s))
+       (and (contract-struct-equivalent? (car c1s) (car c2s))
+            (loop (cdr c1s) (cdr c2s)))]
+      [else #f])))
+
 (define (suggest/c _ctc field message)
   (define ctc (coerce-contract 'suggest/c _ctc))
   (unless (string? field)
@@ -1083,7 +1181,8 @@
    #:name (contract-name ctc)
    #:first-order (contract-first-order ctc)
    #:late-neg-projection (λ (b) (ctc-lnp (blame-add-extra-field b field message)))
-   #:stronger (λ (this that) (contract-stronger? ctc that))
+   #:stronger (λ (this that) (contract-struct-stronger? ctc that))
+   #:equivalent (λ (this that) (contract-struct-equivalent? ctc that))
    #:list-contract? (list-contract? ctc)))
 
 (define (flat-contract-with-explanation ? #:name [name (object-name ?)])
diff --git a/racket/collects/racket/contract/private/object.rkt b/racket/collects/racket/contract/private/object.rkt
index 0f19692ff5..b67efaa2f9 100644
--- a/racket/collects/racket/contract/private/object.rkt
+++ b/racket/collects/racket/contract/private/object.rkt
@@ -128,6 +128,9 @@
                   [(subclass/c? that)
                    (subclass? (subclass/c-% this) (subclass/c-% that))]
                   [else #f]))
+   #:equivalent (λ (this that)
+                  (and (subclass/c? that)
+                       (equal? (subclass/c-% this) (subclass/c-% that))))
    #:name (λ (ctc) `(subclass?/c ,(or (object-name (subclass/c-% ctc)) 'unknown%)))))
 (define (subclass?/c %)
   (unless (class? %)
@@ -145,6 +148,10 @@
                    (interface-extension? (implementation/c-<%> this)
                                          (implementation/c-<%> that))]
                   [else #f]))
+   #:equivalent (λ (this that)
+                  (and (implementation/c? that)
+                       (equal? (implementation/c-<%> this)
+                               (implementation/c-<%> that))))
    #:name (λ (ctc) `(implementation?/c ,(or (object-name (implementation/c-<%> ctc)) 'unknown<%>)))))
             
 (define (implementation?/c <%>)
@@ -185,6 +192,10 @@
            (interface-extension? this-<%> that-<%>)]
           [else #f])]
        [else #f]))
+   #:equivalent
+   (λ (this that)
+     (and (is-a?-ctc? that)
+          (equal? (is-a?-ctc-<%> this) (is-a?-ctc-<%> that))))
    #:name
    (λ (ctc)
      (define <%> (is-a?-ctc-<%> ctc))
diff --git a/racket/collects/racket/contract/private/orc.rkt b/racket/collects/racket/contract/private/orc.rkt
index d54f7d8807..6c09a9a46a 100644
--- a/racket/collects/racket/contract/private/orc.rkt
+++ b/racket/collects/racket/contract/private/orc.rkt
@@ -110,6 +110,14 @@
                                          (single-or/c-flat-ctcs that)))
       (generic-or/c-stronger? this that)))
 
+(define (single-or/c-equivalent? this that)
+  (or (and (single-or/c? that)
+           (contract-struct-equivalent? (single-or/c-ho-ctc this)
+                                        (single-or/c-ho-ctc that))
+           (pairwise-equivalent-contracts? (single-or/c-flat-ctcs this)
+                                           (single-or/c-flat-ctcs that)))
+      (generic-or/c-equivalent? this that)))
+
 (define (generic-or/c-stronger? this that)
   (define this-sub-ctcs (or/c-sub-contracts this))
   (define that-sub-ctcs (or/c-sub-contracts that))
@@ -119,6 +127,15 @@
          (for/or ([that-sub-ctc (in-list that-sub-ctcs)])
            (contract-struct-stronger? this-sub-ctc that-sub-ctc)))))
 
+(define (generic-or/c-equivalent? this that)
+  (define this-sub-ctcs (or/c-sub-contracts this))
+  (define that-sub-ctcs (or/c-sub-contracts that))
+  (and this-sub-ctcs
+       that-sub-ctcs
+       (pairwise-equivalent-contracts?
+        (sort this-sub-ctcs < #:key (λ (x) (equal-hash-code (contract-name x))))
+        (sort that-sub-ctcs < #:key (λ (x) (equal-hash-code (contract-name x)))))))
+
 (define (or/c-sub-contracts ctc)
   (cond
     [(single-or/c? ctc)
@@ -215,6 +232,7 @@
    #:name single-or/c-name
    #:first-order single-or/c-first-order
    #:stronger single-or/c-stronger?
+   #:equivalent single-or/c-equivalent?
    #:generate (λ (ctc) (or/c-generate ctc
                                       (cons (single-or/c-ho-ctc ctc)
                                             (single-or/c-flat-ctcs ctc))))
@@ -229,6 +247,7 @@
    #:name single-or/c-name
    #:first-order single-or/c-first-order
    #:stronger single-or/c-stronger?
+   #:equivalent single-or/c-equivalent?
    #:generate (λ (ctc) (or/c-generate ctc
                                       (cons (single-or/c-ho-ctc ctc)
                                             (single-or/c-flat-ctcs ctc))))
@@ -316,6 +335,14 @@
                                          (multi-or/c-flat-ctcs that)))
       (generic-or/c-stronger? this that)))
 
+(define (multi-or/c-equivalent? this that)
+  (or (and (multi-or/c? that)
+           (pairwise-equivalent-contracts? (multi-or/c-ho-ctcs this)
+                                           (multi-or/c-ho-ctcs that))
+           (pairwise-equivalent-contracts? (multi-or/c-flat-ctcs this)
+                                           (multi-or/c-flat-ctcs that)))
+      (generic-or/c-equivalent? this that)))
+
 (define (mult-or/c-list-contract? c)
   (and (for/and ([c (in-list (multi-or/c-flat-ctcs c))])
          (list-contract? c))
@@ -335,6 +362,7 @@
    #:name multi-or/c-name
    #:first-order multi-or/c-first-order
    #:stronger multi-or/c-stronger?
+   #:equivalent multi-or/c-equivalent?
    #:generate (λ (ctc) (or/c-generate ctc
                                       (append (multi-or/c-ho-ctcs ctc)
                                               (multi-or/c-flat-ctcs ctc))))
@@ -349,6 +377,7 @@
    #:name multi-or/c-name
    #:first-order multi-or/c-first-order
    #:stronger multi-or/c-stronger?
+   #:equivalent multi-or/c-equivalent?
    #:generate (λ (ctc) (or/c-generate ctc
                                       (append (multi-or/c-ho-ctcs ctc)
                                               (multi-or/c-flat-ctcs ctc))))
@@ -394,7 +423,7 @@
                                #f))]
                   [else #f])))
          (generic-or/c-stronger? this that)))
-                    
+   #:equivalent generic-or/c-equivalent?
 
    #:first-order
    (λ (ctc) (flat-or/c-pred ctc))
@@ -470,6 +499,7 @@
    #:name first-or/c-name
    #:first-order first-or/c-first-order
    #:stronger multi-or/c-stronger?
+   #:equivalent multi-or/c-equivalent?
    #:generate (λ (ctc) (or/c-generate ctc (base-first-or/c-ctcs ctc)))
    #:exercise (λ (ctc) (or/c-exercise (base-first-or/c-ctcs ctc)))
    #:list-contract? first-or/c-list-contract?))
@@ -480,6 +510,7 @@
    #:name first-or/c-name
    #:first-order first-or/c-first-order
    #:stronger generic-or/c-stronger?
+   #:equivalent generic-or/c-equivalent?
    #:generate (λ (ctc) (or/c-generate ctc (base-first-or/c-ctcs ctc)))
    #:exercise (λ (ctc) (or/c-exercise (base-first-or/c-ctcs ctc)))
    #:list-contract? first-or/c-list-contract?))
@@ -526,6 +557,15 @@
           (parameterize ([recur? #f])
             (contract-struct-stronger? (get-flat-rec-me this) that))]
          [else #f])))
+   #:equivalent
+   (let ([recur? (make-parameter #t)])
+     (λ (this that)
+       (cond
+         [(equal? this that) #t]
+         [(recur?)
+          (parameterize ([recur? #f])
+            (contract-struct-equivalent? (get-flat-rec-me this) that))]
+         [else #f])))
    #:first-order
    (λ (ctc) 
      (λ (v)
diff --git a/racket/collects/racket/contract/private/parametric.rkt b/racket/collects/racket/contract/private/parametric.rkt
index 211c397253..3f291de611 100644
--- a/racket/collects/racket/contract/private/parametric.rkt
+++ b/racket/collects/racket/contract/private/parametric.rkt
@@ -53,6 +53,24 @@
                                       (apply (polymorphic-contract-body that) instances))]
           [else #f])]
        [else #f]))
+   #:equivalent
+   (λ (this that)
+     (cond
+       [(polymorphic-contract? that)
+        (define this-vars (polymorphic-contract-vars this))
+        (define that-vars (polymorphic-contract-vars that))
+        (define this-barrier/c (polymorphic-contract-barrier this))
+        (define that-barrier/c (polymorphic-contract-barrier that))
+        (cond
+          [(and (eq? this-barrier/c that-barrier/c)
+                (= (length this-vars) (length that-vars)))
+           (define instances
+             (for/list ([var (in-list this-vars)])
+               (this-barrier/c #t var)))
+           (contract-struct-equivalent? (apply (polymorphic-contract-body this) instances)
+                                        (apply (polymorphic-contract-body that) instances))]
+          [else #f])]
+       [else #f]))
    #:late-neg-projection
    (lambda (c)
      (lambda (orig-blame)
@@ -104,6 +122,7 @@
    #:name (lambda (c) (barrier-contract-name c))
    #:first-order (λ (c) (barrier-contract-pred c))
    #:stronger (λ (this that) (eq? this that))
+   #:equivalent (λ (this that) (eq? this that))
    #:late-neg-projection
    (lambda (c)
      (define mk (barrier-contract-make c))
diff --git a/racket/collects/racket/contract/private/prop.rkt b/racket/collects/racket/contract/private/prop.rkt
index 39c72716e6..7bed4f33ec 100644
--- a/racket/collects/racket/contract/private/prop.rkt
+++ b/racket/collects/racket/contract/private/prop.rkt
@@ -12,6 +12,7 @@
          contract-struct-val-first-projection
          contract-struct-late-neg-projection
          contract-struct-stronger?
+         contract-struct-equivalent?
          contract-struct-generate
          contract-struct-exercise
          contract-struct-list-contract?
@@ -62,6 +63,7 @@
                                    first-order
                                    projection
                                    stronger
+                                   equivalent
                                    generate
                                    exercise
                                    val-first-projection
@@ -111,60 +113,86 @@
   (and get-projection
        (get-projection c)))
 
-(define trail (make-parameter #f))
-(define (contract-struct-stronger? a b)
-  (cond
-    [(and (or (flat-contract-struct? a)
-              (chaperone-contract-struct? a))
-          (equal? a b))
-     #t]
-    [else
-     (define prop (contract-struct-property a))
-     (define stronger? (contract-property-stronger prop))
-     (cond
-       [(stronger? a b)
-        ;; optimistically try skip some of the more complex work below
-        #t]
-       [(and (flat-contract-struct? a) (prop:any/c? b)) #t] ;; is the flat-check needed here?
-       [(let ([th (trail)])
-          (and th
-               (for/or ([(a2 bs-h) (in-hash th)])
-                 (and (eq? a a2)
-                      (for/or ([(b2 _) (in-hash bs-h)])
-                        (eq? b b2))))))
-        #t]
-       [(or (prop:recursive-contract? a) (prop:recursive-contract? b))
-        (parameterize ([trail (or (trail) (make-hasheq))])
-          (define trail-h (trail))
-          (let ([a-h (hash-ref trail-h a #f)])
+(define (contract-struct-stronger/equivalent?
+         a b
+         trail
+         contract-property-stronger/equivalent
+         special-or/c-any/c-handling?)
+  (let loop ([a a][b b])
+    (cond
+      [(and (or (flat-contract-struct? a)
+                (chaperone-contract-struct? a))
+            (equal? a b))
+       #t]
+      [else
+       (define prop (contract-struct-property a))
+       (define stronger/equivalent? (contract-property-stronger/equivalent prop))
+       (cond
+         [(stronger/equivalent? a b)
+          ;; optimistically try skip some of the more complex work below
+          #t]
+         [(and special-or/c-any/c-handling?
+               (flat-contract-struct? a)
+               (prop:any/c? b))
+          ;; is the flat-check needed here?
+          #t]
+         [(let ([th (trail)])
+            (and th
+                 (for/or ([(a2 bs-h) (in-hash th)])
+                   (and (eq? a a2)
+                        (for/or ([(b2 _) (in-hash bs-h)])
+                          (eq? b b2))))))
+          #t]
+         [(or (prop:recursive-contract? a) (prop:recursive-contract? b))
+          (parameterize ([trail (or (trail) (make-hasheq))])
+            (define trail-h (trail))
+            (let ([a-h (hash-ref trail-h a #f)])
+              (cond
+                [a-h
+                 (hash-set! a-h b #t)]
+                [else
+                 (define a-h (make-hasheq))
+                 (hash-set! trail-h a a-h)
+                 (hash-set! a-h b #t)]))
+            (loop (if (prop:recursive-contract? a)
+                      ((prop:recursive-contract-unroll a) a)
+                      a)
+                  (if (prop:recursive-contract? b)
+                      ((prop:recursive-contract-unroll b) b)
+                      b)))]
+         [special-or/c-any/c-handling?
+          ;; the 'later?' flag avoids checking
+          ;; (stronger? a b) in the first iteration,
+          ;; since it was checked in the "optimistically"
+          ;; branch above
+          (let loop ([b b] [later? #f])
             (cond
-              [a-h
-               (hash-set! a-h b #t)]
+              [(and later? (stronger/equivalent? a b))
+               #t]
+              [(prop:orc-contract? b)
+               (define sub-contracts ((prop:orc-contract-get-subcontracts b) b))
+               (for/or ([sub-contract (in-list sub-contracts)])
+                 (loop sub-contract #t))]
               [else
-               (define a-h (make-hasheq))
-               (hash-set! trail-h a a-h)
-               (hash-set! a-h b #t)]))
-          (contract-struct-stronger? (if (prop:recursive-contract? a)
-                                         ((prop:recursive-contract-unroll a) a)
-                                         a)
-                                     (if (prop:recursive-contract? b)
-                                         ((prop:recursive-contract-unroll b) b)
-                                         b)))]
-       [else
-        ;; the 'later?' flag avoids checking
-        ;; (stronger? a b) in the first iteration,
-        ;; since it was checked in the "optimistically"
-        ;; branch above
-        (let loop ([b b] [later? #f])
-          (cond
-            [(and later? (stronger? a b))
-             #t]
-            [(prop:orc-contract? b)
-             (define sub-contracts ((prop:orc-contract-get-subcontracts b) b))
-             (for/or ([sub-contract (in-list sub-contracts)])
-               (loop sub-contract #t))]
-            [else
-             #f]))])]))
+               #f]))]
+         [else #f])])))
+
+(define stronger-trail (make-parameter #f))
+(define (contract-struct-stronger? a b)
+  (contract-struct-stronger/equivalent?
+   a b
+   stronger-trail
+   contract-property-stronger
+   #t))
+
+(define equivalent-trail (make-parameter #f))
+(define (contract-struct-equivalent? a b)
+  (contract-struct-stronger/equivalent?
+   a b
+   equivalent-trail
+   contract-property-equivalent
+   #f))
+
 
 (define (contract-struct-generate c)
   (define prop (contract-struct-property c))
@@ -262,13 +290,14 @@
 
 (define-logger racket/contract)
 
-(define ((build-property mk default-name proc-name first-order?)
+(define ((build-property mk default-name proc-name first-order? equivalent-equal?)
          #:name [get-name #f]
          #:first-order [get-first-order #f]
          #:projection [get-projection #f]
          #:val-first-projection [get-val-first-projection #f]
          #:late-neg-projection [get-late-neg-projection #f]
          #:stronger [stronger #f]
+         #:equivalent [equivalent #f]
          #:generate [generate (λ (ctc) (λ (fuel) #f))]
          #:exercise [exercise (λ (ctc) (λ (fuel) (values void '())))]
          #:list-contract? [list-contract? (λ (c) #f)])
@@ -304,6 +333,7 @@
       (or get-first-order get-any?)
       get-projection
       (or stronger weakest)
+      (or equivalent (if equivalent-equal? equal? weakest))
       generate exercise 
       get-val-first-projection
       (cond
@@ -325,13 +355,13 @@
     
 (define build-contract-property
   (procedure-rename
-   (build-property make-contract-property 'anonymous-contract 'build-contract-property #f)
+   (build-property make-contract-property 'anonymous-contract 'build-contract-property #f #f)
    'build-contract-property))
 
 (define build-flat-contract-property
   (procedure-rename
    (build-property (compose make-flat-contract-property make-contract-property)
-                   'anonymous-flat-contract 'build-flat-contract-property #t)
+                   'anonymous-flat-contract 'build-flat-contract-property #t #t)
    'build-flat-contract-property))
 
 (define (blame-context-projection-wrapper proj)
@@ -343,7 +373,7 @@
 (define build-chaperone-contract-property
   (procedure-rename
    (build-property (compose make-chaperone-contract-property make-contract-property)
-                   'anonymous-chaperone-contract 'build-chaperone-contract-property #f)
+                   'anonymous-chaperone-contract 'build-chaperone-contract-property #f #t)
    'build-chaperone-contract-property))
 
 (define (get-any? c) any?)
@@ -383,7 +413,7 @@
 
 (define-struct make-contract [ name first-order projection
                                     val-first-projection late-neg-projection 
-                                    stronger generate exercise list-contract? ]
+                                    stronger equivalent generate exercise list-contract? ]
   #:omit-define-syntaxes
   #:property prop:custom-write
   (λ (stct port display?)
@@ -404,7 +434,7 @@
 
 (define-struct make-chaperone-contract [ name first-order projection
                                               val-first-projection late-neg-projection
-                                              stronger generate exercise list-contract? ]
+                                              stronger equivalent generate exercise list-contract? ]
   #:omit-define-syntaxes
   #:property prop:custom-write
   (λ (stct port display?)
@@ -425,7 +455,7 @@
 
 (define-struct make-flat-contract [ name first-order projection
                                          val-first-projection late-neg-projection
-                                         stronger generate exercise list-contract? ]
+                                         stronger equivalent generate exercise list-contract? ]
   #:omit-define-syntaxes
   #:property prop:custom-write
   (λ (stct port display?)
@@ -444,13 +474,14 @@
    #:exercise (lambda (c) (make-flat-contract-exercise c))
    #:list-contract? (λ (c) (make-flat-contract-list-contract? c))))
 
-(define ((build-contract mk default-name proc-name first-order?)
+(define ((build-contract mk default-name proc-name first-order? equivalent-equal?)
          #:name [name #f]
          #:first-order [first-order #f]
          #:projection [projection #f]
          #:val-first-projection [val-first-projection #f]
          #:late-neg-projection [late-neg-projection #f]
          #:stronger [stronger #f]
+         #:equivalent [equivalent #f]
          #:generate [generate (λ (ctc) (λ (fuel) #f))]
          #:exercise [exercise (λ (ctc) (λ (fuel) (values void '())))]
          #:list-contract? [list-contract? #f])
@@ -485,6 +516,7 @@
            [else #f])]
         [else late-neg-projection])
       (or stronger weakest)
+      (or equivalent (if equivalent-equal? equal? weakest))
       generate exercise
       (and list-contract? #t)))
 
@@ -502,7 +534,7 @@
 
 (define make-contract
   (procedure-rename 
-   (build-contract make-make-contract 'anonymous-contract 'make-contract #f)
+   (build-contract make-make-contract 'anonymous-contract 'make-contract #f #f)
    'make-contract))
 
 (define make-chaperone-contract
@@ -510,7 +542,7 @@
    (build-contract make-make-chaperone-contract
                    'anonymous-chaperone-contract
                    'make-chaperone-contract
-                   #f)
+                   #f #t)
    'make-chaperone-contract))
 
 (define make-flat-contract
@@ -518,7 +550,7 @@
    (build-contract make-make-flat-contract
                    'anonymous-flat-contract
                    'make-flat-contract
-                   #t)
+                   #t #t)
    'make-flat-contract))
 
 ;; property should be bound to a function that accepts the contract and
diff --git a/racket/collects/racket/contract/private/struct-dc.rkt b/racket/collects/racket/contract/private/struct-dc.rkt
index 29a414c602..da8ae6b82f 100644
--- a/racket/collects/racket/contract/private/struct-dc.rkt
+++ b/racket/collects/racket/contract/private/struct-dc.rkt
@@ -673,7 +673,44 @@
                  (procedure-closure-contents-eq?
                   (dep-dep-proc this-subcontract)
                   (dep-dep-proc that-subcontract)))]
-           [else #t]))))
+           [else #f]))))
+
+(define (struct/dc-equivalent? this that)
+  (and (base-struct/dc? that)
+       (eq? (base-struct/dc-pred this) (base-struct/dc-pred that))
+       (let ([this-inv (get-invariant this)]
+             [that-inv (get-invariant that)])
+         (cond
+           [(and (not this-inv) (not that-inv)) #t]
+           [(and this-inv that-inv)
+            (procedure-closure-contents-eq? (invariant-dep-proc this-inv)
+                                            (invariant-dep-proc that-inv))]
+           [else #f]))
+       (for/and ([this-subcontract (in-list (base-struct/dc-subcontracts this))]
+                 [that-subcontract (in-list (base-struct/dc-subcontracts that))])
+         (cond
+           [(and (indep? this-subcontract)
+                 (indep? that-subcontract))
+            (and (or (and (mutable? this-subcontract)
+                          (mutable? that-subcontract))
+                     (and (immutable? this-subcontract)
+                          (immutable? that-subcontract))
+                     (and (lazy-immutable? this-subcontract)
+                          (lazy-immutable? that-subcontract)))
+                 (contract-struct-equivalent? (indep-ctc this-subcontract)
+                                              (indep-ctc that-subcontract)))]
+           [(and (dep? this-subcontract)
+                 (dep? that-subcontract))
+            (and (or (and (dep-mutable? this-subcontract)
+                          (dep-mutable? that-subcontract))
+                     (and (dep-immutable? this-subcontract)
+                          (dep-immutable? that-subcontract))
+                     (and (dep-lazy-immutable? this-subcontract)
+                          (dep-lazy-immutable? that-subcontract)))
+                 (procedure-closure-contents-eq?
+                  (dep-dep-proc this-subcontract)
+                  (dep-dep-proc that-subcontract)))]
+           [else #f]))))
 
 (define (get-invariant sc)
   (for/or ([sub (base-struct/dc-subcontracts sc)]
@@ -700,6 +737,7 @@
    #:first-order struct/dc-first-order
    #:late-neg-projection struct/dc-late-neg-proj
    #:stronger struct/dc-stronger?
+   #:equivalent struct/dc-equivalent?
    #:generate struct/dc-generate
    #:exercise struct/dc-exercise))
 
@@ -710,6 +748,7 @@
    #:first-order struct/dc-flat-first-order
    #:late-neg-projection struct/dc-late-neg-proj
    #:stronger struct/dc-stronger?
+   #:equivalent struct/dc-equivalent?
    #:generate struct/dc-generate
    #:exercise struct/dc-exercise))
 
@@ -720,6 +759,7 @@
    #:first-order struct/dc-first-order
    #:late-neg-projection struct/dc-late-neg-proj
    #:stronger struct/dc-stronger?
+   #:equivalent struct/dc-equivalent?
    #:generate struct/dc-generate
    #:exercise struct/dc-exercise))
 
diff --git a/racket/collects/racket/contract/private/vector.rkt b/racket/collects/racket/contract/private/vector.rkt
index 9eac01a48f..94d4ecf8c4 100644
--- a/racket/collects/racket/contract/private/vector.rkt
+++ b/racket/collects/racket/contract/private/vector.rkt
@@ -126,6 +126,15 @@
              (contract-struct-stronger? that-elem this-elem))])]
     [else #f]))
 
+(define (vectorof-equivalent this that)
+  (cond
+    [(base-vectorof? that)
+     (and (equal? (base-vectorof-immutable this)
+                  (base-vectorof-immutable that))
+          (contract-struct-equivalent? (base-vectorof-elem this)
+                                       (base-vectorof-elem that)))]
+    [else #f]))
+
 (define-struct (flat-vectorof base-vectorof) ()
   #:property prop:custom-write custom-write-property-proc
   #:property prop:flat-contract
@@ -143,6 +152,7 @@
                                (for ([x (in-vector val)])
                                  (vfp+blame x neg-party))
                                val)))
+   #:equivalent vectorof-equivalent
    #:stronger vectorof-stronger))
 
 (define (blame-add-element-of-context blame #:swap? [swap? #f])
@@ -258,6 +268,7 @@
   (build-chaperone-contract-property
    #:name vectorof-name
    #:first-order vectorof-first-order
+   #:equivalent vectorof-equivalent
    #:stronger vectorof-stronger
    #:late-neg-projection (vectorof-late-neg-ho-projection chaperone-vector)))
 
@@ -267,6 +278,7 @@
   (build-contract-property
    #:name vectorof-name
    #:first-order vectorof-first-order
+   #:equivalent vectorof-equivalent
    #:stronger vectorof-stronger
    #:late-neg-projection (vectorof-late-neg-ho-projection impersonate-vector)))
 
@@ -375,7 +387,6 @@
            (contract-first-order-passes? c e)))))
 
 (define (vector/c-stronger this that)
-  ;(define-struct base-vector/c (elems immutable))
   (define this-elems (base-vector/c-elems this))
   (define this-immutable (base-vector/c-immutable this))
   (cond
@@ -413,6 +424,15 @@
        [else #f])]
     [else #f]))
 
+(define (vector/c-equivalent this that)
+  (cond
+    [(base-vector/c? that)
+     (and (equal? (base-vector/c-immutable this)
+                  (base-vector/c-immutable that))
+          (pairwise-equivalent-contracts? (base-vector/c-elems this)
+                                          (base-vector/c-elems that)))]
+    [else #f]))
+
 (define-struct (flat-vector/c base-vector/c) ()
   #:property prop:custom-write custom-write-property-proc
   #:property prop:flat-contract
@@ -420,6 +440,7 @@
    #:name vector/c-name
    #:first-order vector/c-first-order
    #:stronger vector/c-stronger
+   #:equivalent vector/c-equivalent
    #:late-neg-projection
    (λ (ctc) 
      (λ (blame) 
@@ -512,6 +533,7 @@
    #:name vector/c-name
    #:first-order vector/c-first-order
    #:stronger vector/c-stronger
+   #:equivalent vector/c-equivalent
    #:late-neg-projection (vector/c-ho-late-neg-projection chaperone-vector)))
 
 (define-struct (impersonator-vector/c base-vector/c) ()
@@ -521,6 +543,7 @@
    #:name vector/c-name
    #:first-order vector/c-first-order
    #:stronger vector/c-stronger
+   #:equivalent vector/c-equivalent
    #:late-neg-projection (vector/c-ho-late-neg-projection impersonate-vector)))
 
 (define-syntax (wrap-vector/c stx)
diff --git a/racket/collects/racket/private/class-c-old.rkt b/racket/collects/racket/private/class-c-old.rkt
index 218a1d017f..7bc0932f18 100644
--- a/racket/collects/racket/private/class-c-old.rkt
+++ b/racket/collects/racket/private/class-c-old.rkt
@@ -940,10 +940,7 @@
       (check-one-stronger class/c-inits class/c-init-contracts this that)
       
       ;; check both ways for fields (since mutable)
-      (limit-depth
-       (and (check-one-stronger class/c-fields class/c-field-contracts this that) 
-            (check-one-stronger class/c-fields class/c-field-contracts that this)))
-      
+      (check-one-equivalent class/c-fields class/c-field-contracts this that)
 
       ;; inherits
       (check-one-stronger internal-class/c-inherits internal-class/c-inherit-contracts
@@ -974,6 +971,36 @@
       (all-included? (class/c-absents that) (class/c-absents this)))]
     [else #f]))
 
+(define (class/c-equivalent this that)
+  (define this-internal (class/c-internal this))
+  (cond
+    [(class/c? that)
+     (define that-internal (class/c-internal that))
+     (and
+      (check-one-equivalent class/c-methods class/c-method-contracts this that)
+      (check-one-equivalent class/c-inits class/c-init-contracts this that)
+      (check-one-equivalent class/c-fields class/c-field-contracts this that)
+      (check-one-equivalent internal-class/c-inherits internal-class/c-inherit-contracts
+                            this-internal that-internal)
+      (check-one-equivalent internal-class/c-inherit-fields internal-class/c-inherit-field-contracts
+                            this-internal that-internal)
+      (check-one-equivalent internal-class/c-inherit-fields internal-class/c-inherit-field-contracts
+                            that-internal this-internal)
+      (check-one-equivalent internal-class/c-supers internal-class/c-super-contracts
+                            this-internal that-internal)
+      (check-one-equivalent internal-class/c-inners internal-class/c-inner-contracts
+                            this-internal that-internal)
+      (check-one-equivalent internal-class/c-overrides internal-class/c-override-contracts
+                            this-internal that-internal)
+      (check-one-equivalent internal-class/c-augments internal-class/c-augment-contracts
+                            this-internal that-internal)
+      (check-one-equivalent internal-class/c-augrides internal-class/c-augride-contracts
+                            this-internal that-internal)
+      (equal? (class/c-opaque? this) (class/c-opaque? that))
+      (equal? (class/c-absent-fields that) (class/c-absent-fields this))
+      (equal? (class/c-absents that) (class/c-absents this)))]
+    [else #f]))
+
 (define (all-included? this-items that-items)
   (for/and ([this-item (in-list this-items)])
     (for/or ([that-item (in-list that-items)])
@@ -1039,6 +1066,14 @@
       (and (equal? this-name that-name)
            (contract-stronger? this-ctc that-ctc)))))
 
+(define (check-one-equivalent names-sel ctcs-sel this that)
+  (for/and ([this-name (in-list (names-sel this))]
+            [this-ctc (in-list (ctcs-sel this))])
+    (for/or ([that-name (in-list (names-sel that))]
+             [that-ctc (in-list (ctcs-sel that))])
+      (and (equal? this-name that-name)
+           (contract-equivalent? this-ctc that-ctc)))))
+
 (define-struct class/c 
   (methods method-contracts fields field-contracts inits init-contracts
    absents absent-fields 
@@ -1050,6 +1085,7 @@
    #:late-neg-projection class/c-late-neg-proj
    #:name build-class/c-name
    #:stronger class/c-stronger
+   #:equivalent class/c-equivalent
    #:first-order
    (λ (ctc)
      (λ (cls)
@@ -1468,6 +1504,11 @@
        (contract-stronger? (base-instanceof/c-class-ctc this)
                            (base-instanceof/c-class-ctc that))))
 
+(define (instanceof/c-equivalent this that)
+  (and (base-instanceof/c? that)
+       (contract-equivalent? (base-instanceof/c-class-ctc this)
+                             (base-instanceof/c-class-ctc that))))
+
 (define-struct base-instanceof/c (class-ctc)
   #:property prop:custom-write custom-write-property-proc
   #:property prop:contract
@@ -1477,6 +1518,7 @@
    (λ (ctc)
      (build-compound-type-name 'instanceof/c (base-instanceof/c-class-ctc ctc)))
    #:first-order instanceof/c-first-order
+   #:equivalent instanceof/c-equivalent
    #:stronger instanceof/c-stronger))
 
 (define/subexpression-pos-prop (instanceof/c cctc)
@@ -1550,15 +1592,24 @@
       (object/c-width-subtype? this that))]
     [else #f]))
 
+(define (object/c-equivalent this that)
+  (cond
+    [(base-object/c? that)
+     (and
+      (check-one-object/equivalent base-object/c-methods base-object/c-method-contracts this that)
+      (check-one-object/equivalent base-object/c-fields base-object/c-field-contracts this that)
+      (equal? (base-object/c-methods that)
+              (base-object/c-methods this))
+      (equal? (base-object/c-fields that)
+              (base-object/c-fields this)))]
+    [else #f]))
+
 (define (object/c-common-methods-stronger? this that)
   (check-one-object base-object/c-methods base-object/c-method-contracts this that))
 
 (define (object/c-common-fields-stronger? this that)
   ;; check both ways for fields (since mutable)
-  (limit-depth
-   (and
-    (check-one-object base-object/c-fields base-object/c-field-contracts this that)
-    (check-one-object base-object/c-fields base-object/c-field-contracts that this))))
+  (check-one-object/equivalent base-object/c-fields base-object/c-field-contracts this that))
 
 ;; True if `this` has at least as many field / method names as `that`
 (define (object/c-width-subtype? this that)
@@ -1585,6 +1636,22 @@
                     any/c
                     that-ctc)))))))
 
+(define (check-one-object/equivalent names-sel ctcs-sel this that)
+  (and (equal? (names-sel this)
+               (names-sel this))
+       (for/and ([this-name (in-list (names-sel this))]
+                 [this-ctc (in-list (ctcs-sel this))])
+         (for/or ([that-name (in-list (names-sel that))]
+                  [that-ctc (in-list (ctcs-sel that))])
+           (and (equal? this-name that-name)
+                (contract-equivalent?
+                 (if (just-check-existence? this-ctc)
+                     any/c
+                     this-ctc)
+                 (if (just-check-existence? that-ctc)
+                     any/c
+                     that-ctc)))))))
+
 (define-struct base-object/c (methods method-contracts fields field-contracts)
   #:property prop:custom-write custom-write-property-proc
   #:property prop:contract
@@ -1598,6 +1665,7 @@
                                (base-object/c-fields ctc)
                                (base-object/c-field-contracts ctc)))
    #:first-order object/c-first-order
+   #:equivalent object/c-equivalent
    #:stronger object/c-stronger))
 
 (define (build-object/c-type-name name method-names method-ctcs field-names field-ctcs)