(** * Theorems about State effects *)
(* begin hide *)
Program
Setoid
Morphisms
RelationClasses.
Basics.Basics
Basics.Category
Basics.CategoryKleisli
Basics.Monad
Core.ITreeDefinition
Core.KTree
Core.KTreeFacts
Eq.Eq
Eq.UpToTaus
Indexed.Sum
Interp.Interp
Interp.InterpFacts
Interp.RecursionFacts
Events.State.
Open Scope itree_scope.
(* end hide *)
Definition _interp_state {E F S R}
(f : E ~> stateT S (itree F)) (ot : itreeF E R _)
: stateT S (itree F) R := fun s =>
match ot with
| RetF r => Ret (s, r)
| TauF t => Tau (interp_state f t s)
| VisF e k => f _ e s >>= (fun sx => Tau (interp_state f (k (snd sx)) (fst sx)))
end.
Instance eq_itree_interp_state {E F S R} (h : E ~> Monads.stateT S (itree F)) :
Proper (eq_itree eq ==> eq ==> eq_itree eq)
(@interp_state _ _ _ _ _ _ h R).
Instance eutt_interp_state {E F: Type -> Type} {S : Type}
(h : E ~> Monads.stateT S (itree F)) R :
Proper (eutt eq ==> eq ==> eutt eq) (@interp_state E (itree F) S _ _ _ h R).

Lemma eutt_interp_state_loop {E F S A B C} (RS : S -> S -> Prop)
(h : E ~> Monads.stateT S (itree F))
(t1 t2 : C + A -> itree E (C + B)) :
(forall ca s1 s2, RS s1 s2 ->
eutt (fun a b => RS (fst a) (fst b) /\ snd a = snd b)
(interp_state h (t1 ca) s1)
(interp_state h (t2 ca) s2)) ->
(forall a s1 s2, RS s1 s2 ->
eutt (fun a b => RS (fst a) (fst b) /\ snd a = snd b)
(interp_state h (loop t1 a) s1)
(interp_state h (loop t2 a) s2)).