Library Paco.paco0

Require Export paconotation pacotacuser.
Require Import paconotation_internal pacotac pacon.
Set Implicit Arguments.

Section PACO0.

Record sig0T :=
  exist0T {
    }.

Definition uncurry0 (R: rel0): rel1 sig0T := fun x => R.

Definition curry0 (R: rel1 sig0T): rel0 :=
  R (exist0T).

Lemma uncurry_map0 r0 r1 (LE : r0 <0== r1) : uncurry0 r0 <1== uncurry0 r1.
Proof. intros [] H. apply LE. apply H. Qed.

Lemma uncurry_map_rev0 r0 r1 (LE: uncurry0 r0 <1== uncurry0 r1) : r0 <0== r1.
Proof.
  repeat_intros 0. intros H. apply (LE (exist0T) H).
Qed.

Lemma curry_map0 r0 r1 (LE: r0 <1== r1) : curry0 r0 <0== curry0 r1.
Proof.
  repeat_intros 0. intros H. apply (LE (exist0T) H).
Qed.

Lemma curry_map_rev0 r0 r1 (LE: curry0 r0 <0== curry0 r1) : r0 <1== r1.
Proof.
  intros [] H. apply LE. apply H.
Qed.

Lemma uncurry_bij1_0 r : curry0 (uncurry0 r) <0== r.
Proof. unfold le0. repeat_intros 0. intros H. apply H. Qed.

Lemma uncurry_bij2_0 r : r <0== curry0 (uncurry0 r).
Proof. unfold le0. repeat_intros 0. intros H. apply H. Qed.

Lemma curry_bij1_0 r : uncurry0 (curry0 r) <1== r.
Proof. intros []. intro H. apply H. Qed.

Lemma curry_bij2_0 r : r <1== uncurry0 (curry0 r).
Proof. intros []. intro H. apply H. Qed.

Lemma uncurry_adjoint1_0 r0 r1 (LE: uncurry0 r0 <1== r1) : r0 <0== curry0 r1.
Proof.
  apply uncurry_map_rev0. eapply le1_trans; [apply LE|]. apply curry_bij2_0.
Qed.

Lemma uncurry_adjoint2_0 r0 r1 (LE: r0 <0== curry0 r1) : uncurry0 r0 <1== r1.
Proof.
  apply curry_map_rev0. eapply le0_trans; [|apply LE]. apply uncurry_bij2_0.
Qed.

Lemma curry_adjoint1_0 r0 r1 (LE: curry0 r0 <0== r1) : r0 <1== uncurry0 r1.
Proof.
  apply curry_map_rev0. eapply le0_trans; [apply LE|]. apply uncurry_bij2_0.
Qed.

Lemma curry_adjoint2_0 r0 r1 (LE: r0 <1== uncurry0 r1) : curry0 r0 <0== r1.
Proof.
  apply uncurry_map_rev0. eapply le1_trans; [|apply LE]. apply curry_bij1_0.
Qed.

Definition paco0(gf : rel0 -> rel0)(r: rel0) : rel0 :=
  curry0 (paco (fun R0 => uncurry0 (gf (curry0 R0))) (uncurry0 r)).

Definition upaco0(gf : rel0 -> rel0)(r: rel0) := paco0 gf r \0/ r.
Arguments paco0 : clear implicits.
Arguments upaco0 : clear implicits.
Hint Unfold upaco0.

Definition monotone0 (gf: rel0 -> rel0) :=
  forall r r' (IN: gf r) (LE: r <0= r'), gf r'.

Definition _monotone0 (gf: rel0 -> rel0) :=
  forall r r'(LE: r <0= r'), gf r <0== gf r'.

Lemma monotone0_eq (gf: rel0 -> rel0) :
  monotone0 gf <-> _monotone0 gf.
Proof. unfold monotone0, _monotone0, le0. split; intros; eapply H; eassumption. Qed.

Lemma monotone0_map (gf: rel0 -> rel0)
      (MON: _monotone0 gf) :
  _monotone (fun R0 => uncurry0 (gf (curry0 R0))).
Proof.
  repeat_intros 3. apply uncurry_map0. apply MON; apply curry_map0; assumption.
Qed.

Lemma _paco0_mon_gen (gf gf': rel0 -> rel0) r r'
    (LEgf: gf <1= gf')
    (LEr: r <0= r'):
  paco0 gf r <0== paco0 gf' r'.
Proof.
  apply curry_map0. red; intros. eapply paco_mon_gen. apply PR.
  - intros. apply LEgf, PR0.
  - intros. apply LEr, PR0.
Qed.

Lemma paco0_mon_gen (gf gf': rel0 -> rel0) r r'
    (REL: paco0 gf r)
    (LEgf: gf <1= gf')
    (LEr: r <0= r'):
  paco0 gf' r'.
Proof.
  eapply _paco0_mon_gen; [apply LEgf | apply LEr | apply REL].
Qed.

Lemma upaco0_mon_gen (gf gf': rel0 -> rel0) r r'
    (REL: upaco0 gf r)
    (LEgf: gf <1= gf')
    (LEr: r <0= r'):
  upaco0 gf' r'.
Proof.
  destruct REL.
  - left. eapply paco0_mon_gen; [apply H | apply LEgf | apply LEr].
  - right. apply LEr, H.
Qed.

Section Arg0.

Variable gf : rel0 -> rel0.
Arguments gf : clear implicits.

Theorem _paco0_mon: _monotone0 (paco0 gf).
Proof.
  repeat_intros 3. eapply curry_map0, _paco_mon; apply uncurry_map0; assumption.
Qed.

Theorem _paco0_acc: forall
  l r (OBG: forall rr (INC: r <0== rr) (CIH: l <0== rr), l <0== paco0 gf rr),
  l <0== paco0 gf r.
Proof.
  intros. apply uncurry_adjoint1_0.
  eapply _paco_acc. intros.
  apply uncurry_adjoint1_0 in INC. apply uncurry_adjoint1_0 in CIH.
  apply uncurry_adjoint2_0.
  eapply le0_trans. eapply (OBG _ INC CIH).
  apply curry_map0.
  apply _paco_mon; try apply le1_refl; apply curry_bij1_0.
Qed.

Theorem _paco0_mult_strong: forall r,
  paco0 gf (upaco0 gf r) <0== paco0 gf r.
Proof.
  intros. apply curry_map0.
  eapply le1_trans; [| eapply _paco_mult_strong].
  apply _paco_mon; intros []; intros H; apply H.
Qed.

Theorem _paco0_fold: forall r,
  gf (upaco0 gf r) <0== paco0 gf r.
Proof.
  intros. apply uncurry_adjoint1_0.
  eapply le1_trans; [| apply _paco_fold]. apply le1_refl.
Qed.

Theorem _paco0_unfold: forall (MON: _monotone0 gf) r,
  paco0 gf r <0== gf (upaco0 gf r).
Proof.
  intros. apply curry_adjoint2_0.
  eapply _paco_unfold; apply monotone0_map; assumption.
Qed.

Theorem paco0_acc: forall
  l r (OBG: forall rr (INC: r <0= rr) (CIH: l <0= rr), l <0= paco0 gf rr),
  l <0= paco0 gf r.
Proof.
  apply _paco0_acc.
Qed.

Theorem paco0_mon: monotone0 (paco0 gf).
Proof.
  apply monotone0_eq.
  apply _paco0_mon.
Qed.

Theorem upaco0_mon: monotone0 (upaco0 gf).
Proof.
  repeat_intros 2. intros R LE0.
  destruct R.
  - left. eapply paco0_mon. apply H. apply LE0.
  - right. apply LE0, H.
Qed.

Theorem paco0_mult_strong: forall r,
  paco0 gf (upaco0 gf r) <0= paco0 gf r.
Proof.
  apply _paco0_mult_strong.
Qed.

Corollary paco0_mult: forall r,
  paco0 gf (paco0 gf r) <0= paco0 gf r.
Proof. intros; eapply paco0_mult_strong, paco0_mon; [apply PR|..]; intros; left; assumption. Qed.

Theorem paco0_fold: forall r,
  gf (upaco0 gf r) <0= paco0 gf r.
Proof.
  apply _paco0_fold.
Qed.

Theorem paco0_unfold: forall (MON: monotone0 gf) r,
  paco0 gf r <0= gf (upaco0 gf r).
Proof.
  repeat_intros 1. eapply _paco0_unfold; apply monotone0_eq; assumption.
Qed.

End Arg0.

Arguments paco0_acc : clear implicits.
Arguments paco0_mon : clear implicits.
Arguments upaco0_mon : clear implicits.
Arguments paco0_mult_strong : clear implicits.
Arguments paco0_mult : clear implicits.
Arguments paco0_fold : clear implicits.
Arguments paco0_unfold : clear implicits.

Global Instance paco0_inst (gf : rel0->_) r : paco_class (paco0 gf r) :=
{ pacoacc := paco0_acc gf;
  pacomult := paco0_mult gf;
  pacofold := paco0_fold gf;
  pacounfold := paco0_unfold gf }.

End PACO0.

Global Opaque paco0.

Hint Unfold upaco0.
Hint Resolve paco0_fold.
Hint Unfold monotone0.