Section eqit_eq.
(** *** Properties of relation transformers. *)
Context {E : Type -> Type} {R : Type}.
Local Notation eqit := (@eqit E R R eq).
Global Instance Reflexive_eqitF_eq b1 b2 (sim : itree E R -> itree E R -> Prop)
: Reflexive sim -> Reflexive (eqitF eq b1 b2 id sim).
Global Instance Symmetric_eqitF_eq b (sim : itree E R -> itree E R -> Prop)
: Symmetric sim -> Symmetric (eqitF eq b b id sim).
Global Instance Reflexive_eqit__eq b1 b2 (sim : itree E R -> itree E R -> Prop)
: Reflexive sim -> Reflexive (eqit_ eq b1 b2 id sim).
Global Instance Reflexive_eqit_eq b1 b2 : Reflexive (eqit b1 b2).
Global Instance Symmetric_eqit_eq b : Symmetric (eqit b b).
(** *** Congruence properties *)
Global Instance eqit_observe b1 b2:
Proper (eqit b1 b2 ==> going (eqit b1 b2)) (@observe E R).
Global Instance eqit_tauF b1 b2:
Proper (eqit b1 b2 ==> going (eqit b1 b2)) (@TauF E R _).
Global Instance eqit_VisF b1 b2 {u} (e: E u) :
Proper (pointwise_relation _ (eqit b1 b2) ==> going (eqit b1 b2)) (VisF e).
Global Instance observing_sub_eqit l r :
subrelation (observing eq) (eqit l r).
(** ** Eta-expansion *)
(** *** Transitivity properties *)
Inductive rcompose {R1 R2 R3} (RR1: R1->R2->Prop) (RR2: R2->R3->Prop) (r1: R1) (r3: R3) : Prop :=
| rcompose_intro r2 (REL1: RR1 r1 r2) (REL2: RR2 r2 r3)
.
Hint Constructors rcompose.
Global Instance Transitive_eqit {E : Type -> Type} {R: Type} (RR : R -> R -> Prop) (b1 b2: bool):
Transitive RR -> Transitive (@eqit E _ _ RR b1 b2).
Global Instance Transitive_eqit_eq {E : Type -> Type} {R: Type} (b1 b2: bool):
Transitive (@eqit E R R eq b1 b2).
Global Instance Equivalence_eqit {E : Type -> Type} {R: Type} (RR : R -> R -> Prop) (b: bool):
Equivalence RR -> Equivalence (@eqit E R R RR b b).
Global Instance Equivalence_eqit_eq {E : Type -> Type} {R: Type} (b: bool):
Equivalence (@eqit E R R eq false false).
Global Instance Transitive_eutt {E R RR} : Transitive RR -> Transitive (@eutt E R R RR).
Global Instance Equivalence_eutt {E R RR} : Equivalence RR -> Equivalence (@eutt E R R RR).
Global Instance geuttgen_cong_eqit {E R1 R2 RR1 RR2 RS} b1 b2 r rg
(LERR1: forall x x' y, (RR1 x x': Prop) -> (RS x' y: Prop) -> RS x y)
(LERR2: forall x y y', (RR2 y y': Prop) -> RS x y' -> RS x y):
Proper (eq_itree RR1 ==> eq_itree RR2 ==> flip impl)
(gpaco2 (@eqit_ E R1 R2 RS b1 b2 id) (eqitC RS b1 b2) r rg).
Global Instance geuttgen_cong_eqit_eq {E R1 R2 RS} b1 b2 r rg:
Proper (eq_itree eq ==> eq_itree eq ==> flip impl)
(gpaco2 (@eqit_ E R1 R2 RS b1 b2 id) (eqitC RS b1 b2) r rg).
Global Instance geuttge_cong_euttge {E R1 R2 RR1 RR2 RS} r rg
(LERR1: forall x x' y, (RR1 x x': Prop) -> (RS x' y: Prop) -> RS x y)
(LERR2: forall x y y', (RR2 y y': Prop) -> RS x y' -> RS x y):
Proper (euttge RR1 ==> eq_itree RR2 ==> flip impl)
(gpaco2 (@eqit_ E R1 R2 RS true false id) (eqitC RS true false) r rg).
Global Instance geuttge_cong_euttge_eq {E R1 R2 RS} r rg:
Proper (euttge eq ==> eq_itree eq ==> flip impl)
(gpaco2 (@eqit_ E R1 R2 RS true false id) (eqitC RS true false) r rg).
Global Instance geutt_cong_euttge {E R1 R2 RR1 RR2 RS} r rg
(LERR1: forall x x' y, (RR1 x x': Prop) -> (RS x' y: Prop) -> RS x y)
(LERR2: forall x y y', (RR2 y y': Prop) -> RS x y' -> RS x y):
Proper (euttge RR1 ==> euttge RR2 ==> flip impl)
(gpaco2 (@eqit_ E R1 R2 RS true true id) (eqitC RS true true) r rg).
Global Instance geutt_cong_euttge_eq {E R1 R2 RS} r rg:
Proper (euttge eq ==> euttge eq ==> flip impl)
(gpaco2 (@eqit_ E R1 R2 RS true true id) (eqitC RS true true) r rg).
Global Instance eqitgen_cong_eqit {E R1 R2 RR1 RR2 RS} b1 b2
(LERR1: forall x x' y, (RR1 x x': Prop) -> (RS x' y: Prop) -> RS x y)
(LERR2: forall x y y', (RR2 y y': Prop) -> RS x y' -> RS x y):
Proper (eq_itree RR1 ==> eq_itree RR2 ==> flip impl)
(@eqit E R1 R2 RS b1 b2).
Global Instance eqitgen_cong_eqit_eq {E R1 R2 RS} b1 b2:
Proper (eq_itree eq ==> eq_itree eq ==> flip impl)
(@eqit E R1 R2 RS b1 b2).
Global Instance euttge_cong_euttge {E R RS}
(TRANS: Transitive RS):
Proper (euttge RS ==> flip (euttge RS) ==> flip impl)
(@eqit E R R RS true false).
Global Instance euttge_cong_euttge_eq {E R}:
Proper (euttge eq ==> flip (euttge eq) ==> flip impl)
(@eqit E R R eq true false).
(** ** Equations for core combinators *)
(* TODO (LATER): I keep these [...bind_] lemmas around temporarily in case I run some issues with slow typeclass resolution. *)

Lemma unfold_forever {E R S} (t : itree E R)
: @ITree.forever E R S t ≅ (t >>= fun _ => Tau (ITree.forever t)).