(** * 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_aloop {E F S I I' A A'}
(RA : A -> A' -> Prop) (RI : I -> I' -> Prop)
(RS : S -> S -> Prop)
(h : E ~> Monads.stateT S (itree F))
(t1 : I -> itree E (I + A))
(t2 : I' -> itree E (I' + A')):
(forall i i' s1 s2, RS s1 s2 -> RI i i' ->
eutt (prod_rel RS (sum_rel RI RA))
(interp_state h (t1 i) s1)
(interp_state h (t2 i') s2)) ->
(forall i i' s1 s2, RS s1 s2 -> RI i i' ->
eutt (fun a b => RS (fst a) (fst b) /\ RA (snd a) (snd b))
(interp_state h (ITree.iter t1 i) s1)
(interp_state h (ITree.iter t2 i') s2)).