Section sec_map_modalop.
Variable A B: Type.
Proof using.
unfold and_tl; intuition.
Qed.
Proof using.
unfold and_tl; intuition.
Qed.
Proof using.
unfold or_tl; intuition.
Qed.
Proof using.
unfold or_tl; intuition.
Qed.
Proof using.
unfold impl_tl; intuition.
Qed.
Proof using.
unfold impl_tl; intuition.
Qed.
Proof using.
unfold not_tl; intuition.
Qed.
Proof using.
unfold not_tl; intuition.
Qed.
Proof using.
intros f P (x, s) nP; assumption.
Qed.
Proof using.
intros f P (x, s) nP; assumption.
Qed.
Proof using.
intros f P Q PQ [x s]; apply PQ.
Qed.
Proof using.
intros f P Q QP [x s]; apply QP.
Qed.
Proof using.
intros f P (x, (y, s)) nP; assumption.
Qed.
Proof using.
intros f P (x, (y, s)) nP; assumption.
Qed.
Proof using.
intros f P Q PQ. cofix cf.
intros (x, s) a. case (always_Cons a); intros a1 a2. constructor.
- apply PQ. assumption.
- rewrite map_Cons; simpl. apply cf; assumption.
Qed.
Proof using.
intros f J P Q inv JQP. cofix c.
intros [x s] Js a.
rewrite map_Cons in a. case (always_Cons a); intros a1 a2. constructor.
- apply JQP. assumption.
rewrite map_Cons; assumption.
- simpl. apply c.
* apply (inv x). assumption.
* assumption.
Qed.
Proof using.
intros f P Q QP s.
apply (always_map_conv_ext f P Q True_tl); auto.
Qed.
Proof using.
intros f J P K Q JK PQ. cofix cf.
intros (x, s) un. case (weak_until_Cons un); clear un.
- intro Pxs; constructor 1. apply PQ. assumption.
- intros (Jxs, un). rewrite map_Cons. constructor 2.
* rewrite <- map_Cons. auto.
* simpl. auto.
Qed.
Proof using.
intros f J P K Q KJ QP. cofix cf.
intros (x, s) un.
rewrite map_Cons in un; case (weak_until_Cons un); clear un; rewrite <- map_Cons.
- intro Qxs; constructor 1. apply QP. assumption.
- intros (Kxs, un). constructor 2; simpl; auto.
Qed.
Proof using.
intros f J P K Q JK PQ s un.
induction un.
- apply U0, PQ. assumption.
- rewrite map_Cons.
apply U_next.
* rewrite <- map_Cons.
apply JK.
assumption.
* assumption.
Qed.
Proof using.
intros f J P K Q JK PQ. cofix cf.
intros (x, s) rl. case (release_Cons rl); clear rl.
intros Pxs orR.
case orR; intro cR.
- apply R0.
* apply PQ. assumption.
* apply JK. assumption.
- apply R_tl.
* apply PQ. assumption.
* apply cf. assumption.
Qed.
Proof using.
intros f J P K Q KJ QP. cofix cf.
intros (x, s) rl.
rewrite map_Cons in rl; case (release_Cons rl); clear rl; rewrite <- map_Cons; intros QC orR; case orR; intro cR.
- apply R0.
* apply QP. assumption.
* apply KJ. assumption.
- apply R_tl.
* apply QP. assumption.
* apply cf. assumption.
Qed.
Proof using.
intros f P Q PQ s e. induction e as [s ok | x s e induc_hyp].
- destruct s as (x, s); simpl in *. rewrite map_Cons. constructor 1.
rewrite <- map_Cons. apply PQ. exact ok.
- rewrite map_Cons. constructor 2. exact induc_hyp.
Qed.
(* The converse seems to require much more work *)
Definition fstAB := fst (A:=A) (B:=B).
Proof using.
cofix cf. intros (a, sA) (b, sB).
rewrite zip_Cons. rewrite map_Cons. constructor. apply cf.
Qed.
Proof using.
intros f. cofix cf.
intros (a, sA) (b, sB).
repeat rewrite map_Cons; repeat rewrite zip_Cons; repeat rewrite map_Cons; simpl.
intro al; case (always_Cons al); clear al; simpl. intros e al. case e. constructor.
apply cf. exact al.
Qed.
Proof using.
intros f Q extQ s sB al ev. genclear al; genclear s.
induction ev as [(b, sB) QbsB | b sB ev induc_hyp].
- intros (a, sA) al.
constructor 1. apply extQ with (Cons b sB); try assumption.
apply exteq_zip_map. apply al.
- intros (a, sA). repeat rewrite map_Cons. repeat rewrite zip_Cons.
intro al. case (always_Cons al); simpl. clear al; intros e al.
constructor 2. apply induc_hyp. exact al.
Qed.
Proof using.
intros f P Q J extP extQ extJ inv QP s Js ev.
revert Js.
assert (efst: J (map fstAB (zip s (map f s))) -> eventually P (map fstAB (zip s (map f s)))).
- assert (evzip : eventually (fun sc => Q (map f (map fstAB sc))) (zip s (map f s))).
* clear extP QP P.
assert (alzip : (always (now (fun c : A * B => let (x, y) := c in y = f x)) (zip s (map f s)))).
+ clear ev extQ. generalize s. cofix cf. intros (x, s0). constructor.
-- simpl. reflexivity.
-- simpl. apply cf.
+ apply (eventually_map_conv_aux f Q extQ s (map f s) alzip ev).
* clear ev. induction evzip as [((a, b), sAB) QabsAB | c sAB _ induc_hyp].
+ intros Js.
apply QP; assumption.
+ intros Js.
rewrite map_Cons.
apply E_next.
apply induc_hyp.
rewrite map_Cons in Js.
apply (inv (fstAB c)).
assumption.
- intros Js.
assert (emJ: J (map fstAB (zip s (map f s)))).
* unfold extensional in extJ.
apply (extJ s).
+ apply exteq_sym. apply exteq_fst_zip.
+ assumption.
* apply efst in emJ.
genclear emJ.
apply extensional_eventually.
+ exact extP.
+ apply exteq_fst_zip.
Qed.
Proof using.
intros f P Q extP extQ QP s.
apply eventually_map_conv_ext with (J := True_tl); auto.
- apply extensional_True_tl.
- intros. apply E0. apply QP. assumption.
Qed.

Lemma eventually_map_monotonic :
forall (f: A->B) (P Q J: infseq A->Prop) (K : infseq B -> Prop),
(forall x s, J (Cons x s) -> J s) ->
(forall x s, K (map f (Cons x s)) -> K (map f s)) ->
(forall s, J s -> K (map f s) -> Q s -> P s) ->
forall s, J s -> K (map f s) -> eventually Q s -> eventually P s.