Section PACO_METATHEORY.
Context {D : Type} {PROSET : isProset D}.
#[local] Hint Resolve le_join_lattice_introl le_join_lattice_intror join_lattice_le_intro bot_lattice_le_intro : core.
Proof with eauto with *.
assert (claim1 : proj1_sig f (proj1_sig (nu f)) =< proj1_sig f (join_lattice x (proj1_sig (nu f)))).
{ eapply (proj2_sig f). eapply join_lattice_spec; done!. }
pose proof (proj2_sig (nu f)) as [claim2 claim3]. split.
- intros x_le. rewrite x_le at 1. transitivity (proj1_sig f (proj1_sig (nu f)))...
- intros x_le. unnw. exploit (join_lattice_le_intro x (proj1_sig (nu f)) _ x_le).
+ do 2 red in claim2. rewrite claim2 at 1. eapply (proj2_sig f). eapply le_join_lattice_intror...
+ intros H. rewrite x_le. eapply postfixedpoint_le_gfpOf. eapply (proj2_sig f)...
Qed.
Definition G_aux0 {UPPER_LATTICE : isUpperSemilattice D} (f : `[D -> D]) (x : D) : D -> D :=
fun y : D => proj1_sig f (join_lattice x y).
Definition G_aux {UPPER_LATTICE : isUpperSemilattice D} (f : `[D -> D]) (x : D) : `[D -> D] :=
@exist (D -> D) isMonotonic1 (G_aux0 f x) (G_aux0_isMonotionicMap f x).
Context {COLA : isCola D} {UPPER_LATTICE : isUpperSemilattice D}.
Definition G0 (f : `[D -> D]) (x : D) : D :=
proj1_sig (nu (G_aux f x)).
Proof with eauto with *.
intros x1 x2 x1_le_x2. eapply strong_coinduction. simpl in *.
assert (claim1 : G0 f x1 == proj1_sig f (join_lattice x1 (G0 f x1))) by eapply (proj2_sig (nu (G_aux f x1))).
rewrite claim1 at 1. eapply (proj2_sig f). transitivity (join_lattice x2 (G0 f x1)).
- eapply join_lattice_le_intro.
+ rewrite x1_le_x2 at 1. eapply le_join_lattice_introl...
+ eapply le_join_lattice_intror...
- eapply join_lattice_le_intro...
Qed.
Definition G1 (f : `[D -> D]) : `[D -> D] :=
@exist (D -> D) isMonotonic1 (G0 f) (G0_isMonotonic1 f).
Definition G : `[`[D -> D] -> `[D -> D]] :=
@exist (`[D -> D] -> `[D -> D]) isMonotonic1 G1 G1_isMonotonic1.
Variant paco_spec (f : `[D -> D]) (G_f : `[D -> D]) : Prop :=
| paco_spec_intro
(INIT_COFIXPOINT : proj1_sig (nu f) == proj1_sig G_f bot_lattice)
(UNFOLD_COFIXPOINT : forall x : D, proj1_sig G_f x == proj1_sig f (join_lattice x (proj1_sig G_f x)))
(ACCUM_COFIXPOINT : forall x : D, forall y : D, y =< proj1_sig G_f x <-> y =< proj1_sig G_f (join_lattice x y))
: paco_spec f G_f.
Proof with eauto with *.
pose proof (nu_is_supremum_of_postfixedpointsOf (G_aux f bot_lattice)) as claim1.
pose proof (nu_is_supremum_of_postfixedpointsOf f) as claim2.
pose proof (fun x : D => proj1 (nu_f_is_gfpOf_f (G_aux f x))) as claim3.
split.
- eapply leProp_antisymmetry.
+ eapply claim2. ii. eapply claim1... s!. rewrite IN at 1. eapply (proj2_sig f)...
+ eapply claim1. ii. eapply claim2... s!. rewrite IN at 1. eapply (proj2_sig f)...
- exact (claim3).
- ii; split; intros y_le.
+ rewrite y_le at 1. eapply G0_isMonotonic1...
+ rewrite y_le at 1. eapply postfixedpoint_le_gfpOf.
transitivity (proj1_sig f (join_lattice (join_lattice x y) (proj1_sig (proj1_sig G f) (join_lattice x y)))).
{ eapply eqProp_implies_leProp. exact (claim3 (join_lattice x y)). }
{ eapply (proj2_sig f). eapply join_lattice_le_intro... }
Qed.

Theorem G_compositionality (f : `[D -> D]) (r : D) (r1 : D) (r2 : D) (g1 : D) (g2 : D)
(g1_le_G_f_r1 : g1 =< proj1_sig (proj1_sig G f) r1)
(g2_le_G_f_r2 : g2 =< proj1_sig (proj1_sig G f) r2)
(r1_le : r1 =< join_lattice r g2)
(r2_le : r2 =< join_lattice r g1)
: join_lattice g1 g2 =< proj1_sig (proj1_sig G f) r.