ITree.Simple
Require Export ITree.Core.ITreeDefinition.
Export ITreeNotations.
#[global] Open Scope itree_scope.
(* This scope is open by default to make this "tutorial module" as
straightforward as possible. *)
- itree : (Type → Type) → Type → Type type
- Ret, Tau, Vis notations
- ITree.bind : itree E R → (R → itree E S) → itree E S
- ITree.map : (R → S) → itree E R → itree E S
- ITree.trigger : E R → itree E R
- Notations for bind t k: "t >>= k", "x <- t ;; k x"
Combinators for event handlers:
- case_ : (E ~> itree G) → (F ~> itree G) → (E +' F ~> itree G)
- bimap : (E ~> itree G) → (F ~> itree H) → (E +' F ~> itree (G +' H))
- inl1_ : E ~> itree (E +' F)
- inr1_ : F ~> itree (E +' F)
- cat : (E ~> itree F) → (F ~> itree G) → (E ~> itree G)
Equational theory
This interface is implemented by the module
ITree.Simple.Simple below (exported by default).
eutt is an equivalence relation.
We can erase taus unter eutt.
Parameter tau_eutt : ∀ (t : itree E R),
Tau t ≈ t.
Parameter itree_eta : ∀ (t : itree E R),
t ≈ go (observe t).
Parameter eutt_ret : ∀ (r1 r2 : R),
r1 = r2 → Ret r1 ≈ Ret r2.
Parameter eutt_vis : ∀ {U : Type} (e : E U) (k1 k2 : U → itree E R),
(∀ u, k1 u ≈ k2 u) → Vis e k1 ≈ Vis e k2.
Parameter eutt_inv_ret : ∀ (r1 r2 : R),
Ret r1 ≈ Ret r2 → r1 = r2.
Parameter eutt_inv_vis : ∀ {U : Type} (e : E U) (k1 k2 : U → itree E R),
Vis e k1 ≈ Vis e k2 → (∀ u, k1 u ≈ k2 u).
End EquivalenceUpToTaus.
Infix "≈" := eutt (at level 70).
Tau t ≈ t.
Parameter itree_eta : ∀ (t : itree E R),
t ≈ go (observe t).
Parameter eutt_ret : ∀ (r1 r2 : R),
r1 = r2 → Ret r1 ≈ Ret r2.
Parameter eutt_vis : ∀ {U : Type} (e : E U) (k1 k2 : U → itree E R),
(∀ u, k1 u ≈ k2 u) → Vis e k1 ≈ Vis e k2.
Parameter eutt_inv_ret : ∀ (r1 r2 : R),
Ret r1 ≈ Ret r2 → r1 = r2.
Parameter eutt_inv_vis : ∀ {U : Type} (e : E U) (k1 k2 : U → itree E R),
Vis e k1 ≈ Vis e k2 → (∀ u, k1 u ≈ k2 u).
End EquivalenceUpToTaus.
Infix "≈" := eutt (at level 70).
Parameter bind_ret : ∀ {E R S} (r : R) (k : R → itree E S),
ITree.bind (Ret r) k ≈ k r.
Parameter bind_vis
: ∀ {E R} U V (e: E V) (ek: V → itree E U) (k: U → itree E R),
ITree.bind (Vis e ek) k
≈ Vis e (fun x ⇒ ITree.bind (ek x) k).
Parameter bind_ret_r : ∀ {E R} (s : itree E R),
ITree.bind s (fun x ⇒ Ret x) ≈ s.
Parameter bind_bind
: ∀ {E R S T}
(s : itree E R) (k : R → itree E S) (h : S → itree E T),
ITree.bind (ITree.bind s k) h
≈ ITree.bind s (fun r ⇒ ITree.bind (k r) h).
Hint Rewrite @tau_eutt : itree.
Hint Rewrite @bind_ret : itree.
Hint Rewrite @bind_vis : itree.
Hint Rewrite @bind_ret_r : itree.
Hint Rewrite @bind_bind : itree.
Monadic interpretation: interp
Definition _interp {E F R} (f : E ~> itree F) (ot : itreeF E R _)
: itree F R
:= match ot with
| RetF r ⇒ Ret r
| TauF t ⇒ Tau (interp f t)
| VisF e k ⇒ f _ e >>= (fun x ⇒ Tau (interp f (k x)))
end.
Parameter unfold_interp
: ∀ {E F R} {f : E ~> itree F} (t : itree E R),
interp f t ≈ (_interp f (observe t)).
The next three are immediate corollaries of unfold_interp.
Parameter interp_ret
: ∀ {E F R} {f : E ~> itree F} (x: R),
interp f (Ret x) ≈ Ret x.
Parameter interp_vis
: ∀ {E F R} {f : E ~> itree F} U (e: E U) (k: U → itree E R),
interp f (Vis e k)
≈ ITree.bind (f _ e) (fun x ⇒ interp f (k x)).
Parameter interp_trigger : ∀ {E F : Type → Type} {R : Type}
(f : E ~> (itree F)) (e : E R),
interp f (ITree.trigger e) ≈ f _ e.
Parameter interp_bind : ∀ {E F R S}
(f : E ~> itree F) (t : itree E R) (k : R → itree E S),
interp f (ITree.bind t k)
≈ ITree.bind (interp f t) (fun r ⇒ interp f (k r)).
Hint Rewrite @interp_ret : itree.
Hint Rewrite @interp_vis : itree.
Hint Rewrite @interp_trigger : itree.
Hint Rewrite @interp_bind : itree.
: ∀ {E F R} {f : E ~> itree F} (x: R),
interp f (Ret x) ≈ Ret x.
Parameter interp_vis
: ∀ {E F R} {f : E ~> itree F} U (e: E U) (k: U → itree E R),
interp f (Vis e k)
≈ ITree.bind (f _ e) (fun x ⇒ interp f (k x)).
Parameter interp_trigger : ∀ {E F : Type → Type} {R : Type}
(f : E ~> (itree F)) (e : E R),
interp f (ITree.trigger e) ≈ f _ e.
Parameter interp_bind : ∀ {E F R S}
(f : E ~> itree F) (t : itree E R) (k : R → itree E S),
interp f (ITree.bind t k)
≈ ITree.bind (interp f t) (fun r ⇒ interp f (k r)).
Hint Rewrite @interp_ret : itree.
Hint Rewrite @interp_vis : itree.
Hint Rewrite @interp_trigger : itree.
Hint Rewrite @interp_bind : itree.
Simple recursion: rec
Definition recursive {E A B} (f : A → itree (callE A B +' E) B)
: (callE A B +' E) ~> itree E
:= case_ (calling' (rec f)) ITree.trigger.
Parameter rec_as_interp
: ∀ {E A B} (f : A → itree (callE A B +' E) B) (a : A),
rec f a
≈ interp (recursive f) (f a).
Parameter interp_recursive_call
: ∀ {E A B} (f : A → itree (callE A B +' E) B) (x : A),
interp (recursive f) (call x)
≈ rec f x.
: (callE A B +' E) ~> itree E
:= case_ (calling' (rec f)) ITree.trigger.
Parameter rec_as_interp
: ∀ {E A B} (f : A → itree (callE A B +' E) B) (a : A),
rec f a
≈ interp (recursive f) (f a).
Parameter interp_recursive_call
: ∀ {E A B} (f : A → itree (callE A B +' E) B) (x : A),
interp (recursive f) (call x)
≈ rec f x.
Definition mrecursive {D E} (f : D ~> itree (D +' E))
: (D +' E) ~> itree E :=
case_ (mrec f) ITree.trigger.
Parameter mrec_as_interp
: ∀ {D E T} (ctx : D ~> itree (D +' E)) (d : D T),
mrec ctx d
≈ interp (mrecursive ctx) (ctx _ d).
Parameter interp_mrecursive
: ∀ {D E T} (ctx : D ~> itree (D +' E)) (d : D T),
interp (mrecursive ctx) (trigger_inl1 d)
≈ mrec ctx d.
Hint Rewrite @interp_recursive_call : itree.
Hint Rewrite @interp_mrecursive : itree.
: (D +' E) ~> itree E :=
case_ (mrec f) ITree.trigger.
Parameter mrec_as_interp
: ∀ {D E T} (ctx : D ~> itree (D +' E)) (d : D T),
mrec ctx d
≈ interp (mrecursive ctx) (ctx _ d).
Parameter interp_mrecursive
: ∀ {D E T} (ctx : D ~> itree (D +' E)) (d : D T),
interp (mrecursive ctx) (trigger_inl1 d)
≈ mrec ctx d.
Hint Rewrite @interp_recursive_call : itree.
Hint Rewrite @interp_mrecursive : itree.
Proper lemmas
#[global]
Declare Instance eutt_go {E R} :
Proper (going eutt ==> eutt) (@go E R).
#[global]
Declare Instance eutt_observe {E R} :
Proper (eutt ==> going eutt) (@observe E R).
#[global]
Declare Instance eutt_TauF {E R} :
Proper (eutt ==> going eutt) (@TauF E R _).
#[global]
Declare Instance eutt_VisF {E R X} (e: E X) :
Proper (pointwise_relation _ (@eutt E R) ==> going eutt) (VisF e).
#[global]
Declare Instance eutt_bind {E R S} :
Proper (eutt ==> pointwise_relation _ eutt ==> eutt)
(@ITree.bind E R S).
#[global]
Declare Instance eutt_map {E R S} :
Proper (pointwise_relation _ eq ==> eutt ==> eutt)
(@ITree.map E R S).
#[global]
Declare Instance eutt_interp (E F : Type → Type) f (R : Type) :
Proper (eutt ==> eutt) (@interp E (itree F) _ _ _ f R).