Local Open Scope rel_scope.
(** * Tests *)
(** ** Reflexivity *)
Goal
forall A (a: A), a = a.
Goal
forall A (a: A), exists b, b = a.
(** ** Setoid rewriting *)
Goal
forall A (a b: A) `(HR: Equivalence A) (H: R a b),
sum_rel R R (inl a) (inl b).
(** There is an issue with the following. *)
Goal
forall A (a b: A) (R: rel A A) (f: A -> A) (p: A -> Prop),
Monotonic f (R ++> R) ->
Monotonic p (R --> impl) ->
R a b ->
p (f b) ->
p (f a).
(** ** Monotonicity tactics *)
(** Basic sanity check. This has actually failed in the past due to [context_candidate] being too liberal and selecting the [RB] property instead of [RA], then going nowhere with that with no backtracking implemented yet. *)
Goal
forall A B (RA: rel A A) (x y: A) (RB: rel B B) (z t: B),
RA x y ->
RB z t ->
RA x y.
Goal
forall A (a b: A) (R: rel A A) (H: R a b),
let f (x y: A * A) := (@pair (A+A) (A+A) (inr (fst x)) (inl (snd y))) in
Monotonic f (R * ⊤ ++> ⊤ * R ++> (⊥ + R) * (R + ⊥))%rel.
Goal
forall {A1 A2 B1 B2} (R1 R1': rel A1 A2) (R2 R2': rel B1 B2),
subrel R1' R1 ->
subrel R2 R2' ->
subrel (R1 ++> R2) (R1' ++> R2').
(** Check that we can use relational hypotheses from the context as well as [Monotonic]/[Related] instances. *)
Goal
forall
{A B} (R: rel A A)
(op: A -> B) (Hop: (R ++> eq) op op)
(x y: A) (Hxy: R x y),
op x = op y.
(** Bug with relational parametricity: you can't [RElim] a relation you don't know yet. *)
Goal
forall {A B} (RA: rel A A) (RB: rel B B) (m n: (A -> B) * B) (x: A),
((- ==> RB) * RB)%rel m n ->
RB (fst m x) (fst n x).
Goal
forall {A} (R: rel A A),
Monotonic
(fun (b: bool) x y => if b then x else y)
(- ==> R ++> R ++> R).
(** *** Hypotheses from the context *)
(* This used to fail because [Hyy] would shadow [Hxy] (the hypothesis we want). *)
Goal
forall {A} (R: rel A A) (x y: A),
R x y -> eq y y -> R x y.
(* This still fail with Coq 8.5, but Coq 8.6 is able to backtrack and try hypothesis from the context beyond the first one it finds. *)
Goal
forall {A} (R: rel A A) (x y: A),
R x y -> eq x y -> R x y.
(** Then *this* used to fail because the [flip] was hidden until after we exploit the [subrel] property. This is important in particular when using the equivalences for a given partial order, as in [eqrel] vs. [subrel], where we want to be able to use equivalences in both directions. *)
Goal
forall {A} (R R': rel A A) (f: A -> A),
Monotonic f (R ++> R) ->
Related R' (flip R) subrel ->
(R' ++> flip R) f f.
(** As an example where proper handling of [flip] is important, this is a goal generated by [setoid_rewrite] when we try to rewrite using [eqrel] under [option_le]. Here, both [R1] and [R2] have to be instantiated as [flip eq] (so that the associated hypotheses can be used to solve goals of the form [yi = xi]), and similarly we need to use the super-relation [flip subrel] of [eqrel]. *)
Goal
forall A, exists R1 R2: relation (option A),
(eqrel ==> R1 ==> R2 ==> flip impl)%signature option_le option_le.
(** *** [impl] vs. [subrel] *)
(** This checks that a relational property written in terms of [subrel] can be used to solve a goal stated in terms of [impl]. This is made possible by [subrel_impl_relim]. *)
Goal
forall A B C (R: rel A A) (f: A -> rel B C) a1 a2 b c,
Monotonic f (R ++> subrel) ->
R a1 a2 ->
impl (f a1 b c) (f a2 b c).
Goal
forall A1 A2 B1 B2 (R1 R2: rel A1 A2) (R: rel B1 B2),
subrel R1 R2 ->
forall x y,
(R2 ++> R) x y ->
(R1 ++> R) x y.
(** *** Generic rules *)
(** The [coreflexivity] of [rel_prod] and [eq] makes it possible for [pair_rel] to behave in the same way as [f_equal] below, since they allow us to deduce that [eq * eq] is a [subrel] of [eq]. *)
Goal
forall A B (x1 x2 : A) (y1 y2 : B),
x1 = x2 -> y1 = y2 -> (x1, y1) = (x2, y2).
(** ** Using [foo_subrel] instances *)
(** Still broken because of the interaction between [subrel] and [- ==> - ==> impl] (or lack thereof) *)
Goal
forall A1 A2 B1 B2 C1 C2 (R1 R2: rel A1 A2) (R1': rel B1 B2) (R: rel C1 C2),
subrel R1 R2 ->
forall x y,
(R2 ++> R) x y ->
(R1 ++> R) x y.
Goal
forall A B (xa1 xa2 ya1 ya2 : A) (xb1 xb2 yb1 yb2 : B)
(opA: A -> A -> A) (opB: B -> B -> B)
(RA: rel A A) (RB: rel B B)
(HopA: Monotonic opA (RA ++> RA ++> RA))
(HopB: Monotonic opB (RB ++> RB ++> RB))
(Hxa: RA xa1 xa2)
(Hxb: RB xb1 xb2)
(Hya: RA ya1 ya2)
(Hyb: RB yb1 yb2),
(RA * RB)%rel
(opA xa1 ya1, opB xb1 yb1)
(opA xa2 ya2, opB xb2 yb2).
Goal
forall A1 A2 B1 B2 C1 C2 (R1 R2: rel A1 A2) (R1': rel B1 B2) (R: rel C1 C2),
subrel R1 R2 ->
forall x y,
(R2 * R1' ++> R) x y ->
(R1 * R1' ++> R) x y.
(** ** The [rgraph] tactic *)
Goal
forall {A} (R S T: rel A A),
subrel R S ->
subrel S R ->
subrel S T ->
subrel R T.
Goal
forall `(PER) (x y z t : A),
R x y ->
R z y ->
R z t ->
R t x.
(** ** General issues *)
(** Assumptions can be used by [Monotonicity] to solve the goal. However, consider the goal [?R f g |- (- ==> S) f g]. [Monotonicity] can solve this by instantiating [R] and using the hypothesis, however [RIntro] will take precedence in this case. This means we will end up with a goal [?R f g, x |- S (f x) (g x)] that cannot be solved anymore.  When [?R] is already [- ==> S] or some equivalent relation, this is not a problem, because the work done by [RIntro] can essentially be undone later by [Monotonicity]. However when [?R] is an existential variable this is not true and we would prefer an earlier instantiation.  This is a possible workaround: <<< Lemma assumption_rstep {P : Prop} : P -> RStep True P.  Hint Extern 1 (RStep _ (_ ?x ?y)) => lazymatch goal with H : ?R x y |- _ => is_evar R; eexact (assumption_rstep H) end : typeclass_instances. >>> *)
Goal
forall A B (R : relation B) (f g : A -> B), exists X : relation (A -> B),
X f g ->
(- ==> R) f g.
(** ** Tests for specific relators *)
(** *** [list_rel] *)
(** [list_subrel] use to not work because of a missing [Params] declaration. *)
Goal
forall A B (R R': rel A B) l1 l2 x y,
subrel R R' ->
list_rel R l1 l2 ->
R' x y ->
list_rel R' (x :: l1) (y :: l2).
(** *** [rel_pull] *)
(** The [RIntro] instance for [rel_pull] used to be less general. *)
Goal
forall A B (f: A -> B) (R: rel B B) x y,
R (f x) (f y) ->
(R @@ f) x y.
(** We don't want the introduction rule for [rel_pull] to shadow relational properties. *)

Lemma rel_pull_2:
forall A B (f: A -> B) (R: rel B B) (g: A -> A) x y,
Monotonic g (⊤ ==> R @@ f) ->
(R @@ f) (g x) (g y).