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.

(* Specifications: *)
Lemma eventually_map_conv :
forall (f: A->B) (P: infseq A->Prop) (Q: infseq B->Prop),
extensional P -> extensional Q ->
(forall s, Q (map f s) -> P s) ->
forall s, eventually Q (map f s) -> eventually P s.