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