(* Copyright 2012-2015 by Adam Petcher.				*
 * Use of this source code is governed by the license described	*
 * in the LICENSE file at the root of the source tree.		*)
(* Rules used to prove facts based on the distribution semantics *)

Set Implicit Arguments.

Require Import FCF.DistSem.
Require Import FCF.Fold.
Require Import Permutation.
Require Import FCF.SemEquiv.
Require Import FCF.DetSem.
Require Import FCF.NotationV1.

Require Import micromega.Lia.

Local Open Scope rat_scope.
Local Open Scope comp_scope.
Local Open Scope list_scope.

(* The uniformity rule allows us to conclude that all bit vectors (of the same length) are equally likely. *)
Theorem uniformity : forall n (x1 x2 : Bvector n),
  evalDist ({0, 1} ^ n) x1 == evalDist ({0, 1} ^ n) x2.

  intuition.
  unfold evalDist.
  eapply eqRat_refl.
Qed.

Lemma evalDist_in_f : forall (A B : Set)(c1 : Comp A)(c2 : Comp B)(f : A -> B),
  (forall a, eqRat (evalDist c1 a) (evalDist c2 (f a))) ->
  (forall a, In a (getSupport c1) <-> In (f a) (getSupport c2)).

  intros.
  specialize (getSupport_correct c1).
  specialize (getSupport_correct c2).
  intros.
  inversion H0; clear H0.
  inversion H1; clear H1.

  intuition.
  apply H3.
  intuition.
  eapply H4; eauto.
  eapply eqRat_trans.
  eapply H.
  eauto.

  eapply H4.
  intuition.
  eapply H3; eauto.
  eapply eqRat_trans.
  eapply eqRat_symm.
  eapply H.
  eauto.
Qed.

Lemma perm_map_in : forall (A B : Set)(lsa : list A)(lsb : list B)(f : A -> B)(f_inv : B -> A),
  (forall b, In b lsb -> f (f_inv b) = b) ->
  (forall a, In a lsa <-> In (f a) lsb) ->
  NoDup (map f lsa) ->
  NoDup lsb ->
  Permutation (map f lsa) lsb.

  intuition.
  eapply NoDup_Permutation; intuition.
  apply in_map_iff in H3.
  destruct H3.
  intuition.
  subst.
  eapply H0.
  trivial.

  eapply in_map_iff.
  econstructor.
  split.
  2:{
    eapply H0.
    assert (x = f (f_inv x)).
    symmetry.
    eapply H.
    trivial.
    rewrite H4 in H3.
    eapply H3.
  }
  eapply H.
  trivial.
Qed.

Lemma not_in_map : forall (A B : Set)(ls : list A)(f : A -> B)(f_inv : B -> A)(a : A),
  (forall a, f_inv (f a) = a) ->
  ~In a ls ->
  ~In (f a) (map f ls).

  induction ls; intuition.
  simpl in *.

  intuition.

  eapply H1.
  rewrite <- (H a).
  rewrite <- (H a0).
  f_equal.
  trivial.

  eapply IHls; eauto.
Qed.

Lemma map_NoDup : forall (A B : Set)(ls : list A)(f : A -> B)(f_inv : B -> A),
  (forall a, In a ls -> f_inv (f a) = a) ->
  NoDup ls ->
  NoDup (map f ls).

  induction ls; intuition; simpl in *.
  econstructor.

  inversion H0; clear H0; subst.
  econstructor; eauto.

  intuition.
  apply in_map_iff in H0.
  destruct H0.
  intuition.
  assert (x = a).
  rewrite <- (H x); intuition.
  rewrite <- (H a); intuition.
  f_equal.
  trivial.
  subst.
  intuition.
Qed.

Lemma support_NoDup : forall (A : Set)(c : Comp A),
  NoDup (getSupport c).

  intuition.
  specialize (getSupport_correct c); intuition.
  inversion H.
  eauto.
Qed.

Lemma filter_NoDup : forall (A : Set)(ls : list A)(P : A -> bool),
  NoDup ls ->
  NoDup (filter P ls).

  induction ls; simpl in *; intuition.

  inversion H; clear H; subst.
  destruct (P a).
  econstructor; eauto.
  intuition.
  eapply filter_In in H.
  intuition.

  eapply IHls; eauto.

Qed.

Lemma evalDist_getSupport_perm : forall (A B : Set)(c1 : Comp A)(c2 : Comp B) (f : A -> B)(f_inv : B -> A),
  (forall b, In b (getSupport c2) -> (f (f_inv b)) = b) ->
  (forall a, In a (getSupport c1) -> (f_inv (f a)) = a) ->
  (forall a, In a (getSupport c1) -> eqRat (evalDist c1 a) (evalDist c2 (f a))) ->
  (forall a, In a (getSupport c2) -> eqRat (evalDist c2 a) (evalDist c1 (f_inv a))) ->
  Permutation (map f (getSupport c1)) (getSupport c2).

  intuition.
  eapply NoDup_Permutation.
  eapply map_NoDup.
  intuition.
  eapply getSupport_NoDup.
  eapply getSupport_NoDup.
  intuition.
  apply in_map_iff in H3.
  destruct H3.
  intuition.
  subst.
  eapply getSupport_In_evalDist.
  intuition.
  eapply getSupport_In_evalDist.
  eauto.
  eapply eqRat_trans.
  eapply H1.
  trivial.
  trivial.

  eapply in_map_iff.
  econstructor.
  split.
  eapply H.
  trivial.

  eapply getSupport_In_evalDist.
  intuition.
  eapply getSupport_In_evalDist.
  eapply H3.
  rewrite H2.
  trivial.
  trivial.

Qed.

Lemma evalDist_getSupport_filter_perm : forall (A: Set)(c1 : Comp A)(c2 : Comp A)(P : A -> bool),
  (forall a, P a = true -> eqRat (evalDist c1 a) (evalDist c2 a)) ->
  Permutation (filter P (getSupport c1)) (filter P (getSupport c2)).

  intuition.
  eapply NoDup_Permutation.
  eapply filter_NoDup.
  eapply support_NoDup.
  eapply filter_NoDup.
  eapply support_NoDup.

  intuition.
  eapply filter_In in H0.
  eapply filter_In.
  intuition.
  eapply getSupport_In_evalDist.
  apply getSupport_In_evalDist in H1.
  intuition.
  apply H1.
  eapply eqRat_trans.
  eapply H.
  trivial.
  trivial.

  intuition.
  eapply filter_In in H0.
  eapply filter_In.
  intuition.
  eapply getSupport_In_evalDist.
  apply getSupport_In_evalDist in H1.
  intuition.
  apply H1.
  eapply eqRat_trans.
  eapply eqRat_symm.
  eapply H.
  trivial.
  trivial.
Qed.

Lemma evalDist_getSupport_perm_id : forall (A : Set)(c1 c2 : Comp A),
  (forall a, eqRat (evalDist c1 a) (evalDist c2 a)) ->
  Permutation (getSupport c1) (getSupport c2).

  intuition.
  rewrite <- map_id.
  eapply Permutation_sym.
  eapply evalDist_getSupport_perm; intuition.
  symmetry.
  eauto.
Qed.

Lemma sumList_f_inverse : forall (A B : Set)(ls : list A)(f : A -> B)(f_inv : B -> A)(fa : A -> Rat),
    (forall a, In a ls -> f_inv (f a) = a) ->
    sumList (map f ls) (fun (b : B) => fa (f_inv b) ) ==
    sumList ls fa.

  intuition.
  unfold sumList.
  eapply fold_add_f_inverse;
  intuition.
Qed.

Theorem distro_iso_eq : forall (A B C D : Set)(f : C -> D)(f_inv : D -> C)(d : Comp D)(c : Comp C)(f1 : D -> Comp B)(f2 : C -> Comp A)(a : A)(b : B),
  (forall x, In x (getSupport d) -> f (f_inv x) = x) ->
  (forall x, In x (getSupport c) -> f_inv (f x) = x) ->
  (forall x, In x (getSupport d) -> In (f_inv x) (getSupport c)) ->
  (forall x, In x (getSupport c) -> (evalDist d (f x)) == (evalDist c x)) ->
  (forall x, In x (getSupport c) -> (evalDist (f1 (f x)) b) == (evalDist (f2 x) a)) ->
  (evalDist (Bind d f1) b == evalDist (Bind c f2) a).

  intuition.
  simpl.

  eapply eqRat_trans.
  eapply fold_add_rat_perm.
  eapply Permutation_sym.
  eapply evalDist_getSupport_perm; eauto.

  intuition.
  symmetry.
  eauto.

  intuition.
  rewrite <- (H a0) at 1.
  eapply H2.
  eauto.
  trivial.

  eapply eqRat_refl.
  intuition.
  eapply ratMult_eqRat_compat.
  rewrite <- H at 1.
  eauto.
  trivial.
  rewrite <- H at 1.
  eapply H3.
  eauto.
  trivial.

  eapply eqRat_trans.
  2:{
    eapply fold_add_f_inverse; eauto.
    eapply eqRat_refl.
  }
  simpl.
  eapply eqRat_refl.

Qed.

Lemma evalDist_seq_eq : forall (A1 A2 B : Set)(c1 c2 : Comp B)(f1 : B -> Comp A1)(f2 : B -> Comp A2) y z,
  (forall x : B, evalDist c1 x == evalDist c2 x) ->
  (forall x : B, In x (getSupport c1) -> evalDist (f1 x) y == evalDist (f2 x) z) ->
  evalDist (x <-$ c1; f1 x) y == evalDist (x <-$ c2; f2 x) z.

  intuition.
  eapply (distro_iso_eq (fun b => b)(fun b => b)); intuition.

  eapply getSupport_In_evalDist.
  intuition.
  eapply getSupport_In_evalDist.
  eauto.
  rewrite H.
  trivial.

  eapply H0.
  eapply getSupport_In_evalDist.
  intuition.
  eapply getSupport_In_evalDist.
  eauto.
  rewrite <- H.
  trivial.
Qed.

Theorem distro_irr_eq : forall (A B : Set)(b : Comp B)(a : B -> Comp A)(y : A) v,
  well_formed_comp b ->
  (forall x, In x (getSupport b) -> (evalDist (a x) y) == v) ->
  evalDist (Bind b a) y == v.

  intuition.
  simpl.
  rewrite sumList_body_eq.
  2:{
    intuition.
    rewrite H0 at 1.
    eapply eqRat_refl.
    trivial.
  }
  rewrite sumList_factor_constant_r.
  rewrite evalDist_lossless.
  eapply ratMult_1_l.
  trivial.
Qed.

Lemma sumList_filter : forall (A : Set)(ls : list A)(f : A -> Rat)(P : A -> bool) init,
  fold_left (fun r a => r + if (P a) then (f a) else 0) ls init  ==
  fold_left (fun r a => r + (f a)) (filter P ls) init.

  induction ls; simpl in *; intuition.

  destruct (P a); simpl.
  eapply IHls.
  rewrite fold_add_body_eq.
  eapply IHls.
  symmetry.
  eapply ratAdd_0_r.

  intuition.
Qed.

Theorem evalDist_left_ident_eq : forall (B : Set)(eqd : EqDec B)(b : B)(A : Set)(c2 : B -> Comp A)  a,
  (evalDist (x <-$ ret b; (c2 x)) a) == (evalDist (c2 b) a).

  intuition.
  simpl.
  unfold sumList.
  simpl.
  destruct (EqDec_dec eqd b b).
  rewrite <- ratAdd_0_l.
  rewrite ratMult_1_l.
  intuition.
  congruence.

Qed.

Theorem evalDist_assoc_eq : forall (A : Set)(c1 : Comp A)(B C : Set)(c2 : A -> Comp B)(c3 : B -> Comp C),
  dist_sem_eq (Bind (Bind c1 c2) c3) (Bind c1 (fun a => (Bind (c2 a) c3))).

  unfold dist_sem_eq.
  intuition.
  assert (EqDec B).
  eapply bind_EqDec; eauto.
  simpl.
  eapply eqRat_trans.
  eapply sumList_body_eq.
  intuition.
  symmetry.
  eapply sumList_factor_constant_r.
  simpl.
  rewrite sumList_comm.
  eapply sumList_body_eq.
  intuition.
  rewrite <- sumList_factor_constant_l.
  eapply eqRat_trans.
  eapply (sumList_filter_partition (fun b => if (in_dec (EqDec_dec _) b (getSupport (c2 a0))) then true else false)).
  eapply eqRat_trans.
  eapply ratAdd_eqRat_compat.
  eapply eqRat_refl.
  eapply sumList_0.
  intuition.
  eapply filter_In in H1.
  intuition.
  destruct (in_dec (EqDec_dec H) a1 (getSupport (c2 a0))).
  simpl in H3.
  discriminate.
  assert (evalDist (c2 a0) a1 == 0).
  eapply getSupport_not_In_evalDist.
  trivial.
  rewrite H1.
  rewrite ratMult_0_r.
  eapply ratMult_0_l.
  rewrite <- ratAdd_0_r.
  eapply eqRat_trans.
  eapply sumList_permutation.
  2:{
    eapply sumList_body_eq.
    intuition.
    eapply ratMult_assoc.
  }
  eapply NoDup_Permutation.
  eapply filter_NoDup.
  eapply getUnique_NoDup.
  eapply getSupport_NoDup.
  intuition.
  apply filter_In in H1.
  intuition.
  destruct (in_dec (EqDec_dec H) x (getSupport (c2 a0))).
  trivial.
  discriminate.

  eapply filter_In.
  intuition.
  eapply in_getUnique.
  eapply in_flatten.
  econstructor.
  split.
  eapply in_map_iff.
  econstructor.
  split.
  eapply eq_refl.
  eauto.
  eauto.
  destruct (in_dec (EqDec_dec H) x (getSupport (c2 a0)) ).
  trivial.
  intuition.
Qed.

(* We can swap any two independent commands *)
Theorem evalDist_commute_eq : forall (A B : Set)(c1 : Comp A)(c2 : Comp B)(C : Set)(c3 : A -> B -> Comp C),
  dist_sem_eq (a <-$ c1; b <-$ c2; (c3 a b)) (b <-$ c2; a <-$ c1; (c3 a b)).

  intuition.
  unfold dist_sem_eq.
  intuition.
  simpl.
  eapply eqRat_trans.
  eapply sumList_body_eq.
  intuition.
  symmetry.
  eapply sumList_factor_constant_l.
  symmetry.
  eapply eqRat_trans.
  eapply sumList_body_eq.
  intuition.
  symmetry.
  eapply sumList_factor_constant_l.
  rewrite sumList_summation.
  eapply sumList_body_eq.
  intuition.
  eapply sumList_body_eq.
  intuition.
  repeat rewrite <- ratMult_assoc.
  eapply ratMult_eqRat_compat; intuition.
  eapply ratMult_comm.
Qed.

Lemma evalDist_Repeat_eq : forall (A : Set)(c1 c2 : Comp A)(P1 P2 : A -> bool) v1 v2,
  evalDist c1 v1 == evalDist c2 v2 ->
  P1 v1 = P2 v2 ->
  In v1 (filter P1 (getSupport c1)) ->
  sumList (filter P1 (getSupport c1)) (evalDist c1) == sumList (filter P2 (getSupport c2)) (evalDist c2) ->
  evalDist (Repeat c1 P1) v1 == evalDist (Repeat c2 P2) v2.

  intuition.
  simpl.
  eapply ratMult_eqRat_compat; intuition.
  eapply ratMult_eqRat_compat.
  unfold indicator.
  rewrite H0.
  intuition.
  eapply ratInverse_eqRat_compat.
  intuition.
  eapply getSupport_In_evalDist.
  eapply filter_In.
  eauto.
  eapply sumList_0 in H3; eauto.
  trivial.

Qed.

Definition intersect(A : Set)(eqd : eq_dec A)(ls1 ls2 : list A) :=
  filter (fun x => if (in_dec eqd x ls1) then true else false) ls2.

Lemma in_intersect : forall (A : Set)(eqd : eq_dec A)(ls1 ls2 : list A) a,
  In a (intersect eqd ls1 ls2) <->
  In a ls1 /\ In a ls2.

  unfold intersect in *.

  intuition.
  apply filter_In in H.
  intuition.
  destruct (in_dec eqd a ls1).
  trivial.
  discriminate.
  apply filter_In in H.
  intuition.

  eapply filter_In.
  intuition.
  destruct (in_dec eqd a ls1); intuition.
Qed.

Lemma intersect_comm : forall (A : Set)(eqd : eq_dec A)(ls1 ls2 : list A),
  NoDup ls1 ->
  NoDup ls2 ->
  Permutation (intersect eqd ls1 ls2) (intersect eqd ls2 ls1).

  intuition.
  eapply NoDup_Permutation.
  apply filter_NoDup; trivial.
  apply filter_NoDup; trivial.

  unfold intersect in *.
  intuition.
  apply filter_In.
  apply filter_In in H1.
  intuition.
  destruct (in_dec eqd x ls1); intuition.
  discriminate.
  destruct (in_dec eqd x ls2); intuition.

  apply filter_In.
  apply filter_In in H1.
  intuition.
  destruct (in_dec eqd x ls2); intuition.
  discriminate.
  destruct (in_dec eqd x ls1); intuition.

Qed.

Theorem fundamental_lemma_h : forall (A : Set)(eqda : EqDec A)(c1 c2 : Comp (A * bool)),
  (evalDist (Bind c1 (fun x => ret snd x)) true == evalDist (Bind c2 (fun x => ret snd x)) true) ->
  (forall a, evalDist c1 (a, false) == evalDist c2 (a, false)) ->
  forall a,
    ratDistance (evalDist (Bind c1 (fun x => ret (fst x))) a) (evalDist (Bind c2 (fun x => ret (fst x))) a) <=
    evalDist (Bind c1 (fun x => ret snd x)) true.

  intuition.
  simpl in *.

  rewrite (sumList_filter_partition (@snd A bool)).
  rewrite (sumList_filter_partition (@snd A bool) (getSupport c2)).

  rewrite ratDistance_add_same_r_gen.

  eapply leRat_trans.
  eapply ratDistance_le_max_triv.
  eapply maxRat_leRat_same.

  eapply leRat_trans.
  2:{
    eapply sumList_filter_le.
  }

  eapply sumList_le; intuition.
  apply filter_In in H1.
  intuition.
  eapply ratMult_leRat_compat; intuition.
  destruct a0.
  simpl in *.
  subst.
  destruct (EqDec_dec bool_EqDec true true); try congruence.
  destruct (EqDec_dec eqda a0 a); intuition.

  eapply leRat_trans.
  2:{
    eapply eqRat_impl_leRat.
    symmetry.
    eapply H.
  }
  eapply leRat_trans.
  2:{
    eapply sumList_filter_le.
  }
  eapply sumList_le; intuition.
  apply filter_In in H1.
  intuition.
  eapply ratMult_leRat_compat; intuition.
  destruct a0.
  simpl in *.
  subst.
  destruct (EqDec_dec bool_EqDec true true); try congruence.
  destruct (EqDec_dec eqda a0 a); intuition.

  assert (eq_dec (A * bool)).
  unfold eq_dec.
  eapply (EqDec_dec (pair_EqDec _ _)).

  assert (NoDup (filter (fun a0 : A * bool => negb (snd a0)) (intersect H1 (getSupport c1) (getSupport c2)))).
  eapply filter_NoDup.
  eapply filter_NoDup; eapply getSupport_NoDup.

  eapply eqRat_trans.
  symmetry.
  eapply sumList_subset'.
  trivial.
  eapply H2.
  eapply filter_NoDup.
  eapply getSupport_NoDup.
  intuition.
  apply filter_In in H3.
  intuition.
  eapply filter_In.
  split.

  eapply in_intersect.
  eapply Permutation_in.
  eapply intersect_comm.
  eapply getSupport_NoDup.
  2:{
    eauto.
  }
  eapply getSupport_NoDup.
  trivial.

  intuition.
  apply filter_In in H3.
  intuition.
  destruct a0.
  simpl in *.
  destruct (EqDec_dec eqda a0 a); subst.
  rewrite ratMult_1_r.
  destruct b; simpl in *; try discriminate.
  rewrite H0.
  eapply getSupport_not_In_evalDist.
  intuition.
  eapply H4.
  eapply filter_In.
  intuition.
  eapply in_intersect.
  intuition.
  apply ratMult_0_r.

  symmetry.
  eapply eqRat_trans.
  symmetry.
  eapply sumList_subset'.
  trivial.
  eapply H2.
  eapply filter_NoDup.
  eapply getSupport_NoDup.
  intuition.
  apply filter_In in H3.
  intuition.
  eapply filter_In.
  split.

  eapply in_intersect.
  eauto.
  trivial.

  intuition.
  apply filter_In in H3.
  intuition.
  destruct a0.
  simpl in *.
  destruct (EqDec_dec eqda a0 a); subst.
  rewrite ratMult_1_r.
  destruct b; simpl in *; try discriminate.
  rewrite <- H0.
  eapply getSupport_not_In_evalDist.
  intuition.
  eapply H4.
  eapply filter_In.
  intuition.
  eapply in_intersect.
  intuition.
  apply ratMult_0_r.

  eapply sumList_body_eq.
  intuition.
  apply filter_In in H3.
  intuition.
  destruct a0; simpl in *.
  destruct b; simpl in *; try discriminate.
  rewrite H0.
  intuition.
Qed.

Theorem evalDist_right_ident : forall (A : Set)(eqd : EqDec A)(c : Comp A) a,
  evalDist (x <-$ c; ret x) a == evalDist c a.

  intuition.
  destruct (in_dec (EqDec_dec eqd) a (getSupport c)).
  simpl.
  eapply eqRat_trans.
  eapply sumList_exactly_one.
  eapply getSupport_NoDup.
  eauto.
  intuition.
  destruct (EqDec_dec eqd b a).
  subst.
  intuition.
  eapply ratMult_0_r.

  destruct (EqDec_dec eqd a a).
  eapply ratMult_1_r.
  congruence.

  simpl.
  eapply eqRat_trans.
  eapply sumList_0.
  intuition.
  destruct (EqDec_dec eqd a0 a).
  subst.
  intuition.
  eapply ratMult_0_r.
  symmetry.
  eapply getSupport_not_In_evalDist.
  trivial.
Qed.

Theorem fundamental_lemma : forall (A B : Set)(eqda : EqDec A)(eqdb : EqDec B)(c1 c2 : Comp A)(badness : A -> bool)(proj : A -> B),
  Pr [a <-$ c1; ret (badness a)] == Pr[a <-$ c2; ret (badness a)] ->
  (forall x, evalDist (a <-$ c1; ret (proj a, badness a)) (x, false) == evalDist (a <-$ c2; ret (proj a, badness a)) (x, false)) ->
  forall x,
    | (evalDist (a <-$ c1; ret (proj a)) x)  - (evalDist (a <-$ c2; ret (proj a)) x) | <=
    Pr [a <-$ c1; ret (badness a)].

  intuition.
  specialize (@fundamental_lemma_h B eqdb (a <-$ c1; ret (proj a, badness a)) (a <-$ c2; ret (proj a, badness a)) ); intuition.
  assert ( | evalDist (x <-$ (a0 <-$ c1; ret (proj a0, badness a0)); ret fst x) x -
       evalDist (x <-$ (a0 <-$ c2; ret (proj a0, badness a0)); ret fst x) x | ==
          | evalDist (a <-$ c1; ret proj a) x - evalDist (a <-$ c2; ret proj a) x |).
  eapply ratDistance_eqRat_compat.

  eapply eqRat_trans.
  eapply evalDist_assoc_eq.
  cbv beta.
  eapply eqRat_trans.
  eapply evalDist_seq_eq.
  intuition.
  eapply eqRat_refl.
  intuition.
  eapply eqRat_trans.
  eapply evalDist_left_ident_eq.
  eapply eqRat_refl.
  cbv beta.
  unfold fst.
  intuition.

  eapply eqRat_trans.
  eapply evalDist_assoc_eq.
  cbv beta.
  eapply evalDist_seq_eq; intuition.
  eapply evalDist_left_ident_eq.

  rewrite <- H2.
  rewrite H1.
  eapply leRat_trans.
  eapply eqRat_impl_leRat.
  eapply eqRat_trans.
  eapply evalDist_assoc_eq.
  cbv beta.
  eapply evalDist_seq_eq; intuition.
  eapply eqRat_refl.
  eapply eqRat_trans.
  eapply evalDist_left_ident_eq.
  cbv beta.
  eapply eqRat_refl.
  cbv beta.
  unfold snd.
  intuition.
  eapply eqRat_trans.
  eapply evalDist_assoc_eq.
  eapply eqRat_trans.
  eapply evalDist_seq_eq; intuition.
  eapply eqRat_refl.
  eapply eqRat_trans.
  eapply evalDist_left_ident_eq.
  cbv beta.
  eapply eqRat_refl.
  rewrite H.
  symmetry.
  eapply eqRat_trans.
  eapply evalDist_assoc_eq.
  eapply eqRat_trans.
  eapply evalDist_seq_eq; intuition.
  eapply eqRat_refl.
  eapply eqRat_trans.
  eapply evalDist_left_ident_eq.
  eapply eqRat_refl.
  cbv beta.

  simpl.
  intuition.
  intuition.
Qed.

Theorem repeat_unroll_eq: forall (A : Set)(eqd : EqDec A)(c : Comp A)(P : A -> bool) v,
  well_formed_comp c ->
  (exists a, In a (filter P (getSupport c))) ->
  evalDist (Repeat c P) v == evalDist (x <-$ c; if (P x) then ret x else (Repeat c P)) v.

  intuition.

  eapply det_eq_impl_dist_sem_eq; trivial.
  destruct H0.

  eapply well_formed_Repeat; trivial.
  unfold eq_dec.
  intuition.
  eapply (EqDec_dec _).
  eauto.
  econstructor; intuition.
  destruct (P b).
  econstructor.
  destruct H0.
  econstructor.
  unfold eq_dec.
  intuition.
  eapply (EqDec_dec _).
  trivial.
  eauto.

  unfold DetSem.evalDet_equiv.
  intuition.
  inversion H1; clear H1; subst.

  inversion H2; clear H2; subst.
  simpl in *.
  eapply evalDet_steps_bind_done_inv in H6.
  destruct H6.
  destruct H1.
  intuition.
  econstructor.
  eapply evalDet_steps_trans.
  eapply evalDet_steps_bind_done.
  eauto.
  destruct (P x).
  inversion H3; clear H3; subst.
  simpl in *.
  inversion H7; clear H7; subst.
  econstructor.
  eauto.
  simpl.
  2:eassumption.
  constructor.

  inversion H2; clear H2; subst.
  simpl in *.
  apply evalDet_steps_bind_eof_inv in H6.
  intuition.
  econstructor.
  eapply evalDet_bind_eof.
  trivial.
  destruct H1.
  destruct H1.
  intuition.
  econstructor.
  eapply evalDet_steps_trans.
  eapply evalDet_steps_bind_done.
  eauto.
  destruct (P x).
  inversion H3; clear H3; subst.
  simpl in *.
  inversion H7.
  trivial.

  inversion H1; clear H1; subst.
  eapply evalDet_steps_bind_done_inv in H2.
  destruct H2.
  destruct H1.
  intuition.
  econstructor.
  econstructor.
  eauto.
  simpl.
  eapply evalDet_steps_trans.
  eapply evalDet_steps_bind_done.
  eauto.
  destruct (P x).
  inversion H3; clear H3; subst.
  simpl in *.
  inversion H7; clear H7; subst.
  econstructor.
  eauto.
  simpl.
  2:eassumption.
  constructor.

  apply evalDet_steps_bind_eof_inv in H2.
  intuition.
  econstructor.
  econstructor.
  eauto.
  simpl.
  eapply evalDet_bind_eof.
  trivial.
  destruct H1.
  destruct H1.
  intuition.
  econstructor.
  econstructor.
  eauto.
  simpl.
  eapply evalDet_steps_trans.
  eapply evalDet_steps_bind_done.
  eauto.
  destruct (P x).
  inversion H3; clear H3; subst.
  simpl in *.
  inversion H7.
  trivial.
Qed.

(* rules related to case splits and specifications *)
Lemma evalDist_seq_case_split_eq : forall (B : Set)(e : B -> bool) v v1 v2 (A : Set)(c : Comp B)(f : B -> Comp A) a,
  well_formed_comp c ->
  Pr[b <-$ c; ret (e b)] == v ->
  (forall b, (e b) = true -> (evalDist (f b) a) == v1) ->
  (forall b, (e b) = false -> (evalDist (f b) a) == v2) ->
  (evalDist (Bind c f) a == v * v1 + (ratSubtract 1 v) * v2).

  intuition.
  simpl in *.
  rewrite (sumList_partition e).
  eapply ratAdd_eqRat_compat.

  rewrite (sumList_body_eq _ _ (fun b => ((evalDist c b) * (if (e b) then 1 else 0)) * v1)).
  rewrite sumList_factor_constant_r.
  eapply ratMult_eqRat_compat; intuition.
  rewrite <- H0.
  eapply sumList_body_eq; intuition.
  destruct (EqDec_dec bool_EqDec (e a0) true).
  rewrite e0.
  intuition.
  destruct (e a0); try congruence.
  intuition.

  intuition.
  case_eq (e a0); intuition.
  repeat rewrite ratMult_1_r.
  eapply ratMult_eqRat_compat; intuition.
  repeat rewrite ratMult_0_r.
  rewrite ratMult_0_l.
  intuition.

  rewrite (sumList_body_eq _ _ (fun b => ((evalDist c b) * (if (e b) then 0 else 1)) * v2)).
  rewrite sumList_factor_constant_r.
  eapply ratMult_eqRat_compat; intuition.
  rewrite <- H0.

  rewrite <- (@evalDist_lossless _ c).
  rewrite (sumList_partition e _ (evalDist c)).
  rewrite ratAdd_comm.
  rewrite ratSubtract_ratAdd_assoc.
  rewrite ratSubtract_0.
  rewrite <- ratAdd_0_r.
  intuition.
  eapply eqRat_impl_leRat.
  eapply sumList_body_eq; intuition.
  destruct (EqDec_dec bool_EqDec (e a0) true).
  rewrite e0.
  intuition.
  destruct (e a0); try congruence.
  intuition.
  eapply eqRat_impl_leRat.
  eapply sumList_body_eq; intuition.
  destruct (EqDec_dec bool_EqDec (e a0) true).
  rewrite e0.
  intuition.
  destruct (e a0); try congruence.
  intuition.
  trivial.

  intuition.
  case_eq (e a0); intuition.
  repeat rewrite ratMult_0_r.
  rewrite ratMult_0_l.
  intuition.
  repeat rewrite ratMult_1_r.
  eapply ratMult_eqRat_compat; intuition.
Qed.

Theorem evalDist_bind_distance : forall (A B : Set)(c1 c2 : Comp B)(c3 c4 : B -> Comp A) d,
  well_formed_comp c2 ->
  (forall b, evalDist c1 b == evalDist c2 b) ->
  (forall b a, In b (getSupport c1) -> | evalDist (c3 b) a - evalDist (c4 b) a | <= d) ->
  (forall a, | evalDist (Bind c1 c3) a - evalDist (Bind c2 c4) a | <= d).

  intuition.
  simpl.
  eapply leRat_trans.
  eapply eqRat_impl_leRat.
  rewrite sumList_body_eq.
  2:{
    intros.
    eapply ratMult_eqRat_compat.
    eapply H0.
    eapply eqRat_refl.
  }
  eapply eqRat_refl.

  assert (Permutation (getSupport c1) (getSupport c2)).
  eapply NoDup_Permutation; intuition; eauto using getSupport_NoDup.
  eapply getSupport_In_evalDist.
  rewrite <- H0.
  eapply getSupport_In_evalDist.
  trivial.
  eapply getSupport_In_evalDist.
  rewrite H0.
  eapply getSupport_In_evalDist.
  trivial.
  erewrite sumList_permutation; eauto.

  rewrite sumList_distance_prod.
  eapply leRat_trans.
  eapply sumList_le; intuition.
  eapply ratMult_leRat_compat.
  eapply leRat_refl.
  eapply H1.
  eapply getSupport_In_evalDist.
  rewrite H0.
  eapply getSupport_In_evalDist.
  trivial.

  rewrite sumList_factor_constant_r.
  rewrite evalDist_lossless.
  rewrite ratMult_1_l.
  intuition.
  trivial.

Qed.

Lemma evalDist_Bind_1_le_l : forall (A B : Set) (b : Comp B) (a : B -> Comp A) (y : A) (v : Rat),
  well_formed_comp b ->
  (forall x : B, In x (getSupport b) -> evalDist (a x) y <= v) ->
  evalDist (x <-$ b; a x) y <= v.

  intuition.
  simpl.
  eapply leRat_trans.
  eapply sumList_le; intuition.
  eapply ratMult_leRat_compat.
  eapply leRat_refl.
  eapply H0.
  trivial.
  rewrite sumList_factor_constant_r.
  rewrite evalDist_lossless.
  rewrite ratMult_1_l.
  intuition.
  trivial.
Qed.

Lemma evalDist_ret_1 :
  forall (A : Set)(eqd : eq_dec A)(a1 a2 : A),
    a1 = a2 ->
    evalDist (Ret eqd a1) a2 = 1.

  intuition.
  subst.
  simpl.
  destruct (eqd a2 a2); subst; intuition.

Qed.

Lemma evalDist_ret_0 :
  forall (A : Set)(eqd : eq_dec A)(a1 a2 : A),
    a1 <> a2 ->
    evalDist (Ret eqd a1) a2 = 0.

  intuition.
  simpl.
  destruct (eqd a1 a2); subst; intuition.

Qed.

Lemma evalDist_ret_eq :
  forall (A : Set)(eqd1 eqd2 : eq_dec A) a1 a2 x,
    a1 = a2 ->
    evalDist (Ret eqd1 a1) x == evalDist (Ret eqd2 a2) x.

  intuition.
  simpl.
  subst.
  destruct (eqd1 a2 x); destruct (eqd2 a2 x); subst; intuition.
Qed.

Theorem evalDist_seq_step :
  forall (A B :Set)(c : Comp A)(f : A -> Comp B) b,
    evalDist (Bind c f) b ==
    sumList (getSupport c) (fun a => evalDist c a * evalDist (f a) b).

  intuition.
  simpl.
  eapply sumList_body_eq; intuition.

Qed.

Theorem evalDist_1 :
  forall (A : Set)(eqd : EqDec A)(c : Comp A) a,
    well_formed_comp c ->
    evalDist c a == 1 ->
    (getSupport c) = (a :: nil)%list.

  intuition.

  specialize (evalDist_getSupport_perm_id c (ret a)); intuition.
  assert (forall a0 : A, evalDist c a0 == evalDist (ret a) a0).
  intuition.
  case_eq (eqb a a0); intuition.
  rewrite eqb_leibniz in H2.
  subst.
  simpl.
  destruct (EqDec_dec eqd a0 a0); intuition.

  simpl.
  assert (evalDist c a0 == 0).
  eapply evalDist_1_0; intuition.
  eapply H0.
  subst.
  rewrite eqb_refl in H2.
  discriminate.
  rewrite H3.
  destruct ( EqDec_dec eqd a a0); subst; intuition.
  rewrite eqb_refl in H2.
  discriminate.

  intuition.
  simpl in *.

  eapply Permutation_length_1_inv.
  eapply Permutation_sym.
  trivial.

Qed.

Theorem evalDist_bool_equiv_all :
  forall (c1 c2 : Comp bool),
    well_formed_comp c1 ->
    well_formed_comp c2 ->
    Pr[c1] == Pr[c2] ->
    (forall b, evalDist c1 b == evalDist c2 b).

  intuition.
  destruct b.
  trivial.

  rewrite evalDist_complement.
  rewrite evalDist_complement.
  eapply ratSubtract_eqRat_compat; intuition.
  trivial.
  trivial.
Qed.

Require Import Coq.Classes.RelationClasses.
Require Import Coq.Classes.Morphisms.

Class RatRel (R : Rat -> Rat -> Prop) :=
{
  refl : forall r1 r2, r1 == r2 -> R r1 r2;
  trans : Transitive R;
  add_proper : Proper (R ==> R ==> R) ratAdd;
  mult_proper : Proper (R ==> R ==> R) ratMult
}.

#[export] Instance RatRel_trans :
  forall (R : Rat -> Rat -> Prop),
    RatRel R -> Transitive R.

intuition.
destruct H.
intuition.

Qed.

#[export] Instance RatRel_flip :
  forall R,
    RatRel R ->
    RatRel (Basics.flip R).

intuition.
econstructor; intuition.
unfold Basics.flip.
eapply refl.
eapply eqRat_symm.
intuition.

unfold Proper, respectful, Basics.flip in *; intuition.
eapply add_proper; trivial.
unfold Proper, respectful, Basics.flip in *; intuition.
eapply mult_proper; trivial.
Qed.

(* The class includes equality and inequality. *)

#[export] Instance eqRat_RatRel : RatRel eqRat.

econstructor;
eauto with typeclass_instances.

Qed.

#[export] Instance leRat_RatRel : RatRel leRat.

econstructor;
eauto with typeclass_instances.
eapply eqRat_impl_leRat.

Qed.

(* This one comes up some times: *)
#[export] Instance eqRat_RatRel_1 :
  RatRel (fun r r1 : Rat => r1 == r).

eapply RatRel_flip.
intuition.

Qed.

(* some distribution rules that use RatRel *)
Theorem evalDist_left_ident :
  forall rel (B : Set)(eqd : EqDec B)(b : B)(A : Set)(c2 : B -> Comp A) a,
    RatRel rel ->
    rel (evalDist (x <-$ ret b; (c2 x)) a) (evalDist (c2 b) a).

  intuition.
  eapply refl.
  eapply evalDist_left_ident_eq.
Qed.

Theorem evalDist_assoc :
  forall rel (A : Set)(c1 : Comp A)(B C : Set)(c2 : A -> Comp B)(c3 : B -> Comp C) x,
    RatRel rel ->
    rel (evalDist (Bind (Bind c1 c2) c3) x) (evalDist (Bind c1 (fun a => (Bind (c2 a) c3))) x).

  intuition.
  eapply refl.
  eapply evalDist_assoc_eq.

Qed.

Theorem evalDist_commute:
  forall rel  (A B : Set)(c1 : Comp A)(c2 : Comp B)(C : Set)(c3 : A -> B -> Comp C) x,
    RatRel rel ->
    rel (evalDist (a <-$ c1; b <-$ c2; (c3 a b)) x) (evalDist (b <-$ c2; a <-$ c1; (c3 a b)) x).

  intuition.
  eapply refl.
  eapply evalDist_commute_eq.

Qed.

Lemma rel_sumList_compat :
  forall (A : Set)(f1 f2 : A -> Rat) ls rel,
    RatRel rel ->
    (forall a, In a ls -> rel (f1 a) (f2 a)) ->
    rel (sumList ls f1) (sumList ls f2).

  induction ls; intuition; simpl in *.
  unfold sumList; simpl.
  eapply refl.
  intuition.

  eapply trans.
  eapply refl.
  eapply sumList_cons.
  eapply trans.
  2:{
    eapply refl.
    symmetry.
    eapply sumList_cons.
  }
  eapply add_proper.
  intuition.
  eapply IHls; intuition.
Qed.

Lemma rel_seq :
  forall (A B C : Set)(c : Comp A)(f1 : A -> Comp B)(f2 : A -> Comp C) rel x1 x2,
    RatRel rel ->
    (forall a, In a (getSupport c) -> rel (evalDist (f1 a) x1) (evalDist (f2 a) x2)) ->
    rel (evalDist (a <-$ c; f1 a) x1) (evalDist (a <-$ c; f2 a) x2).

  intuition.
  simpl.
  eapply rel_sumList_compat; intuition.
  eapply mult_proper.
  eapply refl.
  intuition.
  intuition.
Qed.

Lemma evalDist_bind_case_split :
  forall rel (B : Set)(e : B -> bool) v v1 v2 (A : Set)(c : Comp B)(f : B -> Comp A)  a,
    RatRel rel ->
    well_formed_comp c ->
    Pr[b <-$ c; ret (e b)] == v ->
    (forall b, (e b) = true -> rel (evalDist (f b) a) v1) ->
    (forall b, (e b) = false -> rel (evalDist (f b) a) v2) ->
    (rel (evalDist (Bind c f) a) (v * v1 + (ratSubtract 1 v) * v2)).

  intuition.
  simpl in *.
  eapply trans.
  eapply refl.
  rewrite (sumList_filter_partition e).
  eapply eqRat_refl.
  eapply add_proper.

  eapply trans.
  eapply (rel_sumList_compat); intuition.
  eapply mult_proper.
  eapply refl.
  eapply eqRat_refl.
  eapply H2.
  eapply filter_In.
  eauto.
  eapply refl.
  rewrite sumList_factor_constant_r.
  eapply ratMult_eqRat_compat; intuition.

  rewrite (sumList_filter_partition e) in H1.
  rewrite <- H1.
  rewrite ratAdd_0_r.
  eapply ratAdd_eqRat_compat.
  eapply sumList_body_eq; intuition.
  rewrite <- ratMult_1_r at 1.
  eapply ratMult_eqRat_compat.
  intuition.
  destruct ( EqDec_dec bool_EqDec (e a0) true); intuition.
  exfalso.
  eapply n.
  eapply filter_In.
  eauto.

  symmetry.
  eapply sumList_0; intuition.
  destruct (EqDec_dec bool_EqDec (e a0) true).
  apply filter_In in H4.
  intuition.
  rewrite e0 in H6.
  simpl in *.
  congruence.
  eapply ratMult_0_r.

  eapply trans.
  eapply (rel_sumList_compat); intuition.
  eapply mult_proper.
  eapply refl.
  eapply eqRat_refl.
  eapply H3.
  eapply filter_In in H4.
  intuition.
  destruct (e a0); intuition.
  eapply refl.
  rewrite sumList_factor_constant_r.
  eapply ratMult_eqRat_compat; intuition.

  rewrite <- H1.
  rewrite <- (@evalDist_lossless _ c); trivial.
  symmetry.
  rewrite (sumList_partition e _ (evalDist c)).
  rewrite ratAdd_comm.
  rewrite ratSubtract_ratAdd_assoc.
  rewrite ratSubtract_0.
  rewrite <- ratAdd_0_r.

  rewrite (sumList_filter_partition e).
  symmetry.
  rewrite ratAdd_0_l.
  eapply ratAdd_eqRat_compat.
  symmetry.
  eapply sumList_0; intuition.
  apply filter_In in H4.
  intuition.
  rewrite H6.
  eapply ratMult_0_r.
  eapply sumList_body_eq; intuition.
  apply filter_In in H4.
  intuition.
  destruct (e a0); simpl in *; try discriminate.
  symmetry.
  eapply ratMult_1_r.
  eapply sumList_le; intuition.
  destruct (EqDec_dec bool_EqDec (e a0) true).
  rewrite e0.
  intuition.
  destruct (e a0); intuition.

  eapply sumList_le; intuition.
  destruct ( EqDec_dec bool_EqDec (e a0) true).
  destruct (e a0); try discriminate.
  intuition.
  destruct (e a0); intuition.
Qed.

Lemma rel_sumList_factor_r :
  forall (A : Set) (f : A -> Rat) (ls : list A) c rel,
    RatRel rel ->
    rel (sumList ls (fun a => (f a) * c)) ((sumList ls f) * c).

  induction ls; intuition; simpl in *.
  unfold sumList; simpl.
  eapply refl.
  symmetry.
  eapply ratMult_0_l.

  eapply trans.
  eapply refl.
  eapply sumList_cons.
  eapply trans.
  2:{
    eapply refl.
    symmetry.
    eapply eqRat_trans.
    eapply ratMult_eqRat_compat.
    eapply sumList_cons.
    eapply eqRat_refl.
    eapply ratMult_distrib_r.
  }
  eapply add_proper.
  eapply refl.
  intuition.
  eapply IHls; intuition.
Qed.

Theorem evalDist_irr_l :
  forall (A B : Set)(c : Comp A)(f : A -> Comp B)(y : B) rel v,
    RatRel rel ->
    well_formed_comp c ->
    (forall x, In x (getSupport c) -> rel (evalDist (f x) y) v) ->
    rel (evalDist (Bind c f) y) v.

  intuition.
  simpl.
  eapply trans.
  eapply rel_sumList_compat;
  intuition.
  eapply mult_proper.
  eapply refl.
  eapply eqRat_refl.
  eapply H1.
  trivial.

  specialize (rel_sumList_factor_r (evalDist c) (getSupport c) v H); intuition.

  eapply trans.
  eapply H2.
  eapply refl.
  rewrite evalDist_lossless.
  eapply ratMult_1_l.
  trivial.
Qed.

Lemma rel_sumList_factor_r_r :
  forall (A : Set) (f : A -> Rat) (ls : list A) c rel,
    RatRel rel ->
    rel ((sumList ls f) * c) (sumList ls (fun a => (f a) * c)).

  induction ls; intuition; simpl in *.
  unfold sumList; simpl.
  eapply refl.
  eapply ratMult_0_l.

  eapply trans.
  eapply refl.
  eapply eqRat_trans.
  eapply ratMult_eqRat_compat.
  eapply sumList_cons.
  eapply eqRat_refl.
  eapply ratMult_distrib_r.

  eapply trans.
  2:{
    eapply refl.
    symmetry.
    eapply sumList_cons.
  }
  simpl.
  eapply add_proper.
  eapply refl.
  intuition.
  eapply IHls; intuition.
Qed.

Theorem evalDist_irr_r :
  forall (A B : Set)(c : Comp A)(f : A -> Comp B)(y : B) rel v,
    RatRel rel ->
    well_formed_comp c ->
    (forall x, In x (getSupport c) -> rel v (evalDist (f x) y)) ->
    rel v (evalDist (Bind c f) y).

  intuition.
  simpl.
  eapply trans.
  2:{
    eapply rel_sumList_compat;
    intuition.
    eapply mult_proper.
    eapply refl.
    eapply eqRat_refl.
    eapply H1.
    trivial.
  }

  specialize (rel_sumList_factor_r_r (evalDist c) (getSupport c) v H); intuition.

  eapply trans.
  2:{
    eapply H2.
  }
  eapply refl.
  rewrite evalDist_lossless.
  symmetry.
  eapply ratMult_1_l.
  trivial.
Qed.

Theorem evalDist_iso :
  forall rel (A B C D : Set) (f : C -> D) (f_inv : D -> C)
    (d : Comp D) (c : Comp C) (f1 : D -> Comp B)
    (f2 : C -> Comp A) (a : A) (b : B),
    RatRel rel ->
    (forall x : D, In x (getSupport d) -> f (f_inv x) = x) ->
    (forall x : C, In x (getSupport c) -> f_inv (f x) = x) ->
    (forall x : D, In x (getSupport d) -> In (f_inv x) (getSupport c)) ->
    (forall x : C, In x (getSupport c) -> evalDist d (f x) == evalDist c x) ->
    (forall x : C,
      In x (getSupport c) -> rel (evalDist (f1 (f x)) b) (evalDist (f2 x) a)) ->
    rel (evalDist (x <-$ d; f1 x) b) (evalDist (x <-$ c; f2 x) a).

  intuition.
  eapply trans.
  eapply refl.
  eapply (distro_iso_eq); intros.
  eapply H0.
  trivial.
  eapply H1.
  eauto.
  eapply H2.
  eauto.

  eapply H3.
  trivial.
  eapply eqRat_refl.

  eapply rel_seq;
  intuition.

Qed.

Theorem evalDist_seq :
forall rel (A1 A2 B : Set) (c1 c2 : Comp B) (f1 : B -> Comp A1)(f2 : B -> Comp A2) y z,
  RatRel rel ->
  (forall x : B, evalDist c1 x == evalDist c2 x) ->
  (forall x : B,
    In x (getSupport c1) -> rel (evalDist (f1 x) y) (evalDist (f2 x) z)) ->
  rel (evalDist (x <-$ c1; f1 x) y) (evalDist (x <-$ c2; f2 x) z).

  intuition.
  eapply (evalDist_iso (fun b => b)(fun b => b)); intuition.

  eapply getSupport_In_evalDist.
  intuition.
  eapply getSupport_In_evalDist.
  eauto.
  rewrite H0.
  trivial.
  eapply H1.
  eapply getSupport_In_evalDist.
  intuition.
  eapply getSupport_In_evalDist.
  eauto.
  rewrite <- H0.
  trivial.

Qed.

Theorem oc_comp_invariant :
  forall (A B C : Set)(c : OracleComp A B C)(S : Set)(P : S -> Prop)
    (eqds : EqDec S)
    (o : S -> A -> Comp (B * S))(s : S),
    (forall a b c d, In (a, b) (getSupport (o c d)) -> P c -> P b) ->
      P s ->
      forall a b, In (a, b) (getSupport (c _ _ o s)) -> P b.

  Opaque getSupport.
  induction c; intuition; simpl in *.
  eapply H; eauto.

  Transparent getSupport.
  repeat simp_in_support.
  destruct x.
  simpl in *.

  specialize (IHc (S * S0) (fun x => P (snd x)) _
  (fun (x : S * S0) (y : A) =>
                p <-$ (o (fst x) y) S0 eqds o0 (snd x);
                ret (fst (fst p), (snd (fst p), snd p))) (s, s0))%type.
  eapply IHc; intros.
  3:{
    eapply H3.
  }
  repeat simp_in_support.
  simpl.
  destruct c1.
  destruct x.
  eapply H.
  eapply H0.
  eapply H4.
  eapply H5.
  trivial.

  repeat simp_in_support.
  trivial.

  repeat simp_in_support.
  destruct x.
  eapply H.
  eapply H0.
  eapply IHc.
  eapply H0.
  eapply H1.
  eauto.
  eauto.
Qed.

Theorem oc_comp_invariant_f :
  forall (A B C : Set)(c : OracleComp A B C)(S : Set)(f : S -> bool)
    (eqds : EqDec S)
    (o : S -> A -> Comp (B * S))(s : S),
    (forall a b c d, In (a, b) (getSupport (o c d)) -> f c = true -> f b = true) ->
    f s = true ->
    forall a b, In (a, b) (getSupport (c _ _ o s)) -> f b = true.

  intuition.
  eapply (@oc_comp_invariant _ _ _ _ _ (fun x => f x = true)); intuition.
  eapply H.
  eapply H2.
  eapply H3.
  eapply H0.
  eapply H1.
Qed.

Theorem distro_irr_le
     : forall (A B : Set) (c : Comp A) (f : A -> Comp B)
         (y : B) (v : Rat),
       (forall x : A, In x (getSupport c) -> (evalDist (f x) y) <=  v) ->
       (evalDist (x <-$ c; f x) y)  <= v.

  intuition.
  simpl.
  rewrite sumList_le.
  2:{
    intuition.
    rewrite H at 1.
    eapply leRat_refl.
    trivial.
  }
  rewrite sumList_factor_constant_r.
  eapply leRat_trans.
  eapply ratMult_leRat_compat.
  eapply evalDist_sum_le_1.
  eapply leRat_refl.
  rewrite ratMult_1_l.
  intuition.
Qed.

Theorem oc_comp_wf :
  forall (A B C : Set)(c : OracleComp A B C),
    well_formed_oc c ->
    forall (S : Set)(eqds : EqDec S)(o : S -> A -> Comp (B * S))(s : S),
      (forall a b, well_formed_comp (o a b)) ->
      well_formed_comp (c _ _ o s).

  induction 1; intuition; simpl in *; intuition.
  eapply well_formed_Bind; intuition.

  eapply IHwell_formed_oc; intuition.
  eapply well_formed_Bind; intuition.
  eapply well_formed_Ret.
  eapply well_formed_Ret.

  eapply well_formed_Bind; intuition.
  eapply well_formed_Ret.

  eapply well_formed_Bind; intuition.
  destruct b.
  eauto.

Qed.

Theorem repeat_fission :
  forall (A B : Set)(eqda : EqDec A)(eqdb : EqDec B)(c : Comp A)(P : A -> bool)(f : A -> Comp B) x,
    well_formed_comp c ->
    (exists a, In a (filter P (getSupport c))) ->
    (forall a, In a (getSupport c) -> well_formed_comp (f a)) ->
    evalDist (a <-$ Repeat c P; b <-$ f a; ret (a, b)) x ==
    evalDist
      (Repeat (a <-$ c; b <-$ f a; ret (a, b)) (fun p => P (fst p))) x.

  intuition.

  case_eq (P a); intuition.

  simpl.
  symmetry.
  rewrite <- sumList_factor_constant_l.

  symmetry.
  rewrite (@sumList_subset' A (EqDec_dec _ ) _ (getSupport c)).

  eapply sumList_body_eq; intuition.
  unfold indicator.
  simpl.
  rewrite H2.
  case_eq (P a0); intuition.
  repeat rewrite ratMult_1_l.
  rewrite <- ratMult_assoc.
  eapply ratMult_eqRat_compat; intuition.
  eapply ratMult_eqRat_compat; intuition.
  eapply ratInverse_eqRat_compat.
  eapply sumList_nz.
  econstructor; intuition.
  eapply filter_In; intuition; eauto.
  eapply getSupport_In_evalDist;
  eauto.

  symmetry.

  assert ((getUnique
           (flatten
              (map
                 (fun b0 : A =>
                  getUnique
                    (flatten
                       (map (fun b1 : B => (b0, b1) :: nil)
                          (getSupport (f b0))))
                    (bind_eq_dec (f b0) (fun b1 : B => ret (b0, b1))))
                 (getSupport c)))
           (bind_eq_dec c (fun a1 : A => b0 <-$ f a1; ret (a1, b0)))) =
           (flatten
              (map
                 (fun b0 : A =>
                    (map (fun b1 : B => (b0, b1))
                         (getSupport (f b0))))
                 (getSupport c)))).

  rewrite DetSem.getUnique_NoDup_eq.
  f_equal.
  eapply map_ext; intuition.

  rewrite flatten_map_eq.
  rewrite DetSem.getUnique_NoDup_eq.
  intuition.

  eapply map_NoDup; intuition.
  assert (snd (a1, a2) = a2).
  trivial.
  eauto.
  eapply getSupport_NoDup.

  eapply flatten_NoDup;
    intuition.

  eapply map_NoDup'; intuition.
  eapply getSupport_NoDup.

  repeat rewrite flatten_map_eq in *.

  edestruct (@well_formed_val_exists _ (f a1)).
  intuition.

  eapply (getUnique_eq_inv (a1, x)) in H8.
  apply in_map_iff in H8.
  destruct H8.
  intuition.
  pairInv.
  intuition.
  eapply in_map_iff.
  econstructor.
  intuition.

  apply in_map_iff in H5.
  destruct H5.
  intuition.
  subst.
  eapply getUnique_NoDup.

  eapply in_map_iff in H5.
  destruct H5.
  intuition.
  eapply in_map_iff in H6.
  destruct H6.
  intuition.
  subst.
  repeat rewrite flatten_map_eq in *.
  eapply app_NoDup; intuition.
  eapply getUnique_NoDup.
  eapply getUnique_NoDup.

  apply in_getUnique_if in H5.
  apply in_getUnique_if in H6.
  apply in_map_iff in H5.
  apply in_map_iff in H6.
  destruct H5.
  destruct H6.
  intuition.
  subst.
  pairInv.
  intuition.

  apply in_getUnique_if in H5.
  apply in_getUnique_if in H6.
  apply in_map_iff in H5.
  apply in_map_iff in H6.
  destruct H5.
  destruct H6.
  intuition.
  subst.
  pairInv.
  intuition.

  rewrite H5.
  clear H5.

  rewrite sumList_filter_twice.
  eapply sumList_body_eq; intuition.
  apply filter_In in H5; intuition.
  eapply eqRat_trans.
  eapply sumList_body_eq; intuition.
  rewrite (@sumList_exactly_one _ a1) at 1.
  eapply eqRat_refl.
  eapply getSupport_NoDup.
  intuition.
  intuition.
  eapply eqRat_trans.
  eapply ratMult_eqRat_compat.
  eapply eqRat_refl.
  eapply sumList_0; intuition.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (b0, a3) (a1, a2)).
  pairInv.
  intuition.
  eapply ratMult_0_r.
  eapply ratMult_0_r.
  eapply eqRat_trans.
  eapply sumList_body_eq; intuition.
  eapply ratMult_eqRat_compat.
  eapply eqRat_refl.
  eapply (@sumList_exactly_one _ a2); intuition.
  eapply getSupport_NoDup.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (a1, b0) (a1, a2)).
  pairInv.
  intuition.
  eapply ratMult_0_r.

  rewrite sumList_factor_constant_l.
  symmetry.
  rewrite <- ratMult_1_r at 1.
  eapply ratMult_eqRat_compat; intuition.
  symmetry.
  eapply eqRat_trans.
  eapply sumList_body_eq; intuition.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (a1, a2) (a1, a2)).
  eapply ratMult_1_r.
  congruence.
  eapply evalDist_lossless.
  intuition.

  repeat rewrite ratMult_0_l.
  symmetry.
  rewrite ratMult_1_l.
  eapply eqRat_trans.
  eapply ratMult_eqRat_compat.
  eapply eqRat_refl.
  eapply ratMult_eqRat_compat.
  eapply eqRat_refl.
  eapply sumList_0; intuition.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (a0, a1) (a, b)).
  pairInv.
  congruence.
  eapply ratMult_0_r.
  repeat rewrite ratMult_0_r.
  intuition.
  eapply filter_NoDup.
  eapply getSupport_NoDup.
  eapply getSupport_NoDup.

  intuition.
  apply filter_In in H3; intuition.

  intuition.
  unfold indicator.
  case_eq (P a0); intuition.
  exfalso.
  eapply H4.
  eapply filter_In; intuition.
  repeat rewrite ratMult_0_l.
  intuition.

  destruct H0.
  eapply evalDist_irr_l; intuition.
  eapply well_formed_Repeat.
  unfold eq_dec; intuition.
  eapply (EqDec_dec _).
  trivial.
  eauto.

  eapply evalDist_irr_l; intuition.
  simpl in *.
  apply filter_In in H3.
  intuition.

  simpl in *.
  apply filter_In in H3.
  intuition.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (x0, x1) (a, b)).
  pairInv.
  congruence.

  unfold indicator.
  simpl.
  rewrite H2.
  repeat rewrite ratMult_0_l.
  intuition.
Qed.

Lemma evalDistRepeat_sup_0 :
  forall (A : Set)(c : Comp A)(P : A -> bool) x,
    evalDist c x == 0 ->
    evalDist (Repeat c P) x == 0.

  intuition.
  simpl.
  rewrite H.
  rewrite ratMult_0_r.
  intuition.

Qed.

Lemma evalDistRepeat_pred_0 :
  forall (A : Set)(c : Comp A)(P : A -> bool) x,
    P x = false ->
    evalDist (Repeat c P) x == 0.

  intuition.
  simpl.
  unfold indicator.
  rewrite H.
  repeat rewrite ratMult_0_l.
  intuition.

Qed.

Theorem repeat_snd_equiv :
  forall (A B : Set)(eqd : EqDec B)(c : Comp (A * B))(P : B -> bool) x,
    evalDist (p <-$ Repeat c (fun p => P (snd p)); ret (snd p)) x ==
    evalDist (Repeat (p <-$ c; ret (snd p)) P) x.

  intuition.

  simpl.
  case_eq (P x); intuition.

  unfold indicator.
  rewrite H.
  rewrite ratMult_1_l.
  rewrite <- sumList_factor_constant_l.

  symmetry.
  rewrite (sumList_filter_partition (fun p : A * B => P (snd p))).
  symmetry.
  rewrite ratAdd_0_r.
  eapply ratAdd_eqRat_compat.
  eapply sumList_body_eq; intuition.
  apply filter_In in H0; intuition.
  rewrite H2.
  destruct (EqDec_dec eqd (snd a) x).
  rewrite ratMult_1_l.
  repeat rewrite ratMult_1_r.
  eapply ratMult_eqRat_compat; intuition.

  rewrite flatten_map_eq.
  eapply ratInverse_eqRat_compat.
  intuition.
  destruct a.
  simpl in *.
  subst.
  eapply sumList_nz; eauto.
  exists (a, x).
  intuition.
  eapply filter_In; intuition.
  eapply getSupport_In_evalDist; eauto.

  rewrite sumList_comm.
  symmetry.
  rewrite (sumList_filter_partition (fun p : A * B => P (snd p))).
  symmetry.
  rewrite ratAdd_0_r.
  eapply ratAdd_eqRat_compat.
  eapply sumList_body_eq; intuition.
  apply filter_In in H0; intuition.
  rewrite sumList_factor_constant_l.
  rewrite <- ratMult_1_r at 1.
  eapply ratMult_eqRat_compat; intuition.
  symmetry.
  destruct a0.
  simpl in *.
  rewrite (@sumList_exactly_one _ b).
  destruct (EqDec_dec eqd b b); intuition.
  eapply filter_NoDup.
  eapply getUnique_NoDup.
  eapply filter_In; intuition.
  eapply in_getUnique.
  eapply in_map_iff.
  econstructor. split; eauto.
  simpl.
  trivial.

  intuition.
  destruct (EqDec_dec eqd b b0); subst; intuition.

  symmetry.
  eapply sumList_0.
  intuition.
  eapply sumList_0; intuition.
  apply filter_In in H3; intuition.
  apply filter_In in H0; intuition.
  destruct a0.
  simpl in *.
  destruct (EqDec_dec eqd b a1); subst.
  destruct (P a1); simpl in *; discriminate.
  eapply ratMult_0_r.

  repeat rewrite ratMult_0_r.
  intuition.

  symmetry.
  eapply sumList_0; intuition.
  eapply filter_In in H0; intuition.
  destruct (EqDec_dec eqd (snd a) x); subst.
  destruct (P (snd a)); simpl in *; discriminate.

  repeat rewrite ratMult_0_r.
  intuition.

  unfold indicator.
  rewrite H.
  repeat rewrite ratMult_0_l.
  eapply sumList_0; intuition.
  apply filter_In in H0.
  intuition.
  rewrite H2.
  rewrite ratMult_1_l.
  destruct a.
  simpl in *.
  destruct (EqDec_dec eqd b x); subst; try congruence.
  rewrite ratMult_0_r.
  intuition.

Qed.

Theorem repeat_fst_equiv :
  forall (A B : Set)(eqd : EqDec A)(c : Comp (A * B))(P : A -> bool) x,
    evalDist (p <-$ Repeat c (fun p => P (fst p)); ret (fst p)) x ==
    evalDist (Repeat (p <-$ c; ret (fst p)) P) x.

  intuition.

  simpl.
  case_eq (P x); intuition.

  unfold indicator.
  rewrite H.
  rewrite ratMult_1_l.
  rewrite <- sumList_factor_constant_l.

  symmetry.
  rewrite (sumList_filter_partition (fun p : A * B => P (fst p))).
  symmetry.
  rewrite ratAdd_0_r.
  eapply ratAdd_eqRat_compat.
  eapply sumList_body_eq; intuition.
  apply filter_In in H0; intuition.
  rewrite H2.
  destruct (EqDec_dec eqd (fst a) x).
  rewrite ratMult_1_l.
  repeat rewrite ratMult_1_r.
  eapply ratMult_eqRat_compat; intuition.

  rewrite flatten_map_eq.
  eapply ratInverse_eqRat_compat.
  intuition.
  destruct a.
  simpl in *.
  subst.
  eapply sumList_nz; eauto.
  exists (x, b).
  intuition.
  eapply filter_In; intuition.
  eapply getSupport_In_evalDist; eauto.

  rewrite sumList_comm.
  symmetry.
  rewrite (sumList_filter_partition (fun p : A * B => P (fst p))).
  symmetry.
  rewrite ratAdd_0_r.
  eapply ratAdd_eqRat_compat.
  eapply sumList_body_eq; intuition.
  apply filter_In in H0; intuition.
  rewrite sumList_factor_constant_l.
  rewrite <- ratMult_1_r at 1.
  eapply ratMult_eqRat_compat; intuition.
  symmetry.
  destruct a0.
  simpl in *.
  rewrite (@sumList_exactly_one _ a0).
  destruct (EqDec_dec eqd a0 a0); intuition.
  eapply filter_NoDup.
  eapply getUnique_NoDup.
  eapply filter_In; intuition.
  eapply in_getUnique.
  eapply in_map_iff.
  econstructor. split; eauto.
  simpl.
  trivial.

  intuition.
  destruct (EqDec_dec eqd a0 b0); subst; intuition.

  symmetry.
  eapply sumList_0.
  intuition.
  eapply sumList_0; intuition.
  apply filter_In in H3; intuition.
  apply filter_In in H0; intuition.
  destruct a0.
  simpl in *.
  destruct (EqDec_dec eqd a0 a1); subst.
  destruct (P a1); simpl in *; discriminate.
  eapply ratMult_0_r.

  repeat rewrite ratMult_0_r.
  intuition.

  symmetry.
  eapply sumList_0; intuition.
  eapply filter_In in H0; intuition.
  destruct (EqDec_dec eqd (fst a) x); subst.
  destruct (P (fst a)); simpl in *; discriminate.

  repeat rewrite ratMult_0_r.
  intuition.

  unfold indicator.
  rewrite H.
  repeat rewrite ratMult_0_l.
  eapply sumList_0; intuition.
  apply filter_In in H0.
  intuition.
  rewrite H2.
  rewrite ratMult_1_l.
  destruct a.
  simpl in *.
  destruct (EqDec_dec eqd a x); subst; try congruence.
  rewrite ratMult_0_r.
  intuition.

Qed.

Theorem repeat_fission' :
  forall (A B : Set)(eqda : EqDec A)(eqdb : EqDec B)(c : Comp A)(P1 : A -> bool)(P2 : B -> bool)(f : A -> Comp B) x,
    well_formed_comp c ->
    (exists a, In a (filter P1 (getSupport c))) ->
    (forall a, In a (getSupport c) -> well_formed_comp (f a)) ->
    (forall a b, In a (getSupport c) -> In b (getSupport (f a)) -> (P1 a = P2 b)) ->
    evalDist (a <-$ Repeat c P1; f a) x ==
    evalDist
      (Repeat (a <-$ c; f a) P2) x.

  intuition.

  assert (evalDist (a <-$ Repeat c P1; f a) x  ==
          evalDist (z <-$ (a <-$ Repeat c P1; b <-$ f a; ret (a, b)); ret (snd z)) x).

  rewrite evalDist_assoc.
  eapply evalDist_seq_eq; intuition.
  rewrite evalDist_assoc.
  rewrite <- evalDist_right_ident.
  eapply evalDist_seq_eq; intuition.
  rewrite evalDist_left_ident.
  simpl.
  reflexivity.
  intuition.
  intuition.
  intuition.

  rewrite H3.
  clear H3.

  assert (evalDist (z <-$ (a <-$ Repeat c P1; b <-$ f a; ret (a, b)); ret snd z) x ==
          evalDist (z <-$ (Repeat (a <-$ c; b <-$ f a; ret (a, b)) (fun p => P1 (fst p))); ret snd z) x).

  eapply evalDist_seq_eq; intuition.
  eapply repeat_fission; intuition.
  rewrite H3.
  clear H3.

  assert (evalDist
     (z <-$
      Repeat (a <-$ c; b <-$ f a; ret (a, b)) (fun p : A * B => P1 (fst p));
      ret snd z) x ==
          evalDist
     (z <-$
      Repeat (a <-$ c; b <-$ f a; ret (a, b)) (fun p : A * B => P2 (snd p));
      ret snd z) x).

  eapply evalDist_seq_eq; intuition.
  destruct (in_dec (EqDec_dec _ ) a (getSupport c)).
  destruct (in_dec (EqDec_dec _) b (getSupport (f a))).
  case_eq (P1 a); intuition.

  eapply evalDist_Repeat_eq; intuition.
  eapply filter_In; intuition.
  eapply getSupport_In_Seq; eauto.
  eapply getSupport_In_Seq; eauto.
  simpl; intuition.

  eapply sumList_permutation.
  eapply NoDup_Permutation; intuition.
  eapply filter_NoDup.
  eapply getSupport_NoDup.
  eapply filter_NoDup.
  eapply getSupport_NoDup.

  apply filter_In in H4.
  intuition.
  repeat simp_in_support.
  eapply filter_In; intuition.
  eapply getSupport_In_Seq; eauto.
  eapply getSupport_In_Seq; eauto.
  simpl.
  intuition.
  simpl in *.
  erewrite <- H2; eauto.

  apply filter_In in H4.
  intuition.
  repeat simp_in_support.
  eapply filter_In; intuition.
  eapply getSupport_In_Seq; eauto.
  eapply getSupport_In_Seq; eauto.
  simpl.
  intuition.
  simpl in *.
  erewrite H2; eauto.

  assert (P2 b = false).
  erewrite <- H2; eauto.

  repeat rewrite evalDistRepeat_pred_0; intuition.

  repeat rewrite evalDistRepeat_sup_0; intuition;
  eapply getSupport_not_In_evalDist; intuition;
  repeat simp_in_support; intuition.

  repeat rewrite evalDistRepeat_sup_0; intuition;
  eapply getSupport_not_In_evalDist; intuition;
  repeat simp_in_support; intuition.

  rewrite H3.
  clear H3.

  rewrite repeat_snd_equiv.

  (* The following fact comes up a couple times. *)
  assert (forall a,
             evalDist (p <-$ (a0 <-$ c; b <-$ f a0; ret (a0, b)); ret snd p) a ==
   evalDist (a0 <-$ c; f a0) a).
  intuition.
  rewrite evalDist_assoc; intuition.
  eapply evalDist_seq_eq; intuition.
  rewrite evalDist_assoc; intuition.
  symmetry.
  rewrite <- evalDist_right_ident.
  eapply evalDist_seq_eq; intuition.
  rewrite evalDist_left_ident; intuition.
  simpl.
  reflexivity.

  case_eq (P2 x); intuition.
  destruct (in_dec (EqDec_dec _) x (getSupport (Bind c f))).
  eapply evalDist_Repeat_eq; intuition.

  eapply filter_In; intuition.
  repeat simp_in_support.
  eapply getSupport_In_Seq.
  eapply getSupport_In_Seq; eauto.
  eapply getSupport_In_Seq; eauto.
  simpl.
  intuition.
  simpl.
  intuition.

  rewrite sumList_permutation.
  2:{
    eapply (evalDist_getSupport_filter_perm _ (a <-$ c; f a)); intuition.
  }

  eapply sumList_body_eq; intuition.

  repeat rewrite evalDistRepeat_sup_0; intuition;
  eapply getSupport_not_In_evalDist; intuition;
  repeat simp_in_support; intuition.
  eapply n.
  eapply getSupport_In_Seq; eauto.

  repeat rewrite evalDistRepeat_pred_0; intuition.
Qed.

Theorem prob_or_le_sum :
  forall (c1 c2 : Comp bool),
    Pr[x1 <-$ c1;
        x2 <-$ c2;
        ret (x1 || x2)] <= Pr[c1] + Pr[c2].

  intuition.
  Local Transparent evalDist.
  simpl.
  rewrite (sumList_partition (fun x => x)).
  eapply ratAdd_leRat_compat.

  eapply leRat_trans.
  2:{
    eapply eqRat_impl_leRat.
    eapply evalDist_right_ident.
  }
  simpl.
  eapply sumList_le.
  intuition.
  destruct a; simpl.
  destruct (EqDec_dec bool_EqDec true true).
  rewrite ratMult_1_r.
  eapply ratMult_leRat_compat; intuition.
  eapply leRat_trans.
  eapply sumList_le.
  intros.
  eapply eqRat_impl_leRat.
  eapply ratMult_1_r.
  eapply evalDist_sum_le_1.

  intuition.

  rewrite ratMult_0_r.
  eapply rat0_le_all.

  eapply leRat_trans.
  2:{
    eapply eqRat_impl_leRat.
    eapply evalDist_right_ident.
  }
  simpl.
  eapply leRat_trans.
  eapply sumList_le.
  intros.
  eapply eqRat_impl_leRat.
  eapply eqRat_trans.
  eapply ratMult_eqRat_compat.
  symmetry.
  eapply sumList_factor_constant_l.
  reflexivity.
  symmetry.
  eapply sumList_factor_constant_r.
  rewrite sumList_summation.
  eapply sumList_le.
  intuition.
  destruct a.
  destruct (EqDec_dec bool_EqDec true true); intuition.

  eapply leRat_trans.
  eapply eqRat_impl_leRat.
  eapply sumList_body_eq.
  intros.
  rewrite orb_true_r.
  destruct ( EqDec_dec bool_EqDec true true).
  rewrite ratMult_1_r at 1.
  rewrite ratMult_assoc at 1.
  rewrite ratMult_comm at 1.
  eapply ratMult_assoc.
  intuition.
  rewrite sumList_factor_constant_l.
  eapply ratMult_leRat_compat.
  intuition.
  eapply leRat_trans.
  eapply sumList_le.
  intros.
  assert ( (if a then 0 else 1) * evalDist c1 a <= evalDist c1 a).
  eapply leRat_trans.
  2:{
    eapply eqRat_impl_leRat.
    eapply ratMult_1_l.
  }
  eapply ratMult_leRat_compat.
  destruct a;
    intuition.
  reflexivity.
  eapply H1.
  eapply evalDist_sum_le_1.

  destruct ( EqDec_dec bool_EqDec false true).
  discriminate.
  eapply leRat_trans.
  eapply eqRat_impl_leRat.
  eapply sumList_0.
  intuition.
  destruct a; simpl.
  repeat rewrite ratMult_0_r.
  intuition.
  destruct (EqDec_dec bool_EqDec false true ); try discriminate.
  repeat rewrite ratMult_0_r.
  eapply ratMult_0_l.

  eapply rat0_le_all.
Qed.

Theorem evalDist_orb_le :
  forall (A : Set)(c : Comp A) f1 f2,
    Pr [x <-$ c; ret (f1 x || f2 x)] <=
    Pr[ x <-$ c; ret (f1 x)] + Pr[x <-$ c; ret (f2 x)].

  intuition.
  simpl.
  rewrite (sumList_partition f1).
  eapply ratAdd_leRat_compat.

  eapply sumList_le.
  intuition.
  rewrite ratMult_assoc.
  eapply ratMult_leRat_compat; intuition.
  destruct (f1 a); simpl.
  rewrite ratMult_1_r.
  reflexivity.
  rewrite ratMult_0_r.
  eapply rat0_le_all.

  eapply sumList_le.
  intuition.
  rewrite ratMult_assoc.
  eapply ratMult_leRat_compat; intuition.
  destruct (f1 a); simpl.
  rewrite ratMult_0_r.
  eapply rat0_le_all.
  rewrite ratMult_1_r.
  reflexivity.

Qed.

Theorem evalDist_seq_eq_trans : forall (A B : Set) c1 c2 (f : A -> Comp B),
  (forall x, evalDist c1 x == evalDist c2 x) ->
  (forall x, evalDist (Bind c1 f) x == evalDist (Bind c2 f) x).

  intros.
  eapply evalDist_seq_eq; intuition idtac.
  reflexivity.

Qed.

Theorem evalDist_comp_equal : forall (A : Set)(c1 c2 : Comp A) x,
  c1 = c2 ->
  evalDist c1 x == evalDist c2 x.

  intros; subst; reflexivity.

Qed.

Theorem combine_app : forall (A B : Type) (lsa1 lsa2 : list A) (lsb1 lsb2 : list B),
  length lsa1 = length lsb1 ->
  combine (lsa1 ++ lsa2) (lsb1 ++ lsb2) =
  (combine lsa1 lsb1) ++ (combine lsa2 lsb2).

  induction lsa1; destruct lsb1; intros; simpl in *; try discriminate.
  reflexivity.
  f_equal.
  eapply IHlsa1.
  lia.

Qed.

Theorem combine_cons : forall (A B : Type) a1 (lsa2 : list A) b1 (lsb2 : list B),
  combine (a1 :: lsa2) (b1 ::lsb2) =
  (a1, b1) :: (combine lsa2 lsb2).

  intuition idtac.

Qed.

Theorem map_cons : forall (A B : Type)(f : A -> B) a ls,
  map f (a :: ls) = (f a) :: (map f ls).

  intuition idtac.

Qed.

Theorem Repeat_body_eq : forall (A : Set) (eqda : EqDec A)(c1 c2 : Comp A) f,
  (forall x, evalDist c1 x == evalDist c2 x) ->
  (forall x, evalDist (Repeat c1 f) x == evalDist (Repeat c2 f) x).

  intros.
  destruct (in_dec (EqDec_dec _) x (getSupport c1)).
  case_eq (f x); intuition idtac.
  eapply evalDist_Repeat_eq; intuition idtac.
  eauto.
  eapply filter_In; intuition idtac.
  erewrite sumList_permutation.
  eapply sumList_body_eq.
  intuition idtac.
  eauto.
  apply evalDist_getSupport_filter_perm; intuition idtac.
  eauto.

  repeat rewrite evalDistRepeat_pred_0; intuition idtac.
  reflexivity.
  repeat rewrite evalDistRepeat_sup_0; intuition idtac.
  reflexivity.
  rewrite <- H.
  eapply getSupport_not_In_evalDist_h; eauto.
  eapply getSupport_not_In_evalDist_h; eauto.

Qed.

Theorem repeat_fission_indep : forall (A B : Set)(eqda : EqDec A)(eqdb : EqDec B)(c1 : Comp A)(c2 : Comp B) P1 P2 y,
  evalDist (Repeat (a <-$ c1; b <-$ c2; ret (a, b)) (fun x => (P1 (fst x)) && (P2 (snd x)))) y  ==
  evalDist (a <-$ (Repeat c1 P1); b <-$ (Repeat c2 P2); ret (a, b)) y.

  intros.
  simpl.
  rewrite <- sumList_factor_constant_l.
  rewrite (sumList_filter_partition P1).
  symmetry.
  rewrite ratAdd_0_r.
  apply ratAdd_eqRat_compat.

  apply sumList_body_eq.
  intros.
  repeat rewrite <- sumList_factor_constant_l.
  symmetry.
  rewrite (sumList_filter_partition P2).
  symmetry.
  rewrite ratAdd_0_r.
  apply ratAdd_eqRat_compat.

  apply sumList_body_eq.
  intros.
  apply filter_In in H.
  apply filter_In in H0.
  intuition idtac.
  unfold indicator.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (a, a0) (a1, b)).
  pairInv. simpl.
  rewrite H2. rewrite H3.
  repeat rewrite ratMult_1_l.
  repeat rewrite ratMult_1_r.
  repeat rewrite <- ratMult_assoc.
  apply ratMult_eqRat_compat; intuition idtac.
  rewrite ratMult_comm.
  rewrite <- ratMult_assoc.
  apply ratMult_eqRat_compat; intuition idtac.
  rewrite <- ratInverse_ratMult.
  eapply ratInverse_eqRat_compat.
  intuition idtac.
  apply ratMult_0 in H0.
  intuition idtac.
  rewrite sumList_0 in H4.
  eapply getSupport_In_evalDist.
  eauto.
  eapply H4.
  eapply filter_In; intuition idtac.
  rewrite sumList_0 in H4.
  eapply getSupport_In_evalDist.
  eapply H1.
  eapply H4.
  eapply filter_In; intuition idtac.

  symmetry.
  eapply eqRat_trans.
  eapply sumList_body_eq.
  intros.
  apply filter_In in H0.
  intuition idtac.
  eapply eqRat_trans.
  eapply (sumList_filter_partition P1).
  eapply eqRat_trans.
  eapply ratAdd_eqRat_compat.
  eapply sumList_body_eq.
  intros.
  eapply ratMult_eqRat_compat.
  reflexivity.
  eapply (sumList_filter_partition P2).
  eapply sumList_0.
  intros.
  eapply eqRat_trans.
  eapply ratMult_eqRat_compat.
  reflexivity.
  eapply sumList_0.
  intros.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (a0, a2) a).
  subst.
  eapply filter_In in H0.
  intuition idtac. simpl in *.
  simpl in *.
  rewrite negb_true_iff in H8.
  rewrite H8 in H5.
  discriminate.
  eapply ratMult_0_r.
  apply ratMult_0_r.

  eapply eqRat_trans.
  symmetry.
  eapply ratAdd_0_r.
  eapply sumList_body_eq.
  intros.
  eapply ratMult_eqRat_compat.
  reflexivity.
  eapply eqRat_trans.
  eapply ratAdd_eqRat_compat.
  reflexivity.
  eapply sumList_0.
  intros.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (a0, a2) a); subst.
  apply filter_In in H6.
  intuition idtac.
  simpl in *.
  rewrite negb_true_iff in H8.
  rewrite H8 in H5.
  rewrite andb_false_r in H5.
  discriminate.
  eapply ratMult_0_r.
  symmetry.
  eapply ratAdd_0_r.

  rewrite sumList_comm.
  eapply eqRat_trans.
  eapply sumList_body_eq.
  intros.
  eapply sumList_factor_constant_l.
  eapply eqRat_trans.
  eapply sumList_body_eq.
  intros.
  eapply ratMult_eqRat_compat.
  reflexivity.
  eapply sumList_comm.
  eapply eqRat_trans.
  eapply sumList_body_eq.
  intros.
  eapply ratMult_eqRat_compat.
  reflexivity.
  eapply sumList_body_eq.
  intros.
  eapply sumList_factor_constant_l.
  eapply eqRat_trans.
  eapply sumList_body_eq.
  intros.
  eapply ratMult_eqRat_compat.
  reflexivity.
  eapply sumList_body_eq.
  intros.
  eapply ratMult_eqRat_compat.
  reflexivity.
  apply (@sumList_exactly_one _ (a, a0)).
  eapply filter_NoDup.
  eapply getUnique_NoDup.
  eapply filter_In.
  intuition idtac.
  eapply in_getUnique.
  eapply in_flatten.
  exists ((map (pair a) (getSupport c2))).
  intuition idtac.
  eapply in_map_iff.
  exists a.
  intuition idtac.
  rewrite Fold.flatten_map_eq.
  apply DetSem.getUnique_NoDup_eq.
  apply FinFun.Injective_map_NoDup.
  unfold FinFun.Injective.
  intuition idtac.
  pairInv.
  trivial.
  eapply getSupport_NoDup.
  eapply filter_In; eauto.
  eapply in_map_iff.
  econstructor; intuition idtac.
  eapply filter_In; eauto.
  simpl.
  eapply filter_In in H0.
  eapply filter_In in H4.
  eapply andb_true_iff.
  intuition idtac.

  intros.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (a, a0) b0).
  subst.
  intuition idtac.
  reflexivity.
  eapply eqRat_trans.
  eapply sumList_body_eq.
  intros.
  eapply ratMult_eqRat_compat.
  reflexivity.
  eapply sumList_body_eq.
  intros.
  eapply ratMult_eqRat_compat.
  reflexivity.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (a, a0) (a, a0)).
  reflexivity.
  intuition idtac.
  eapply eqRat_trans.
  eapply sumList_body_eq.
  intros.
  eapply ratMult_eqRat_compat.
  reflexivity.
  eapply sumList_body_eq.
  intros.
  eapply ratMult_1_r.
  rewrite sumList_prod.
  eapply eqRat_trans.
  eapply sumList_body_eq.
  intros.
  symmetry.
  eapply sumList_factor_constant_l.
  rewrite sumList_comm.
  eapply sumList_body_eq.
  intros.
  rewrite sumList_factor_constant_r.
  eapply ratMult_comm.
  intuition idtac.
  rewrite sumList_0 in H0.
  eapply getSupport_In_evalDist.
  eauto.
  eapply H0.
  eapply filter_In; eauto.
  intuition idtac.
  rewrite sumList_0 in H0.
  eapply getSupport_In_evalDist.
  eapply H1.
  eapply H0.
  eapply filter_In; eauto.
  reflexivity.
  reflexivity.

  simpl.
  repeat rewrite ratMult_0_r.
  reflexivity.

  symmetry.
  apply sumList_0.
  intros.
  apply filter_In in H0.
  intuition idtac.
  rewrite negb_true_iff in H2.
  unfold indicator. simpl.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (a, a0) (a1, b)).
  pairInv.
  rewrite H2.
  rewrite andb_false_r.
  repeat rewrite ratMult_0_l.
  reflexivity.
  repeat rewrite ratMult_0_r.
  reflexivity.

  symmetry.
  apply sumList_0.
  intros.
  apply filter_In in H.
  intuition idtac.
  rewrite negb_true_iff in H1.
  unfold indicator. simpl.
  case_eq (P1 a0); intuition idtac.
  simpl.
  assert (sumList (getSupport c2)
   (fun b0 : B =>
    evalDist c2 b0 *
    (if EqDec_dec (pair_EqDec eqda eqdb) (a, b0) (a0, b)
     then 1
     else 0)) == 0).
  apply sumList_0.
  intros.
  destruct (EqDec_dec (pair_EqDec eqda eqdb) (a, a1) (a0, b)).
  pairInv.
  congruence.
  apply ratMult_0_r.
  rewrite H2.
  repeat rewrite ratMult_0_r.
  reflexivity.
  simpl.
  repeat rewrite ratMult_0_l.
  reflexivity.

Qed.


(* Copyright © 1998-2006
 * Henk Barendregt
 * Luís Cruz-Filipe
 * Herman Geuvers
 * Mariusz Giero
 * Rik van Ginneken
 * Dimitri Hendriks
 * Sébastien Hinderer
 * Bart Kirkels
 * Pierre Letouzey
 * Iris Loeb
 * Lionel Mamane
 * Milad Niqui
 * Russell O’Connor
 * Randy Pollack
 * Nickolay V. Shmyrev
 * Bas Spitters
 * Dan Synek
 * Freek Wiedijk
 * Jan Zwanenburg
 *
 * This work is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This work is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License along
 * with this work; if not, write to the Free Software Foundation, Inc.,
 * 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 *)

Require Export CoRN.metrics.ContFunctions.

Section Reals.
(**
** Real numbers
*)
(**
%\begin{convention}%
Let [X] be a  pseudo metric space.
%\end{convention}%
*)
(**
The real numbers with the usual distance form a pseudo metric space.
*)

Definition dIR (x y : IR) : IR := ABSIR (x[-]y).

Lemma bin_fun_strext_dIR : bin_fun_strext IR IR IR dIR.
Proof.
 unfold bin_fun_strext in |- *.
 unfold dIR in |- *.
 intros.
 apply cg_minus_strext.
 apply un_op_strext_unfolded with AbsIR.
 auto.
Qed.

Definition dIR_as_CSetoid_fun :=
  Build_CSetoid_bin_fun IR IR IR dIR bin_fun_strext_dIR.

Lemma dIR_nneg : forall x y : IR, [0][<=]dIR_as_CSetoid_fun x y.
Proof.
 unfold dIR_as_CSetoid_fun in |- *.
 unfold dIR in |- *.
 simpl in |- *.
 intros.
 apply AbsIR_nonneg.
Qed.

Lemma dIR_com :
 forall x y : IR, dIR_as_CSetoid_fun x y[=]dIR_as_CSetoid_fun y x.
Proof.
 unfold dIR_as_CSetoid_fun in |- *.
 unfold dIR in |- *.
 simpl in |- *.
 exact AbsIR_minus.
Qed.

Lemma dIR_pos_imp_ap :
 forall x y : IR, [0][<]dIR_as_CSetoid_fun x y -> x[#]y.
Proof.
 unfold dIR_as_CSetoid_fun in |- *.
 simpl in |- *.
 intros x y H.
 cut (x[#]x or y[#]x).
  intro H0.
  apply ap_symmetric_unfolded.
  elim H0.
   intro H1.
   cut False.
    intuition.
   cut (Not (x[#]x)).
    intro H2.
    exact (H2 H1).
   apply ap_irreflexive_unfolded.
  intro H1.
  exact H1.
 apply bin_fun_strext_dIR.
 astepr ZeroR.
  apply ap_symmetric_unfolded.
  apply less_imp_ap.
  exact H.
 unfold dIR in |- *.
 astepr (ABSIR ZeroR).
  apply eq_symmetric_unfolded.
  apply AbsIRz_isz.
 apply AbsIR_wd.
 apply eq_symmetric_unfolded.
 apply cg_minus_correct.
Qed.

(* begin hide *)
Lemma IR_tri_ineq : forall a b : IR, AbsIR (a[+]b)[<=]AbsIR a[+]AbsIR b.
Proof.
 intros a b.
 astepr (AbsIR (AbsIR a[+]AbsIR b)).
  apply AbsSmall_imp_AbsIR.
  unfold AbsSmall in |- *.
  split.
   apply inv_cancel_leEq.
   astepr (AbsIR (AbsIR a[+]AbsIR b)).
   astepl ([--]a[+][--]b).
   astepr (AbsIR a[+]AbsIR b).
    apply plus_resp_leEq_both.
     apply inv_leEq_AbsIR.
    apply inv_leEq_AbsIR.
   apply eq_symmetric_unfolded.
   apply AbsIR_eq_x.
   astepl (ZeroR[+]ZeroR).
   apply plus_resp_leEq_both.
    apply AbsIR_nonneg.
   apply AbsIR_nonneg.
  astepr (AbsIR a[+]AbsIR b).
   apply plus_resp_leEq_both.
    apply leEq_AbsIR.
   apply leEq_AbsIR.
  apply eq_symmetric_unfolded.
  apply AbsIR_eq_x.
  astepl (ZeroR[+]ZeroR).
  apply plus_resp_leEq_both.
   apply AbsIR_nonneg.
  apply AbsIR_nonneg.
 apply AbsIR_eq_x.
 astepl (ZeroR[+]ZeroR).
 apply plus_resp_leEq_both.
  apply AbsIR_nonneg.
 apply AbsIR_nonneg.
Qed.
(* end hide *)

Lemma dIR_tri_ineq : tri_ineq dIR_as_CSetoid_fun.
Proof.
 unfold tri_ineq in |- *.
 intros x y z.
 unfold dIR_as_CSetoid_fun in |- *.
 unfold dIR in |- *.
 simpl in |- *.
 astepl (ABSIR (x[+]([--]y[+]y)[-]z)).
  astepl (ABSIR (x[+][--]y[+](y[-]z))).
   astepl (ABSIR (x[-]y[+](y[-]z))).
   apply IR_tri_ineq.
  apply AbsIR_wd.
  rational.
 apply AbsIR_wd.
 rational.
Qed.

Definition IR_dIR_is_CPsMetricSpace :=
  Build_is_CPsMetricSpace IR dIR_as_CSetoid_fun dIR_com dIR_nneg
    dIR_pos_imp_ap dIR_tri_ineq.

Definition IR_as_CPsMetricSpace :=
  Build_CPsMetricSpace IR dIR_as_CSetoid_fun IR_dIR_is_CPsMetricSpace.

Variable X : CPsMetricSpace.

Lemma rev_tri_ineq' :
 forall a b c : X,
 cms_d (c:=IR_as_CPsMetricSpace) (a[-d]b) (a[-d]c)[<=]b[-d]c.
Proof.
 simpl in |- *.
 unfold dIR in |- *.
 intros a b c.
 apply AbsSmall_imp_AbsIR.
 apply rev_tri_ineq.
Qed.

(**
A pseudo metric is Lipschitz. Hence it is uniformly continuous and continuous.
*)

Lemma d_is_lipschitz :
 forall a : X,
 lipschitz (projected_bin_fun X X IR_as_CPsMetricSpace (cms_d (c:=X)) a).
Proof.
 intro a.
 red in |- *.
 simpl in |- *.
 exists 0.
 intros x y.
 astepr (OneR[*](x[-d]y)).
 astepr (x[-d]y).
 apply rev_tri_ineq'.
Qed.

Lemma d_is_uni_continuous :
 forall a : X,
 uni_continuous (projected_bin_fun X X IR_as_CPsMetricSpace (cms_d (c:=X)) a).
Proof.
 intro a.
 apply lipschitz_imp_uni_continuous.
 apply d_is_lipschitz.
Qed.

Lemma d_is_continuous :
 forall a : X,
 continuous (projected_bin_fun X X IR_as_CPsMetricSpace (cms_d (c:=X)) a).
Proof.
 intro a.
 apply uni_continuous_imp_continuous.
 apply d_is_uni_continuous.
Qed.

End Reals.

Section Addition.
(**
** Addition of continuous functions
*)

(**
The sum of two Lipschitz/uniformly continous/continuous functions is again
Lipschitz/uniformly continuous/continuous.
*)

Lemma plus_resp_lipschitz :
 forall (X : CPsMetricSpace) (f g : CSetoid_fun X IR_as_CPsMetricSpace)
   (H : lipschitz f) (H1 : lipschitz g),
 lipschitz
   (compose_CSetoid_bin_fun X IR_as_CPsMetricSpace IR_as_CPsMetricSpace f g
      (csg_op (c:=IR))).
Proof.
 red in |- *.
 unfold lipschitz in |- *.
 intros X f g H H1.
 elim H.
 intros x H2.
 elim H1.
 intros x0 H3.
 exists (max x x0 + 1).
 intros x1 y.
 astepl (dIR (f x1[+]g x1) (f y[+]g y)).
 unfold dIR in |- *.
 unfold dIR in |- *.
 astepl (ABSIR (g x1[-]g y[+](f x1[-]f y))).
  apply leEq_transitive with (ABSIR (g x1[-]g y)[+]ABSIR (f x1[-]f y)).
   apply IR_tri_ineq.
  apply leEq_transitive with ((Two:IR)[^]x0[*](x1[-d]y)[+]ABSIR (f x1[-]f y)).
   apply plus_resp_leEq.
   astepl (g x1[-d]g y).
   apply H3.
  apply leEq_transitive with (Two[^]x0[*](x1[-d]y)[+]Two[^]x[*](x1[-d]y)).
   apply plus_resp_leEq_lft.
   astepl (f x1[-d]f y).
   apply H2.
  astepr ((Two:IR)[*]Two[^]max x x0[*](x1[-d]y)).
   apply leEq_transitive with (Two[^]max x x0[*](x1[-d]y)[+]Two[^]max x x0[*](x1[-d]y)).
    apply plus_resp_leEq_both.
     apply mult_resp_leEq_rht.
      apply great_nexp_resp_le.
       apply less_leEq.
       apply one_less_two.
      intuition.
     apply ax_d_nneg.
     apply CPsMetricSpace_is_CPsMetricSpace.
    apply mult_resp_leEq_rht.
     apply great_nexp_resp_le.
      apply less_leEq.
      apply one_less_two.
     intuition.
    apply ax_d_nneg.
    apply CPsMetricSpace_is_CPsMetricSpace.
   apply eq_imp_leEq.
   rational.
  astepl (Two[^]1[*]Two[^]max x x0[*](x1[-d]y)).
  2: apply AbsIR_wd.
  apply mult_wdl.
  astepl ((Two:IR)[^](max x x0 + 1)).
   2: astepl ((Two:IR)[^]max x x0[*]Two[^]1).
   2: apply mult_commutes.
  astepr ((Two:IR)[^](max x x0 + 1)).
  rational.
 rational.

Qed.

Lemma plus_resp_uni_continuous :
 forall (X : CPsMetricSpace) (f g : CSetoid_fun X IR_as_CPsMetricSpace)
   (H : uni_continuous f) (H1 : uni_continuous g),
 uni_continuous
   (compose_CSetoid_bin_fun X IR_as_CPsMetricSpace IR_as_CPsMetricSpace f g
      (csg_op (c:=IR))).
Proof.
 unfold uni_continuous in |- *.
 unfold IR_as_CPsMetricSpace in |- *.
 unfold dIR_as_CSetoid_fun in |- *.
 unfold dIR in |- *.
 intros X f g H H0.
 intros n H1.
 elim (H (S n) H1).
 intros x H2.
 elim (H0 (S n) H1).
 intros x0 H3.
 exists (max x x0).
 intros x1 y H6.
 astepl (ABSIR (f x1[-]f y[+](g x1[-]g y))).
  apply leEq_less_trans with (ABSIR (f x1[-]f y)[+]ABSIR (g x1[-]g y)).
   apply IR_tri_ineq.
  apply less_leEq_trans with ((OneR[/] Two:IR[//]H1)[^]S n[+]ABSIR (g x1[-]g y)).
   apply plus_resp_less_rht.
   generalize H2.
   simpl in |- *.
   intro H7.
   apply H7.
   generalize H6.
   intro H8.
   apply less_leEq_trans with (nexp IR (max x x0) ([1][/] [0][+][1][+][1][//]H1)).
    apply H8.
   3: simpl in |- *.
   astepl (nexp IR (max x x0) ([1][/] Two:IR[//]H1)).
   astepr (nexp IR x ([1][/] Two:IR[//]H1)).
   astepl ((OneR[/] Two:IR[//]H1)[^]max x x0).
   astepr ((OneR[/] Two:IR[//]H1)[^]x).
   apply small_nexp_resp_le.
     apply shift_leEq_div.
      apply pos_two.
     astepl ZeroR.
     apply less_leEq.
     apply pos_one.
    apply shift_div_leEq.
     apply pos_two.
    astepr (Two:IR).
    apply less_leEq.
    apply one_less_two.
   intuition.
  apply leEq_transitive with ((OneR[/] Two:IR[//]H1)[^]S n[+]([1][/] Two:IR[//]H1)[^]S n).
   apply plus_resp_leEq_lft.
   apply less_leEq.
   generalize H3.
   simpl in |- *.
   intro H7.
   apply H7.
   apply less_leEq_trans with (nexp IR (max x x0) ([1][/] Two:IR[//]H1)).
    exact H6.
   astepr (nexp IR x0 ([1][/] Two:IR[//]H1)).
   astepl ((OneR[/] Two:IR[//]H1)[^]max x x0).
   astepr ((OneR[/] Two:IR[//]H1)[^]x0).
   apply small_nexp_resp_le.
     apply shift_leEq_div.
      apply pos_two.
     astepl ZeroR.
     apply less_leEq.
     apply pos_one.
    apply shift_div_leEq.
     apply pos_two.
    astepr (Two:IR).
    apply less_leEq.
    apply one_less_two.
   intuition.
  apply eq_imp_leEq.
  astepl ((Two:IR)[*]([1][/] Two:IR[//]H1)[^]S n).
  astepl ((Two:IR)[*]([1][^]S n[/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H1)).
  astepl ((Two:IR)[*]([1][/] (Two:IR)[^]S n[//]nexp_resp_ap_zero (S n) H1)).
  astepl ((Two:IR)[*] (([1][/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*]([1][/] Two:IR[//]H1))).
   2: apply mult_wdr.
   2: astepl (([1][/] Two:IR[//]H1)[^]S n).
    3: astepl (([1][/] Two:IR[//]H1)[^]n[*]([1][/] Two:IR[//]H1)).
    rstepl (([1][/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*]Two[*] ([1][/] Two:IR[//]H1)).
    astepl (([1][/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*] (Two[*]([1][/] Two:IR[//]H1))).
    rstepl (([1][/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1)[*][1]).
    rstepl ([1][/] (Two:IR)[^]n[//]nexp_resp_ap_zero n H1).
    astepl ((OneR[/] Two:IR[//]H1)[^]n).
    apply eq_reflexive.
   3: apply AbsIR_wd.
   3: rational.
  astepr ((OneR[/] Two:IR[//]H1)[^]S n).
  apply eq_reflexive.
 astepr (([1][/] Two:IR[//]H1)[^]n[*]([1][/] Two:IR[//]H1)).
 apply eq_reflexive.

Qed.

Lemma plus_resp_continuous :
 forall (X : CPsMetricSpace) (f g : CSetoid_fun X IR_as_CPsMetricSpace)
   (H : continuous f) (H1 : continuous g),
 continuous
   (compose_CSetoid_bin_fun X IR_as_CPsMetricSpace IR_as_CPsMetricSpace f g
      (csg_op (c:=IR))).
Proof.
 unfold continuous in |- *.
 simpl in |- *.
 unfold dIR in |- *.
 intros X f g H H0.
 intros x n H1.
 simpl in |- *.
 elim (H x (S n) H1).
 intros xn H2.
 elim (H0 x (S n) H1).
 intros x0 H3.
 exists (max xn x0).
 intros y H6.
 astepl (ABSIR (f x[-]f y[+](g x[-]g y))).
  apply leEq_less_trans with (ABSIR (f x[-]f y)[+]ABSIR (g x[-]g y)).
   apply IR_tri_ineq.
  apply less_leEq_trans with ((OneR[/] [0][+][1][+][1][//]H1)[^]S n[+]ABSIR (g x[-]g y)).
   apply plus_resp_less_rht.
   apply H2.
   apply less_leEq_trans with (nexp IR (max xn x0) ([1][/] [0][+][1][+][1][//]H1)).
    exact H6.
   astepl ((OneR[/] [0][+][1][+][1][//]H1)[^]max xn x0).
   astepr ((OneR[/] [0][+][1][+][1][//]H1)[^]xn).
   apply small_nexp_resp_le.
     apply shift_leEq_div.
      astepr (Two:IR).
      apply pos_two.
     astepl ZeroR.
     apply less_leEq.
     apply pos_one.
    apply shift_div_leEq.
     astepr (Two:IR).
     apply pos_two.
    astepr (OneR[+][1]).
     astepr (Two:IR).
     apply less_leEq.
     apply one_less_two.
    rational.
   intuition.
  apply leEq_transitive with ((OneR[/] [0][+][1][+][1][//]H1)[^]S n[+]
    ([1][/] [0][+][1][+][1][//]H1)[^]S n).
   apply plus_resp_leEq_lft.
   apply less_leEq.
   apply H3.
   apply less_leEq_trans with (nexp IR (max xn x0) ([1][/] [0][+][1][+][1][//]H1)).
    exact H6.
   astepl ((OneR[/] [0][+][1][+][1][//]H1)[^]max xn x0).
   astepr ((OneR[/] [0][+][1][+][1][//]H1)[^]x0).
   apply small_nexp_resp_le.
     apply shift_leEq_div.
      astepr (Two:IR).
      apply pos_two.
     astepl ZeroR.
     apply less_leEq.
     apply pos_one.
    apply shift_div_leEq.
     astepr (Two:IR).
     apply pos_two.
    astepr (OneR[+][1]).
     astepr (Two:IR).
     apply less_leEq.
     apply one_less_two.
    rational.
   intuition.
  apply eq_imp_leEq.
  astepl ((Two:IR)[*]([1][/] [0][+][1][+][1][//]H1)[^]S n).
  astepr ((OneR[/] [0][+][1][+][1][//]H1)[^]n).
  astepl ((Two:IR)[*] ([1][^]S n[/] ([0][+][1][+][1])[^]S n[//]nexp_resp_ap_zero (S n) H1)).
  astepl ((Two:IR)[*]([1][/] ([0][+][1][+][1])[^]S n[//]nexp_resp_ap_zero (S n) H1)).
  astepl ((Two:IR)[*] (([1][/] ([0][+][1][+][1])[^]n[//]nexp_resp_ap_zero n H1)[*]
    ([1][/] [0][+][1][+][1][//]H1))).
   2: apply mult_wdr.
   2: astepl (([1][/] [0][+][1][+][1][//]H1)[^]S n).
    3: astepl (([1][/] [0][+][1][+][1][//]H1)[^]n[*]([1][/] [0][+][1][+][1][//]H1)).
    3: astepr (([1][/] [0][+][1][+][1][//]H1)[^]n[*]([1][/] [0][+][1][+][1][//]H1)).
    3: apply eq_reflexive.
   rstepl (([1][/] ([0][+][1][+][1])[^]n[//]nexp_resp_ap_zero n H1)[*]Two[*]
     ([1][/] [0][+][1][+][1][//]H1)).
   astepl (([1][/] ([0][+][1][+][1])[^]n[//]nexp_resp_ap_zero n H1)[*]
     (Two[*]([1][/] [0][+][1][+][1][//]H1))).
   rstepl (([1][/] ([0][+][1][+][1])[^]n[//]nexp_resp_ap_zero n H1)[*][1]).
   rstepl ([1][/] ([0][+][1][+][1])[^]n[//]nexp_resp_ap_zero n H1).
   astepl ((OneR[/] [0][+][1][+][1][//]H1)[^]n).
   apply eq_reflexive.
  astepr (([1][/] [0][+][1][+][1][//]H1)[^]S n).
  apply eq_reflexive.
 apply AbsIR_wd.
 rational.
Qed.

End Addition.


Lemma equality_commutes
  : forall (a b : bool), a = b -> b = a.
Proof.
  intros.
  subst.
  reflexivity.
Qed.


(*|
############################################################################
Coq: How are the equality tactics ``symmetry`` and ``transitivity`` defined?
############################################################################

:Link: https://stackoverflow.com/q/71024340
|*)

(*|
Question
********

I'm interested in how the Coq tactics ``symmetry`` and
``transitivity`` actually work. I've read the Coq manual but this only
describes what they do, not how they operate on a proof and change the
proof states. As an example of what I'm looking for, in *Interactive
Theorem Proving and Program Development*, the authors state that "The
reflexivity tactic actually is synonymous with ``apply refl_equal``"
(p. 124). But, the author refers the reader to the reference manual
for ``symmetry`` and ``transitivity``. I haven't found a good
description of things that these two tactics are synonymous with in
the same way.

For clarification, the reason why I ask is that I have defined a path
space ``paths {A : UU} : A -> A -> UU`` notated ``a = b`` (like in
``UniMath``) which acts like an equivalence relation except for that
``a = b`` is not a proposition but a type. For this reason I was
unable to add this relation as an equivalence relation using ``Add
Parametric Relation``. I'm trying to cook up a version of ``symmetry``
and ``transitivity`` with Ltac for this path space relation but I
don't know how to change the proof state; knowing how ``symmetry`` and
``transitivity`` actually work might help.
|*)

(*|
Answer
******

These tactics only apply the lemmas corresponding to symmetry and
transitivity of the relation it finds in the goal. These are found
using the type classes mechanism.

For instance you could declare
|*)

From Coq Require Import RelationClasses.

Variables (A : Type) (R : A -> A -> Prop). (* .none *)
Instance trans : Transitive R.

(*|
which would ask you to prove ``R`` is transitive and then you would be
able to use the tactic ``transitivity`` to prove ``R x y``.
|*)


Require Import RelationClasses.

From sflib Require Import sflib.
From Paco Require Import paco.

From PromisingLib Require Import Axioms.
From PromisingLib Require Import Basic.
From PromisingLib Require Import Loc.
From PromisingLib Require Import DenseOrder.
From PromisingLib Require Import Language.

From PromisingLib Require Import Event.
Require Import Time.
Require Import View.
Require Import Cell.
Require Import Memory.
(* Require Import MemoryFacts. *)
Require Import TView.
Require Import Local.
Require Import Thread.
Require Import Configuration.
Require Import Behavior.
Require Import Global.
Require Import BoolMap.
Require Import Promises.

Require Import Cover.
(* Require Import MemorySplit. *)
(* Require Import MemoryMerge. *)
(* Require Import FulfillStep. *)
(* Require Import PromiseConsistent. *)
Require Import MemoryProps.

Require Import Program.

(* Require Import JoinedView. *)
(* Require Import Pred. *)
(* Require Import Delayed. *)
Require Import LowerMemory.
Require Import LowerStep.

Set Implicit Arguments.

Module PCM.
  Class t: Type := mk {
    car: Type;
    unit: car;
    add: car -> car -> car;
    wf: car -> Prop;
    add_comm: forall a b, add a b = add b a;
    add_assoc: forall a b c, add a (add b c) = add (add a b) c;
    unit_id: forall a, add a unit = a;
    wf_unit: wf unit;
    wf_mon: forall a b, wf (add a b) -> wf a;
  }
  .

  Definition extends `{M: t} (a b: car) := exists ctx, add a ctx = b.
  Definition updatable `{M: t} (a b: car) := forall ctx, wf (add a ctx) -> wf (add b ctx).
  Definition updatable_set (M: t) (a: car) (B: car -> Prop) := forall ctx (WF: wf (add a ctx)),
    exists b, <<IN: B b>> /\ <<WF: wf (add b ctx)>>.

  Global Program Instance extends_PreOrder `{M: t}: PreOrder extends.
  Next Obligation.
  Proof.
    ii. eexists. eapply unit_id.
  Qed.
  Next Obligation.
  Proof.
    ii. unfold extends in *. des. subst.
    exists (add ctx0 ctx). apply add_assoc.
  Qed.
End PCM.

Section WORLD.

Variable world: Type.
Context `{M: PCM.t}.

Variable world_messages_le: Messages.t -> Messages.t -> BoolMap.t -> BoolMap.t -> PCM.car -> (world * PCM.car) -> (world * PCM.car) -> Prop.
Context `{world_messages_le_PreOrder: forall msgs_src msgs_tgt gown_src gown_tgt ctx, PreOrder (world_messages_le msgs_src msgs_tgt gown_src gown_tgt ctx)}.

Hypothesis world_messages_le_mon:
  forall msgs_src0 msgs_tgt0 msgs_src1 msgs_tgt1
         gown_src0 gown_tgt0 gown_src1 gown_tgt1
         ctx0 ctx1 w0 w1
         (LE: world_messages_le msgs_src1 msgs_tgt1 gown_src1 gown_tgt1 ctx1 w0 w1)
         (MSGSRC: msgs_src0 <4= msgs_src1)
         (MSGTGT: msgs_tgt0 <4= msgs_tgt1)
         (GOWNSRC: BoolMap.le gown_src0 gown_src1)
         (GOWNTGT: BoolMap.le gown_tgt0 gown_tgt1)
         (CTX: PCM.extends ctx0 ctx1),
    world_messages_le msgs_src0 msgs_tgt0 gown_src0 gown_tgt0 ctx0 w0 w1.

Variable sim_global: forall (w: world) (m: PCM.car) (gl_src gl_tgt:Global.t), Prop.

Section SimulationThread.

  Definition SIM_THREAD :=
    forall (lang_src lang_tgt:language)
           (b: bool) (c: PCM.car) (w: world) (l: PCM.car)
           (st1_src:(Language.state lang_src)) (lc1_src:Local.t) (gl0_src:Global.t)
           (st1_tgt:(Language.state lang_tgt)) (lc1_tgt:Local.t) (gl0_tgt:Global.t), Prop.

  Definition _sim_thread_promise_step
             (lang_src lang_tgt:language)
             (sim_thread: forall (b1: bool) (c1: PCM.car) (w1: world) (l1: PCM.car) (st1_src:(Language.state lang_src)) (lc1_src:Local.t) (gl0_src:Global.t)
                                 (st1_tgt:(Language.state lang_tgt)) (lc1_tgt:Local.t) (gl0_tgt:Global.t), Prop)
             (b: bool)
             (c: PCM.car)
             (w0: world) (l0: PCM.car)
             st1_src lc1_src gl1_src
             st1_tgt lc1_tgt gl1_tgt :=
    forall st3_tgt lc3_tgt gl3_tgt
           (STEP_TGT: Thread.internal_step
                        (Thread.mk _ st1_tgt lc1_tgt gl1_tgt)
                        (Thread.mk _ st3_tgt lc3_tgt gl3_tgt))
           (CONSISTENT: rtc_consistent (Thread.mk _ st3_tgt lc3_tgt gl3_tgt)),
    exists st2_src lc2_src gl2_src,
      (<<STEPS: rtc (@Thread.tau_step _)
                    (Thread.mk _ st1_src lc1_src gl1_src)
                    (Thread.mk _ st2_src lc2_src gl2_src)>>) /\
        ((<<FAILURE: Thread.steps_failure (Thread.mk _ st2_src lc2_src gl2_src)>>) \/
           exists w3 l3,
             (<<gL3: b = false -> sim_global w3 (PCM.add l3 c) gl2_src gl3_tgt>>) /\
               (<<SIM: sim_thread b c w3 l3 st2_src lc2_src gl2_src st3_tgt lc3_tgt gl3_tgt>>) /\
               (<<WORLD: world_messages_le (unchangable gl1_src.(Global.memory) lc1_src.(Local.reserves)) (unchangable gl1_tgt.(Global.memory) lc1_tgt.(Local.reserves)) (BoolMap.minus gl1_src.(Global.promises) lc1_src.(Local.promises)) (BoolMap.minus gl1_tgt.(Global.promises) lc1_tgt.(Local.promises)) c (w0, l0) (w3, l3)>>))
  .

  Definition _sim_thread_cap
             (lang_src lang_tgt:language)
             (sim_thread: forall (b1: bool) (c1: PCM.car) (w1: world) (l1: PCM.car) (st1_src:(Language.state lang_src)) (lc1_src:Local.t) (gl0_src:Global.t)
                                 (st1_tgt:(Language.state lang_tgt)) (lc1_tgt:Local.t) (gl0_tgt:Global.t), Prop)
             (c: PCM.car)
             (w0: world) (l0: PCM.car)
             st1_src lc1_src gl1_src
             st1_tgt lc1_tgt gl1_tgt :=
    exists w3 l3,
      (<<GLOBAL3: sim_global w3 (PCM.add l3 c) (Global.cap_of gl1_src) (Global.cap_of gl1_tgt)>>) /\
      (<<SIM: sim_thread false c w3 l3 st1_src lc1_src (Global.cap_of gl1_src) st1_tgt lc1_tgt (Global.cap_of gl1_tgt)>>).

  Definition _sim_thread_future
             (lang_src lang_tgt:language)
             (sim_thread: forall (b1: bool) (c1: PCM.car) (w1: world) (l1: PCM.car) (st1_src:(Language.state lang_src)) (lc1_src:Local.t) (gl0_src:Global.t)
                                 (st1_tgt:(Language.state lang_tgt)) (lc1_tgt:Local.t) (gl0_tgt:Global.t), Prop)
             (c0: PCM.car)
             (w0: world) (l0: PCM.car)
             st1_src lc1_src gl1_src
             st1_tgt lc1_tgt gl1_tgt :=
    forall gl2_src gl2_tgt w1 c1
           (MEMSRC: Global.strong_le gl1_src gl2_src)
           (MEMTGT: Global.le gl1_tgt gl2_tgt)
           (WORLD: world_messages_le (Messages.of_memory lc1_src.(Local.reserves)) (Messages.of_memory lc1_tgt.(Local.reserves)) lc1_src.(Local.promises) lc1_tgt.(Local.promises) l0 (w0, c0) (w1, c1))
           (MEMORY: sim_global w1 (PCM.add l0 c1) gl2_src gl2_tgt)
           (WF_SRC: Local.wf lc1_src gl2_src)
           (WF_TGT: Local.wf lc1_tgt gl2_tgt)
           (MEM_SRC: Global.wf gl2_src)
           (MEM_TGT: Global.wf gl2_tgt)
           (CONSISTENT: Thread.consistent (Thread.mk _ st1_src lc1_src gl1_src)),
    exists st2_src lc2_src gl3_src,
      (<<STEPS: rtc (@Thread.tau_step _)
                    (Thread.mk _ st1_src lc1_src gl2_src)
                    (Thread.mk _ st2_src lc2_src gl3_src)>>) /\
      ((<<FAILURE: Thread.steps_failure (Thread.mk _ st2_src lc2_src gl3_src)>>) \/
       exists w3 l3,
         (<<MEMORY3: sim_global w3 (PCM.add l3 c1) gl3_src gl2_tgt>>) /\
         (<<SIM: sim_thread false c1 w3 l3 st2_src lc2_src gl3_src st1_tgt lc1_tgt gl2_tgt>>) /\
         (<<WORLD: world_messages_le (unchangable gl2_src.(Global.memory) lc1_src.(Local.reserves)) (unchangable gl2_tgt.(Global.memory) lc1_tgt.(Local.reserves)) (BoolMap.minus gl2_src.(Global.promises) lc1_src.(Local.promises)) (BoolMap.minus gl2_tgt.(Global.promises) lc1_tgt.(Local.promises)) c1 (w1, l0) (w3, l3)>>))
  .

  Definition _sim_thread_release_step
             (lang_src lang_tgt:language)
             (sim_thread: forall (b1: bool) (c1: PCM.car) (w1: world) (l1: PCM.car) (st1_src:(Language.state lang_src)) (lc1_src:Local.t) (gl0_src:Global.t)
                                 (st1_tgt:(Language.state lang_tgt)) (lc1_tgt:Local.t) (gl0_tgt:Global.t), Prop)
             (c: PCM.car)
             (w0: world) (l0: PCM.car)
             st1_src lc1_src gl1_src
             st1_tgt lc1_tgt gl1_tgt :=
    forall e_tgt st3_tgt lc3_tgt gl3_tgt
           (STEP_TGT: Thread.step e_tgt
                                  (Thread.mk _ st1_tgt lc1_tgt gl1_tgt)
                                  (Thread.mk _ st3_tgt lc3_tgt gl3_tgt))
           (RELEASE: release_event e_tgt),
    exists st2_src lc2_src gl2_src,
      (<<STEPS: rtc (@Thread.tau_step _)
                    (Thread.mk _ st1_src lc1_src gl1_src)
                    (Thread.mk _ st2_src lc2_src gl2_src)>>) /\
      ((<<FAILURE: Thread.steps_failure (Thread.mk _ st2_src lc2_src gl2_src)>>) \/
       exists e_src st3_src lc3_src gl3_src st4_src lc4_src gl4_src w3 l3,
         (<<STEP_SRC: Thread.opt_step e_src
                                      (Thread.mk _ st2_src lc2_src gl2_src)
                                      (Thread.mk _ st3_src lc3_src gl3_src)>>) /\
         (<<STEPS_AFTER: rtc (@Thread.tau_step _)
                             (Thread.mk _ st3_src lc3_src gl3_src)
                             (Thread.mk _ st4_src lc4_src gl4_src)>>) /\
         (<<EVENT: machine_event_le (ThreadEvent.get_machine_event e_tgt) (ThreadEvent.get_machine_event e_src)>>) /\
         (<<MEMORY3: sim_global w3 (PCM.add l3 c) gl4_src gl3_tgt>>) /\
         (<<SIM: sim_thread false c w3 l3 st4_src lc4_src gl4_src st3_tgt lc3_tgt gl3_tgt>>) /\
         (<<WORLD: world_messages_le (unchangable gl1_src.(Global.memory) lc1_src.(Local.reserves)) (unchangable gl1_tgt.(Global.memory) lc1_tgt.(Local.reserves)) (BoolMap.minus gl1_src.(Global.promises) lc1_src.(Local.promises)) (BoolMap.minus gl1_tgt.(Global.promises) lc1_tgt.(Local.promises)) c (w0, l0) (w3, l3)>>))
  .

  Definition _sim_thread_terminal
             (lang_src lang_tgt:language)
             (sim_thread: forall (b1: bool) (c1: PCM.car) (w1: world) (l1: PCM.car) (st1_src:(Language.state lang_src)) (lc1_src:Local.t) (gl0_src:Global.t)
                                 (st1_tgt:(Language.state lang_tgt)) (lc1_tgt:Local.t) (gl0_tgt: Global.t), Prop)
             (c: PCM.car)
             (w0: world) (l0: PCM.car)
             st1_src lc1_src gl1_src
             st1_tgt lc1_tgt gl1_tgt :=
    forall (TERMINAL_TGT: (Language.is_terminal lang_tgt) st1_tgt)
           (BOT: Local.is_terminal lc1_tgt),
    exists st2_src lc2_src gl2_src,
      (<<STEPS: rtc (@Thread.tau_step _)
                    (Thread.mk _ st1_src lc1_src gl1_src)
                    (Thread.mk _ st2_src lc2_src gl2_src)>>) /\
      ((<<FAILURE: Thread.steps_failure (Thread.mk _ st2_src lc2_src gl2_src)>>) \/
       exists w3 l3,
         (<<TERMINAL_SRC: (Language.is_terminal lang_src) st2_src>>) /\
         (<<BOT: Local.is_terminal lc2_src>>) /\
         (<<MEMORY3: sim_global w3 (PCM.add l3 c) gl2_src gl1_tgt>>) /\
         (<<WORLD: world_messages_le (unchangable gl1_src.(Global.memory) lc1_src.(Local.reserves)) (unchangable gl1_tgt.(Global.memory) lc1_tgt.(Local.reserves)) (BoolMap.minus gl1_src.(Global.promises) lc1_src.(Local.promises)) (BoolMap.minus gl1_tgt.(Global.promises) lc1_tgt.(Local.promises)) c (w0, l0) (w3, l3)>>)).

  Definition _sim_thread_certification
             (lang_src lang_tgt:language)
             (sim_thread: forall (b1: bool) (c1: PCM.car) (w1: world) (l1: PCM.car) (st1_src:(Language.state lang_src)) (lc1_src:Local.t) (gl0_src:Global.t)
                                 (st1_tgt:(Language.state lang_tgt)) (lc1_tgt:Local.t) (gl0_tgt:Global.t), Prop)
             (c0: PCM.car)
             (w0: world) (l0: PCM.car)
             st1_src lc1_src gl1_src
             lc1_tgt :=
    forall (BOT: lc1_tgt.(Local.promises) = BoolMap.bot),
    exists st2_src lc2_src gl2_src,
      (<<STEPS: rtc (@Thread.tau_step lang_src)
                    (Thread.mk _ st1_src lc1_src gl1_src)
                    (Thread.mk _ st2_src lc2_src gl2_src)>>) /\
        ((<<FAILURE: Thread.steps_failure (Thread.mk _ st2_src lc2_src gl2_src)>>) \/
           (<<BOT: lc2_src.(Local.promises) = BoolMap.bot>>)).

  Definition _sim_thread_lower_step
             (lang_src lang_tgt:language)
             (sim_thread: forall (b1: bool) (c1: PCM.car) (w1: world) (l1: PCM.car) (st1_src:(Language.state lang_src)) (lc1_src:Local.t) (gl0_src:Global.t)
                                 (st1_tgt:(Language.state lang_tgt)) (lc1_tgt:Local.t) (gl0_tgt:Global.t), Prop)
             (c: PCM.car)
             (w0: world) (l0: PCM.car)
             st1_src lc1_src gl1_src
             st1_tgt lc1_tgt gl1_tgt :=
    forall e_tgt st3_tgt lc3_tgt gl3_tgt
           (STEP_TGT: Thread.program_step e_tgt
                                          (Thread.mk _ st1_tgt lc1_tgt gl1_tgt)
                                          (Thread.mk _ st3_tgt lc3_tgt gl3_tgt))
           (NRELEASE: ~ release_event e_tgt),
    exists st2_src lc2_src gl2_src,
      (<<STEPS: rtc (@Thread.tau_step _)
                    (Thread.mk _ st1_src lc1_src gl1_src)
                    (Thread.mk _ st2_src lc2_src gl2_src)>>) /\
      ((<<FAILURE: Thread.steps_failure (Thread.mk _ st2_src lc2_src gl2_src)>>) \/
       exists w3 l3,
         ((<<SIM: sim_thread true c w3 l3 st2_src lc2_src gl2_src st3_tgt lc3_tgt gl3_tgt>>) /\
          (<<WORLD: world_messages_le (unchangable gl1_src.(Global.memory) lc1_src.(Local.reserves)) (unchangable gl1_tgt.(Global.memory) lc1_tgt.(Local.reserves)) (BoolMap.minus gl1_src.(Global.promises) lc1_src.(Local.promises)) (BoolMap.minus gl1_tgt.(Global.promises) lc1_tgt.(Local.promises)) c (w0, l0) (w3, l3)>>)))
  .

  Definition _sim_thread_failure
             (lang_src lang_tgt:language)
             (w0: world)
             (st1_src:(Language.state lang_src)) (lc1_src:Local.t) (gl0_src:Global.t)
             (st1_tgt:(Language.state lang_tgt)) (lc1_tgt:Local.t) (gl0_tgt:Global.t) :=
    exists st2_src lc2_src gl2_src,
      (<<STEPS: rtc (@Thread.tau_step _)
                    (Thread.mk _ st1_src lc1_src gl0_src)
                    (Thread.mk _ st2_src lc2_src gl2_src)>>) /\
        (<<FAILURE: Thread.steps_failure (Thread.mk _ st2_src lc2_src gl2_src)>>).

  Definition _sim_thread
             (sim_thread: SIM_THREAD)
             (lang_src lang_tgt:language)
             (b0: bool) (c0: PCM.car) (w0: world) (l0: PCM.car)
             (st1_src:(Language.state lang_src)) (lc1_src:Local.t) (gl0_src:Global.t)
             (st1_tgt:(Language.state lang_tgt)) (lc1_tgt:Local.t) (gl0_tgt:Global.t): Prop :=
    forall
      (WF_SRC: Local.wf lc1_src gl0_src)
      (WF_TGT: Local.wf lc1_tgt gl0_tgt)
      (MEM_SRC: Global.wf gl0_src)
      (MEM_TGT: Global.wf gl0_tgt),
      ((<<RELEASE: _sim_thread_release_step _ _ (@sim_thread _ _) c0 w0 l0 st1_src lc1_src gl0_src st1_tgt lc1_tgt gl0_tgt>>) /\
         (<<CERTIFICATION: _sim_thread_certification _ lang_tgt (@sim_thread _ _) c0 w0 l0 st1_src lc1_src gl0_src lc1_tgt>>) /\
         (<<LOWER: _sim_thread_lower_step _ _ (@sim_thread _ _) c0 w0 l0 st1_src lc1_src gl0_src st1_tgt lc1_tgt gl0_tgt>>) /\
         (<<TERMINAL: _sim_thread_terminal _ _ (@sim_thread _ _) c0 w0 l0 st1_src lc1_src gl0_src st1_tgt lc1_tgt gl0_tgt>>) /\
         (<<PROMISE: _sim_thread_promise_step _ _ (@sim_thread _ _) b0 c0 w0 l0 st1_src lc1_src gl0_src st1_tgt lc1_tgt gl0_tgt>>) /\
         (<<CAP: b0 = false -> _sim_thread_cap _ _ (@sim_thread _ _) c0 w0 l0 st1_src lc1_src gl0_src st1_tgt lc1_tgt gl0_tgt>>) /\
         (<<FUTURE: b0 = false -> _sim_thread_future _ _ (@sim_thread _ _) c0 w0 l0 st1_src lc1_src gl0_src st1_tgt lc1_tgt gl0_tgt>>)) \/
        (<<FAILURE: _sim_thread_failure _ _ w0 st1_src lc1_src gl0_src st1_tgt lc1_tgt gl0_tgt>>)
  .

  Lemma _sim_thread_mon: monotone12 _sim_thread.
  Proof.
    ii. red in IN. exploit IN; eauto. i. des; auto.
    left. splits; eauto.
    { ii. exploit RELEASE; eauto. i. des.
      { esplits; eauto. }
      { esplits; eauto. right. esplits; eauto. }
    }
    { ii. exploit LOWER; eauto. i. des.
      { esplits; eauto. }
      { esplits; eauto. right. esplits; eauto. }
    }
    { ii. exploit PROMISE; eauto. i. des.
      { esplits; eauto. }
      { esplits; eauto. right. esplits; eauto. }
    }
    { ii. exploit CAP; eauto. i. rr in x12. des. rr. esplits; eauto. }
    { ii. exploit FUTURE; eauto. i. des.
      { esplits; eauto. }
      { esplits; eauto. right. esplits; eauto. }
    }
  Qed.
  #[local] Hint Resolve _sim_thread_mon: paco.

  Definition sim_thread: SIM_THREAD := paco12 _sim_thread bot12.
End SimulationThread.
#[local] Hint Resolve _sim_thread_mon: paco.

End WORLD.
#[export] Hint Resolve _sim_thread_mon: paco.