From Categories Require Import Essentials.Notations.
From Categories Require Import Essentials.Types.
From Categories Require Import Essentials.Facts_Tactics.
From Categories Require Import Category.Main.
From Categories.Limits Require Import Limit GenProd_GenSum GenProd_Eq_Limits.
From Categories.Functor Require Import Functor Const_Func Functor_Ops.
From Categories Require Import NatTrans.Main.
From Categories Require Import Ext_Cons.Comma.
From Categories.Basic_Cons Require Import Terminal Equalizer Limits.
From Categories Require Import Archetypal.Discr.Discr.
From Categories Require Import Cat.Terminal.

(** We show that if C is a complete category and G : C –≻ D preserves limits,
then every comma category (Comma (Func_From_SingletonCat x) G) for (x : D) has
equalizers. *)
Section Commas_Equalizer.
  Context
    {C D : Category}
    {CC : Complete C}
    {G : (C --> D)%functor}
    (GCont : Continuous CC G)
    (x : D).

  Context {a b : (Comma (Const_Func 1 x) G)} (f g: (a --> b)%morphism).

  Local Hint Extern 1 => match goal with [x : bool |- _] => destruct x end : core.
  Local Hint Extern 1 => match goal with [x : unit |- _] => destruct x end : core.
  Local Hint Extern 1 => apply Comma_Hom_eq_simplify : core.
  Local Hint Extern 1 => progress cbn in * : core.
  Local Hint Extern 1 => rewrite From_Term_Cat : core.

  Local Obligation Tactic := basic_simpl; auto 10.

  Definition G_Eq_producing_Func_CMH_right_Limit :=
    is_Cone_Local_Right_KanExt_Local_Right_KanExt
      _
      _
      (GCont _ (Equalizer_Producing_Func (CMH_right f) (CMH_right g))).

  Definition Eq_CMH_right_f_CMH_right_g :
    Equalizer (CMH_right f) (CMH_right g)
    :=
      Equalizer_as_Limit
        _ _ (LimitOf (Equalizer_Producing_Func (CMH_right f) (CMH_right g))).

  Program Definition
          G_Eq_producing_Func_CMH_right_Eq_producing_Func_G_CMH_right_Iso :
    (((Equalizer_Producing_Func
         (G _a (CMH_right f)) (G _a (CMH_right g)))%morphism)
       ≃
       (G ∘ Equalizer_Producing_Func (CMH_right f) (CMH_right g))%functor)%natiso
    :=
      {|
        iso_morphism :=
          {|
            Trans := fun c => _
          |};
        inverse_morphism :=
          {|
            Trans := fun c => _
          |}
      |}
  .
  Next Obligation.
  Proof.
    destruct c; exact id.
  Defined.
  Next Obligation.
  Proof.
    destruct c; exact id.
  Defined.

  Definition Eq_producing_Func_G_CMH_right_Limit :
    Limit (Equalizer_Producing_Func
             (G _a (CMH_right f)) (G _a (CMH_right g)))%morphism
    :=
      Local_Right_KanExt_Iso
        G_Eq_producing_Func_CMH_right_Eq_producing_Func_G_CMH_right_Iso
        G_Eq_producing_Func_CMH_right_Limit.

  Definition Eq_G_CMH_right :
    Equalizer (G _a (CMH_right f))%morphism (G _a (CMH_right g))%morphism
    := Equalizer_as_Limit _ _ Eq_producing_Func_G_CMH_right_Limit.

  Theorem CMO_hom_a_equalizes :
    ((G _a (CMH_right f)) ∘ (CMO_hom a))%morphism =
    ((G _a (CMH_right g)) ∘ (CMO_hom a))%morphism.
  Proof.
    rewrite (CMH_com f).
    rewrite (CMH_com g).
    destruct (CMH_left f); destruct (CMH_left g).
    trivial.
  Qed.

  Program Definition Comma_Equalizer_Obj : Comma (Const_Func 1 x) G :=
    {|
      CMO_src := tt;
      CMO_trg := equalizer _ _ Eq_CMH_right_f_CMH_right_g;
      CMO_hom :=
        equalizer_morph_ex Eq_G_CMH_right CMO_hom_a_equalizes
    |}.

  Program Definition Comma_Equalizer :
    Equalizer f g
    :=
      {|
        equalizer := Comma_Equalizer_Obj;
        equalizer_morph :=
          {|
            CMH_left := tt;
            CMH_right := (equalizer_morph Eq_CMH_right_f_CMH_right_g)
          |};
        equalizer_morph_ex :=
          fun e eqm eqmc =>
            {|
              CMH_left := tt;
              CMH_right :=
                equalizer_morph_ex
                  Eq_CMH_right_f_CMH_right_g
                  (f_equal CMH_right eqmc)
            |}
      |}.

  Local Obligation Tactic := idtac.

  Next Obligation.
  Proof.
    etransitivity;
    [|
     etransitivity;
       [apply (equalizer_morph_ex_com Eq_G_CMH_right CMO_hom_a_equalizes)|]
    ].
    {
      cbn -[equalizer_morph_ex].
      simpl_ids.
      rewrite From_Term_Cat.
      rewrite F_id.
      simpl_ids.
      trivial.
    }
    {
      auto.
    }
  Qed.

  Next Obligation.
  Proof.
    apply Comma_Hom_eq_simplify; cbn -[equalizer_morph]; auto.
    apply (equalizer_morph_com Eq_CMH_right_f_CMH_right_g).
  Qed.

  Next Obligation.
  Proof.
    intros e eqm eqmc.
    unfold Comma_Equalizer_Obj.
    cbn [CMO_hom].
    assert
      (H :
         ((G _a (CMH_right f)) ∘ (G _a (CMH_right eqm)))%morphism
         =
         ((G _a (CMH_right g)) ∘ (G _a (CMH_right eqm)))%morphism
      )
      by
        (repeat rewrite <- F_compose;
          cbn_rewrite (f_equal CMH_right eqmc); trivial)
    .
    match goal with
      [|- (?A ∘ _)%morphism = _] =>
      replace A with (equalizer_morph_ex Eq_G_CMH_right H)
    end.
    {
      apply (
          @equalizer_morph_unique
            _
            _
            _
            _
            _
            Eq_G_CMH_right
            _
            _
            CMO_hom_a_equalizes
        ).
      {
        rewrite assoc_sym.
        rewrite (equalizer_morph_ex_com Eq_G_CMH_right H).
        etransitivity;[apply (CMH_com eqm)|]; auto.
      }
      {
        cbn [FA Const_Func].
        simpl_ids.
        apply (equalizer_morph_ex_com Eq_G_CMH_right CMO_hom_a_equalizes).
      }
    }
    {
      apply (
          @equalizer_morph_unique
            _
            _
            _
            _
            _
            Eq_G_CMH_right
            _
            _
            H
        ).
      {
        rewrite (equalizer_morph_ex_com Eq_G_CMH_right H); trivial.
      }
      {
        etransitivity;
        [
        | etransitivity;
          [
            apply
              (
                f_equal
                  (fun w => (G _a w)%morphism)
                  (equalizer_morph_ex_com
                     Eq_CMH_right_f_CMH_right_g (f_equal CMH_right eqmc)
                  )
              )
          |
          ]
        ]; trivial.
        cbn -[equalizer_morph_ex].
        simpl_ids.
        rewrite From_Term_Cat.
        rewrite F_id.
        simpl_ids.
        rewrite <- F_compose.
        trivial.
      }
    }
  Qed.
  Next Obligation.
  Proof.
    intros e eqm eqmc.
    apply Comma_Hom_eq_simplify.
    {
      cbn.
      match goal with
        [|- _ = ?A] => destruct A; trivial
      end.
    }
    {
      cbn -[equalizer_morph equalizer_morph_ex].
      apply (equalizer_morph_ex_com Eq_CMH_right_f_CMH_right_g).
    }
  Qed.
  Next Obligation.
  Proof.
    intros e eqm eqmc u u' H1 H2.
    apply Comma_Hom_eq_simplify.
    {
      cbn.
      match goal with
        [|- ?A = ?B] => destruct A; destruct B; trivial
      end.
    }
    {
      apply (
          @equalizer_morph_unique
            _
            _
            _
            _
            _
            Eq_CMH_right_f_CMH_right_g
            _
            _
            (f_equal CMH_right eqmc)
        ).
      + apply (f_equal CMH_right H1).
      + apply (f_equal CMH_right H2).
    }
  Qed.

End Commas_Equalizer.


(*
(C) Copyright 2010, COQTAIL team

Project Info: http://sourceforge.net/projects/coqtail/

This library is free software; you can redistribute it and/or modify it
under the terms of the GNU Lesser General Public License as published by
the Free Software Foundation; either version 2.1 of the License, or
(at your option) any later version.

This library 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 Lesser General Public
License for more details.

You should have received a copy of the GNU Lesser General Public
License along with this library; if not, write to the Free Software
Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301,
USA.
*)

Require Export Reals.
Require Export MyReals.
Require Export Rsequence_facts.
Require Export Rseries_def.
Require Export Rpser_facts.
Require Import Fourier.
Require Import Rintegral.
Require Import Rseries_facts.
Require Import Rseries_RiemannInt.
Require Import Rsequence_subsequence.

(* begin hide *)
Lemma continuity_pt_eq_compat :
  forall f g x, (exists alp, alp > 0 /\ forall y, R_dist x y < alp -> f y = g y) ->
  continuity_pt f x -> continuity_pt g x.
Proof.
intros f g x [alp1 [Halp1 H1]] H.
intros eps Heps.
destruct (H eps Heps) as [alp2 [Halp2 H2]].
exists (Rmin alp1 alp2); split.
apply Rmin_pos; assumption.
intros u Hu.
repeat rewrite <- H1.
apply H2.
split; intuition.
unfold Rmin in * |- ; destruct Rle_dec; fourier.
rewrite R_dist_eq; assumption.
apply Rlt_le_trans with (Rmin alp1 alp2).
  destruct Hu as [_ Hu].
  rewrite R_dist_sym; apply Hu.
  apply Rmin_l.
Qed.
(* end hide *)

(** ** Taylor series of ln *)

(** * Taylor series of ln (1 - x) *)

Section ln_minus.

Let Un n :=
match n with
| 0 => 0
| _ => - / (INR n)
end.

Lemma ln_minus_cv_radius : Cv_radius_weak Un 1.
Proof.
exists 1; intros m [n Hn]; subst m.
unfold gt_abs_Pser.
rewrite pow1; rewrite Rmult_1_r.
unfold Un; destruct n.
  rewrite Rabs_R0; apply Rle_0_1.
  assert (Hle : 1 <= INR (S n)).
    rewrite S_INR.
    pattern 1 at 1; rewrite <- Rplus_0_l.
    apply Rplus_le_compat_r.
    apply pos_INR.
  rewrite Rabs_Ropp.
  rewrite Rabs_Rinv; [|intros Hc; fourier].
  rewrite Rabs_right; [|fourier].
  apply (Rmult_le_reg_l (INR (S n))); [fourier|].
  rewrite Rinv_r; [fourier|intros Hc; fourier].
Qed.
(* begin hide *)

Lemma sum_f_R0_Ropp_compat : forall An n, - sum_f_R0 An n = sum_f_R0 (-An)%Rseq n.
Proof.
intros An n ; induction n.
 reflexivity.
 simpl ; rewrite Ropp_plus_distr ; rewrite IHn ; reflexivity.
Qed.
(* end hide *)

Lemma ln_minus_finite_cv_radius : finite_cv_radius Un 1.
Proof.
 assert (Un_decr : Un_decreasing (- (fun n => Un (S n)))%Rseq).
  assert (Hrew : forall n, Un (S n) = -/ INR (S n)).
   intro ; reflexivity.
   intro n ; unfold Rseq_opp ; repeat rewrite Hrew, Ropp_involutive.
   apply Rle_Rinv ; intuition.
  assert (Un_cv_0 : Un_cv (fun n : nat => - Un (S n)) 0).
  replace (fun n : nat => Un (S n)) with (fun n => - / INR (S n)).
  rewrite <- Ropp_involutive ;  do 2 apply Rseq_cv_opp_compat.
  apply Rseq_cv_pos_infty_inv_compat.
  intro M.
  assert (lt_0_1 : (0 < 1)%nat) by auto ;
  destruct (Rseq_poly_cv 1 lt_0_1 M) as [N HN] ;
  exists N ; intros n n_gt_N ; apply Rlt_trans with (INR n).
  rewrite <- pow_1 ; apply HN ; assumption.
  intuition.
  reflexivity.
 destruct (alternated_series (fun n => - Un (S n)) Un_decr Un_cv_0) as [l Hl].

 rewrite <- Rabs_R1.
 rewrite <- Rabs_Ropp.
 apply Rpser_finite_cv_radius_caracterization with l.
 unfold Pser, infinite_sum.
 intros eps eps_pos ; destruct (Hl eps eps_pos) as [N HN] ; exists (S N) ;
 intros n n_lb ; unfold R_dist.
 rewrite <- Rabs_Ropp.
 rewrite Ropp_minus_distr.
 unfold Rminus ; rewrite sum_f_R0_Ropp_compat.
 apply Rle_lt_trans with (R_dist (sum_f_R0 (tg_alt (fun n0 : nat => - Un (S n0))) (pred n)) l).
 right ; rewrite <- Rabs_Ropp ; unfold R_dist ; apply Rabs_eq_compat.
 clear - n_lb; induction n ; unfold tg_alt.
 inversion n_lb.
 simpl pred.
 clear ; induction n.
  compute ; field.
  rewrite tech5.
  repeat rewrite Ropp_plus_distr in *.
  rewrite <- Rplus_assoc.
  rewrite IHn.
  unfold Rminus ; rewrite tech5.
  repeat rewrite Rplus_assoc ; apply Rplus_eq_compat_l.
  rewrite Rplus_comm ; apply Rplus_eq_compat_r.
  unfold Rseq_opp ;  simpl pow ;  ring.
  apply HN ; intuition.

 unfold Pser_abs, Pser.
 rewrite Rabs_Ropp; rewrite Rabs_R1.
 intros M Hconv.
 pose (fun n => match n with O => 0 | S _ => / INR n end) as An.
 apply Rseq_cv_not_infty with (sum_f_R0 An); split.
  exists M.
  refine (Rser_cv_eq_compat _ An M _ Hconv).
  intros [|n].
   simpl; rewrite Rabs_R0; ring.

   unfold Un, An.
   rewrite Rabs_Ropp.
   rewrite Rabs_pos_eq; [ | apply Rlt_le; apply Rinv_0_lt_compat; INR_solve].
   rewrite pow1.
   ring.

 apply Rseq_cv_pos_infty_shift_compat.
 eapply Rseq_cv_pos_infty_eq_compat.
  2:eapply Rseq_equiv_cv_pos_infty_compat.
   2:apply Rseq_equiv_sym.
   2:apply harmonic_series_equiv.

  intro n; unfold Rseq_shift.
   induction n.
    simpl; ring.

    rewrite tech5.
    rewrite IHn.
    reflexivity.

   apply Rseq_subseq_cv_pos_infty_compat with (fun n => ln (INR n)).
    exists (exist _ _ (extractor_Rseq_iter_S 2)).
    unfold extracted, is_extractor.
    reflexivity.

    apply Rseq_ln_cv.
Qed.

Let sum x := weaksum_r Un 1 ln_minus_cv_radius x.

Lemma ln_minus_taylor_sum :
  forall x, Rabs x < 1 -> sum x = (ln (1 - x)).
Proof.
intros x Hx.
pose (f := comp ln (fct_cte 1 - id)).
pose (df := fun u => / (1 - u) * (0 - 1)).
assert (Hb : forall u, Rmin 0 x <= u <= Rmax 0 x -> -1 < u < 1).
  destruct (Rabs_def2 x 1 Hx) as [Hmax Hmin].
  intros u [Hul Hur].
    unfold Rmin, Rmax in Hul, Hur.
    destruct Rle_dec; split; fourier.
pose (Hcv := ln_minus_cv_radius).
pose (g := weaksum_r Un 1 Hcv).
pose (dg := sum_r_derive Un 1 Hcv).
destruct Rint_derive2
  with (f := f) (a := 0) (b := x) (d := df) as [pr HI].
  intros u Hu.
  apply derivable_pt_lim_comp.
  apply derivable_pt_lim_minus.
  apply derivable_pt_lim_const.
  apply derivable_pt_lim_id.
  apply derivable_pt_lim_ln.
  apply Rgt_minus; apply (Hb u Hu).
  intros u Hu.
  apply continuity_pt_mult.
  apply continuity_pt_inv.
  apply continuity_pt_minus.
  apply continuity_pt_const; unfold constant; auto.
  apply derivable_continuous_pt; apply derivable_pt_id.
  apply Rgt_not_eq; apply Rgt_minus; apply (Hb u Hu).
  apply continuity_pt_minus.
  apply continuity_pt_const; unfold constant; auto.
  apply continuity_pt_const; unfold constant; auto.
assert (Heq : forall u, -1 < u < 1 -> dg u = df u).
  intros u [Hul Hur]; unfold df, dg.
  replace (/ (1 - u) * (0 - 1))
    with (- / (1 - u)) by (field; intros Hc; fourier).
  assert (Habs : Rabs u < 1).
    unfold Rabs; destruct Rcase_abs; fourier.
  assert (Hser1 := sum_r_derive_sums Un 1 Hcv u Habs).
  assert (Hser2 := GP_infinite u Habs).
  eapply Rseq_cv_unique.
    apply Hser1.
    assert (Hrw : - sum_f_R0 (fun n => 1 * u ^ n) ==
      sum_f_R0 (fun n => An_deriv Un n * u ^ n)).
      unfold An_deriv.
      unfold Rseq_opp; intros n; induction n.
        simpl; field.
        simpl sum_f_R0 at 1; rewrite Ropp_plus_distr.
        rewrite IHn.
        simpl; apply Rplus_eq_compat_l; destruct n.
          field.
          field; assert (H := pos_INR (S n)); intros Hc; fourier.
    eapply Rseq_cv_eq_compat; [apply Hrw|apply Rseq_cv_opp_compat; apply Hser2].
edestruct Rint_eq_compat
  with (f := df) (g := dg) (a := 0) (b := x) as [pr2 HI2].
  intros u Hu.
  apply Heq; apply Hb; assumption.
  exists pr; apply HI.
destruct Rint_derive2
  with (f := g) (a := 0) (b := x) (d := dg) as [pr3 HI3].
  intros u Hu.
  apply Pser_derivability.
  apply Hb in Hu.
  destruct Hu as [Hul Hur].
  unfold Rabs; destruct Rcase_abs; fourier.
  intros u Hu.
  assert (Hu2 := Hb u Hu).
  destruct Hu2 as [Hul Hur].
  assert (Hct : continuity_pt df u).
    unfold df.
    apply continuity_pt_mult.
    apply continuity_pt_inv; [|intros Hc; fourier].
    apply continuity_pt_minus.
    apply continuity_pt_const; unfold constant; auto.
    apply derivable_continuous_pt; apply derivable_pt_id.
    apply continuity_pt_const; unfold constant; auto.
  eapply continuity_pt_eq_compat; [|apply Hct].
    pose (alp1 := u / 2 + / 2).
    pose (alp2 := /2 - u / 2).
    exists (Rmin alp1 alp2); split.
    apply Rmin_pos.
      unfold alp1; fourier.
      unfold alp2; fourier.
    intros y Hy; symmetry.
    apply Heq.
    unfold alp1, alp2, R_dist, Rabs, Rmin in *.
    destruct Rcase_abs as [Hc|Hc] in Hy;
    destruct Rle_dec as [Hl|Hl] in Hy;
    split; try fourier.
    apply Rnot_le_lt in Hl; fourier.
assert (Hint : Rint dg 0 x (f x - f 0)).
  apply Rint_eq_compat with (f := df).
  intros u Hu.
  apply Heq; apply Hb; assumption.
  exists pr; assumption.
assert (Heq_fun : g x - g 0 = f x - f 0).
  eapply Rint_uniqueness.
    exists pr3; assumption.
    assumption.
replace (ln (1 - x)) with (weaksum_r Un 1 Hcv x).
  unfold sum, Hcv; reflexivity.
unfold f, g, comp, fct_cte, id, minus_fct in Heq_fun; hnf in Heq_fun.
replace (1 - 0) with 1 in Heq_fun by ring; rewrite ln_1 in Heq_fun.
rewrite Rminus_0_r in Heq_fun.
replace (weaksum_r Un 1 Hcv 0) with 0 in Heq_fun.
rewrite Rminus_0_r in Heq_fun; assumption.
symmetry.
eapply Rseq_cv_unique.
apply weaksum_r_sums; rewrite Rabs_R0; fourier.
intros eps Heps; exists 0%nat; intros n _.
rewrite sum_eq_R0.
rewrite R_dist_eq; assumption.
intros m _; unfold Un; destruct m.
  field.
  rewrite pow_ne_zero; [field|].
    apply not_0_INR; auto.
    auto.
Qed.

Lemma ln_minus_taylor :
  forall x, Rabs x < 1 -> Pser Un x (ln (1 - x)).
Proof.
intros x Hx.
rewrite <- ln_minus_taylor_sum; [|assumption].
apply weaksum_r_sums; assumption.
Qed.

End ln_minus.

(** * Taylor series of ln (1 + x) *)

Section ln_plus.

Let Un n :=
match n with
| 0 => 0
| _ => (- 1) ^ (S n) / (INR n)
end.

Lemma ln_plus_cv_radius : Cv_radius_weak Un 1.
exists 1; intros m [n Hn]; subst m.
unfold gt_abs_Pser.
rewrite pow1; rewrite Rmult_1_r.
unfold Un; destruct n.
  rewrite Rabs_R0; apply Rle_0_1.
  assert (Hle : 1 <= INR (S n)).
    rewrite S_INR.
    pattern 1 at 1; rewrite <- Rplus_0_l.
    apply Rplus_le_compat_r.
    apply pos_INR.
  unfold Rdiv; rewrite Rabs_mult.
  rewrite pow_1_abs; rewrite Rmult_1_l.
  rewrite Rabs_Rinv; [|intros Hc; fourier].
  rewrite Rabs_right; [|fourier].
  apply (Rmult_le_reg_l (INR (S n))); [fourier|].
  rewrite Rinv_r; [fourier|intros Hc; fourier].
Qed.

Let sum x := weaksum_r Un 1 ln_plus_cv_radius x.

Lemma ln_plus_taylor_sum :
  forall x, Rabs x < 1 -> sum x = (ln (1 + x)).
Proof.
intros x Hx.
assert (Hmx : Rabs (- x) < 1).
  rewrite Rabs_Ropp; assumption.
replace (1 + x) with (1 - (- x)) by ring.
eapply trans_eq; [|apply ln_minus_taylor_sum; assumption].
eapply Rseq_cv_unique.
  apply weaksum_r_sums; assumption.
eapply Rseq_cv_eq_compat; [|apply weaksum_r_sums; assumption].
intros n; apply sum_eq; intros i Hi; unfold Un.
destruct i; [field|].
replace (- x) with (- 1 * x) by ring.
rewrite Rpow_mult_distr.
repeat rewrite <- tech_pow_Rmult; field.
auto with real.
Qed.

Lemma ln_plus_taylor :
  forall x, Rabs x < 1 -> Pser Un x (ln (1 + x)).
Proof.
intros x Hx.
rewrite <- ln_plus_taylor_sum; [|assumption].
apply weaksum_r_sums; assumption.
Qed.

End ln_plus.


(* This file contains the specification of a lock module discussed
   in the section on the Fancy update modality and weakest precondition
   in the Iris Lecture Notes.
     Recall from loc. cit. that the point of this
   alternative lock specification is that it allows ones
   to allocate the lock before one knows what the resource
   of the invariant it is going to protect is.
*)

(* Contains definitions of the weakest precondition assertion, and its basic rules. *)
From iris.program_logic Require Export weakestpre.
From iris.prelude Require Import options.

(* Instantiation of Iris with the particular language. The notation file
   contains many shorthand notations for the programming language constructs, and
   the lang file contains the actual language syntax. *)
From iris.heap_lang Require Export notation lang.

(* Files related to the interactive proof mode. The first import includes the
   general tactics of the proof mode. The second provides some more specialized
   tactics particular to the instantiation of Iris to a particular programming
   language. *)
From iris.proofmode Require Export proofmode.
From iris.heap_lang Require Import proofmode.

(* Definition of invariants and their rules (expressed using the fancy update
   modality). *)
From iris.base_logic.lib Require Export invariants.

(* The exclusive resource algebra *)
From iris.algebra Require Import excl.

Section lock_model.
(* In order to do the proof we need to assume certain things about the
   instantiation of Iris. The particular, even the heap is handled in an
   analogous way as other ghost state. This line states that we assume the Iris
   instantiation has sufficient structure to manipulate the heap, e.g., it
   allows us to use the points-to predicate, and that the ghost state includes
   the exclusive resource algebra over the singleton set (represented using the
   unitR type). *)

  Context `{heapGS Σ}.
  Context `{inG Σ (exclR unitR)}.

  (* We use a ghost name with a token to model whether the lock is locked or not.
     The the token is just exclusive ownerwhip of unit value. *)
  Definition locked γ := own γ (Excl ()).

  (* The name of a lock. *)
  Definition lockN (l : loc) := nroot .@ "lock" .@ l.

  (* The lock invariant *)
  Definition is_lock γ l P :=
    inv (lockN l) ((l ↦ (#false) ∗ P ∗ locked γ) ∨
                                l ↦ (#true))%I.

  (* The is_lock predicate is persistent *)
  Global Instance is_lock_persistent γ l Φ : Persistent (is_lock γ l Φ).
  Proof. apply _. Qed.

End lock_model.

Section lock_code.

  (* Here is the standard spin lock code *)

  Definition newlock : val := λ: <>, ref #false.
  Definition acquire : val :=
    rec: "acquire" "l" :=
      if: CAS "l" #false #true then #() else "acquire" "l".
  Definition release : val := λ: "l", "l" <- #false.

End lock_code.

Section lock_spec.
  Context `{heapGS Σ}.
  Context `{inG Σ (exclR unitR)}.

  (* Here is the interesting part of this example, namely the new specification
     for newlock, which allows one to get a post-condition which can be instantiated
     with the lock invariant at some point later, when it is known.
     See the discussion in Iris Lecture Notes.
     First we show the specs using triples, and afterwards using weakest preconditions.
  *)

  Lemma wp_newlock_t :
    {{{ True }}} newlock #() {{{v, RET v; ∃ (l: loc) γ, ⌜v = #l⌝ ∧ (∀ P E, P ={E}=∗ is_lock γ l P) }}}.
  Proof.
    iIntros (φ) "Hi Hcont".
    rewrite /newlock.
    wp_lam.
    wp_alloc l as "HPt".
    iApply "Hcont".
    iExists l.
    iMod (own_alloc (Excl ())) as (γ) "Hld"; first done.
    iExists γ.
    iModIntro. iSplit; first done.
    iIntros (P E) "HP".
    iMod (inv_alloc _ _
           ((l ↦ (#false) ∗ P ∗ locked γ) ∨ l ↦ (#true))%I with "[-]")
      as "Hinv"; last eauto.
    { iNext; iLeft; iFrame. }
  Qed.

  Lemma wp_acquire_t E γ l P :
    nclose (lockN l) ⊆ E →
    {{{ is_lock γ l P }}} acquire (#l) @ E {{{v, RET #v; P ∗ locked γ}}}.
  Proof.
    iIntros (HE φ) "#Hi Hcont"; rewrite /acquire.
    iLöb as "IH".
    wp_rec.
    wp_bind (CmpXchg _ _ _).
    iInv (lockN l) as "[(Hl & HP & Ht)|Hl]" "Hcl".
    - wp_cmpxchg_suc.
      iMod ("Hcl" with "[Hl]") as "_"; first by iRight.
      iModIntro.
      wp_proj.
      wp_if.
      iApply "Hcont".
      by iFrame.
    - wp_cmpxchg_fail.
      iMod ("Hcl" with "[Hl]") as "_"; first by iRight.
      iModIntro.
      wp_proj.
      wp_if.
      iApply ("IH" with "[$Hcont]").
  Qed.

  Lemma wp_release_t E γ l P :
    nclose (lockN l) ⊆ E →
    {{{ is_lock γ l P ∗ locked γ ∗ P }}} release (#l) @ E {{{RET #(); True}}}.
  Proof.
    iIntros (HE φ) "(#Hi & Hld & HP) Hcont"; rewrite /release.
    wp_lam.
    iInv (lockN l) as "[(Hl & HQ & >Ht)|Hl]" "Hcl".
    - iDestruct (own_valid_2 with "Hld Ht") as %Hv. done.
    - wp_store.
      iMod ("Hcl" with "[-Hcont]") as "_"; first by iNext; iLeft; iFrame.
      iApply "Hcont".
      done.
  Qed.

  (* Here are the specifications again, just written using weakest preconditions *)

  Lemma wp_newlock :
    True ⊢ WP newlock #() {{v, ∃ (l: loc) γ, ⌜v = #l⌝ ∧ (∀ P E, P ={E}=∗ is_lock γ l P) }}.
  Proof.
    iIntros "_".
    rewrite /newlock.
    wp_lam.
    wp_alloc l as "HPt".
    iExists l.
    iMod (own_alloc (Excl ())) as (γ) "Hld"; first done.
    iExists γ.
    iModIntro. iSplit; first done.
    iIntros (P E) "HP".
    iMod (inv_alloc _ _
           ((l ↦ (#false) ∗ P ∗ locked γ) ∨ l ↦ (#true))%I with "[-]")
      as "Hinv"; last eauto.
    { iNext; iLeft; iFrame. }
  Qed.

  Lemma wp_acquire E γ l P :
    nclose (lockN l) ⊆ E →
    is_lock γ l P ⊢ WP acquire (#l) @ E {{v, P ∗ locked γ}}.
  Proof.
    iIntros (HE) "#Hi"; rewrite /acquire.
    iLöb as "IH".
    wp_rec.
    wp_bind (CmpXchg _ _ _).
    iInv (lockN l) as "[(Hl & HP & Ht)|Hl]" "Hcl".
    - wp_cmpxchg_suc.
      iMod ("Hcl" with "[Hl]") as "_"; first by iRight.
      iModIntro.
      wp_proj.
      wp_if.
      by iFrame.
    - wp_cmpxchg_fail.
      iMod ("Hcl" with "[Hl]") as "_"; first by iRight.
      iModIntro.
      wp_proj.
      wp_if.
      iApply "IH".
  Qed.

  Lemma wp_release E γ l P :
    nclose (lockN l) ⊆ E →
    is_lock γ l P ∗ locked γ ∗ P ⊢ WP release (#l) @ E {{v, True}}.
  Proof.
    iIntros (HE) "(#Hi & Hld & HP)"; rewrite /release.
    wp_lam.
    iInv (lockN l) as "[(Hl & HQ & >Ht)|Hl]" "Hcl".
    - iDestruct (own_valid_2 with "Hld Ht") as %Hv. done.
    - wp_store.
      iMod ("Hcl" with "[-]") as "_"; first by iNext; iLeft; iFrame.
      done.
  Qed.

  Global Opaque newlock release acquire.

  (* We now present a simple client of the lock which cannot be verified with the
     lock specification described in the Chapter on Invariants and Ghost State in the
     Iris Lecture Notes, but which can be specifed and verified with the current
     specification.
  *)
  Definition test : expr :=
    let: "l" := newlock #() in
    let: "r" := ref #0 in
    (λ: <>, acquire "l";; "r" <- !"r" + #1;; release "l").

  Lemma test_spec :
    {{{ True }}} test #() {{{ v, RET v; True }}}.
  Proof using Type*.
    iIntros (φ) "Hi HCont"; rewrite /test.
    wp_bind (newlock #())%E.
    iApply (wp_newlock_t); auto.
    iNext.
    iIntros (v) "Hs".
    wp_let.
    wp_bind (ref #0)%E.
    wp_alloc l as "Hl".
    wp_let.
    wp_seq.
    wp_bind (acquire v)%E.
    iDestruct "Hs" as (l' γ) "[% H2]".
    subst.
    iMod ("H2" $! (∃ (n : Z), l ↦ #n)%I with "[Hl]") as "#H3".
    { iExists 0; iFrame. }
    wp_apply (wp_acquire_t with "H3"); auto.
    iIntros (v) "(Hpt & Hlocked)".
    iDestruct "Hpt" as (u) "Hpt".
    wp_seq.
    wp_load.
    wp_op.
    wp_store.
    wp_apply (wp_release_t with "[-HCont]"); auto.
    iFrame "H3 Hlocked".
    iExists _; iFrame.
  Qed.
End lock_spec.

Typeclasses Opaque locked.
Global Opaque locked.
Typeclasses Opaque is_lock.
Global Opaque is_lock.


Require Import VST.floyd.proofauto.
Require Import VST.progs.message.

Instance CompSpecs : compspecs. make_compspecs prog. Defined.
Definition Vprog : varspecs. mk_varspecs prog. Defined.

(* This program, and its verification, are described in Chapter 29
   of _Program Logics for Certified Compilers_, by Appel et al., 2014 *)

Local Open Scope Z.
Local Open Scope logic.

(*   mf_assert msgfmt sh buf len data  := the [data] is formatted into a message
         at most [len] bytes,  stored starting at address [buf] with share [sh] *)

Record message_format (t: type) : Type :=
mf_build {
   mf_size: Z;
   mf_data_assert: forall (data: reptype t), Prop;
   mf_assert: forall (sh: share) (buf: val) (len: Z) (data: reptype t), mpred;
   mf_size_range:  0 <= mf_size <= Int.max_signed;
   mf_bufprop: forall sh buf len data,
           mf_assert sh buf len data |--
                 !!(0 <= len <= mf_size) && memory_block sh len buf;
   mf_restbuf := fun (sh: share) (buf: val) (len: Z) =>
          memory_block sh (mf_size-len) (offset_val len buf)
}.

Arguments mf_build {t}.
Arguments mf_size {t}.
Arguments mf_data_assert {t}.
Arguments mf_assert {t}.
Arguments mf_bufprop {t}.
Arguments mf_size_range {t}.
Arguments mf_restbuf {t}.

Lemma mf_assert_local_facts: forall t (mf: message_format t) sh buf len (data: reptype t),
   mf_assert mf sh buf len data |--
    !! (0 <= len <= mf_size mf /\ isptr buf).
Proof.
intros.
eapply derives_trans;[ apply mf_bufprop | ].
entailer!.
Qed.

Hint Resolve mf_assert_local_facts : saturate_local.

Definition t_struct_intpair := Tstruct _intpair noattr.
Definition t_struct_message := Tstruct _message noattr.

Program Definition intpair_message: message_format t_struct_intpair :=
  mf_build 8 (fun data => is_int I32 Signed (fst data) /\ is_int I32 Signed (snd data))
             (fun sh buf len data => !!(len=8/\ is_int I32 Signed (fst data) /\ is_int I32 Signed (snd data))
                           && data_at sh (tarray tint 2) [fst data; snd data] buf)
      _ _.
Next Obligation.
compute; split; congruence.
Qed.
Next Obligation.
  entailer!.
  change 8 with (sizeof (tarray tint 2)).
  apply data_at_memory_block.
Qed.

Definition serialize_spec {t: type} (format: message_format t) :=
  WITH data: reptype t, p: val, buf: val, sh: share, sh': share
  PRE [ tptr tvoid, tptr tuchar ]
          PROP (readable_share sh; writable_share sh';
                mf_data_assert format data;
                align_compatible tint buf)
          PARAMS (p; buf)
          SEP (data_at sh t data p;
                 memory_block sh' (mf_size format) buf)
  POST [ tint ]
         EX len: Z,
          PROP() RETURN (Vint (Int.repr len))
          SEP( data_at sh t data p;
                 mf_assert format sh' buf len data;
                 mf_restbuf format sh' buf len).

Definition deserialize_spec {t: type} (format: message_format t) :=
  WITH data: reptype t, p: val, buf: val, sh: share, sh': share, len: Z
  PRE [ tptr tvoid, tptr tuchar, tint ]
          PROP (readable_share sh'; writable_share sh;
                0 <= len <= mf_size format)
          PARAMS (p; buf; Vint (Int.repr len))
          SEP (mf_assert format sh' buf len data;
                 data_at_ sh t p)
  POST [ tvoid ]
          PROP (mf_data_assert format data)  RETURN ()
          SEP (mf_assert format sh' buf len data;
                 data_at sh t data p).

Definition intpair_serialize_spec :=
 DECLARE _intpair_serialize (serialize_spec intpair_message).

Definition intpair_deserialize_spec :=
 DECLARE _intpair_deserialize (deserialize_spec intpair_message).

Definition main_spec :=
 DECLARE _main
  WITH gv: globals
  PRE  [] main_pre prog tt gv
  POST [ tint ] main_post prog gv.

Definition message (sh: share) {t: type} (format: message_format t) (m: val) : mpred :=
  EX fg: val*val,
          func_ptr' (serialize_spec format) (fst fg) *
          func_ptr' (deserialize_spec format) (snd fg) *
       data_at sh t_struct_message (Vint (Int.repr (mf_size format)), (fst fg, snd fg)) m.

Definition Gprog : funspecs :=   ltac:(with_library prog [
    intpair_serialize_spec; intpair_deserialize_spec; main_spec]).

Lemma body_intpair_serialize: semax_body Vprog Gprog f_intpair_serialize intpair_serialize_spec.
Proof.
unfold intpair_serialize_spec.
unfold serialize_spec.
start_function.
destruct H as [Dx Dy].
destruct data as [[|x1 | | | | ] [|y1 | | | | ]]; try contradiction. clear Dx Dy.

change (mf_size intpair_message) with (sizeof (tarray tint 2)).
assert_PROP (field_compatible (tarray tint 2) [] buf).
  entailer!.
  hnf in H; decompose[and] H; repeat split; auto.
  (* TODO: abstract the following proof. *)
  unfold align_compatible in H0 |- *.
  destruct buf; auto.
  constructor.
  intros.
  eapply align_compatible_rec_by_value_inv in H0; [| reflexivity].
  econstructor; [reflexivity |].
  apply Z.divide_add_r; auto.
  exists i0; rewrite Z.mul_comm; auto.
rewrite memory_block_data_at_; auto.
change (data_at_ sh' (tarray tint 2) buf) with
   (data_at sh' (tarray tint 2) [Vundef;Vundef] buf).
forward. (* x = p->x; *)
forward. (* y = p->y; *)
forward. (*  ((int * )buf)[0]=x; *)
forward. (*  ((int * )buf)[1]=y; *)
forward. (* return 8; *)
Exists 8.
unfold mf_restbuf. simpl.
rewrite memory_block_zero.
entailer!.
Qed.

Lemma body_intpair_deserialize: semax_body Vprog Gprog f_intpair_deserialize intpair_deserialize_spec.
Proof.
unfold intpair_deserialize_spec, deserialize_spec.
start_function.
hnf in data; simpl in data. (* This speeds things up dramatically *)
simpl. Intros. subst len.
destruct data as [[|x1 | | | | ] [|y1 | | | | ]]; try contradiction.
clear H H1 H2.
forward. (* x = ((int * )buf)[0]; *)
forward. (* y = ((int * )buf)[1]; *)
forward. (* p->x = x; *)
forward. (* p->y = y; *)
entailer!.
split; simpl; auto.
unfold mf_assert.
simpl.
entailer!.
Qed.

Lemma body_main: semax_body Vprog Gprog f_main main_spec.
Proof.
name buf _buf.
function_pointers.
start_function.
set (ipm := gv _intpair_message).
fold cc_default noattr.
make_func_ptr _intpair_deserialize.
make_func_ptr _intpair_serialize.
set (des := gv _intpair_deserialize).
set (ser := gv _intpair_serialize).
match goal with
 |- context [mapsto_zeros 4 Ews _] =>
  (* 64-bit mode *)
  sep_apply mapsto_zeros_memory_block; auto;
  gather_SEP (mapsto _ _ _ (offset_val 0 des))
      (mapsto _ _ _ (offset_val 0 ser))
      (memory_block Ews 4 _)
      (data_at _ _ _ ipm)
 | _ => (*32-bit mode *)
  gather_SEP (mapsto _ _ _ (offset_val 0 des))
      (mapsto _ _ _ (offset_val 0 ser))
      (data_at _ _ _ ipm)
end.
replace_SEP 0
    (data_at Ews t_struct_message
      (Vint (Int.repr (mf_size intpair_message)), (ser, des)) ipm). {
 entailer!.
 unfold_data_at (data_at _ t_struct_message _ ipm).
 rewrite (field_at_data_at _ _ _ _ ipm).
rewrite data_at_tuint_tint.
(* rewrite <- (mapsto_field_at _ _ [StructField _bufsize] (Vint (Int.repr 8))) by auto with field_compatible. *)
 rewrite <- (mapsto_field_at _ _ [StructField _deserialize] des) by auto with field_compatible.
 rewrite <- (mapsto_field_at _ _ [StructField _serialize] ser) by auto with field_compatible.
 rewrite !field_compatible_field_address by auto with field_compatible.
 simpl.
 normalize.
 unfold spacer, at_offset; simpl.
 cancel.
}
forward. (* p.x = 1; *)
forward. (* p.y = 2; *)
forward. (* ser = intpair_message.serialize; *)

rewrite <- memory_block_data_at__tarray_tuchar_eq by computable.
change (memory_block Tsh 8 buf)
with (memory_block Tsh (mf_size intpair_message) buf).

assert_PROP (align_compatible tint buf).
  entailer!.
  destruct HPbuf; subst; simpl.
  econstructor; [reflexivity | apply Z.divide_0_r].
forward_call (* len = ser(&p, buf); *)
      ((Vint (Int.repr 1), Vint (Int.repr 2)), v_p, buf, Tsh, Tsh).
  split3; auto.
  repeat split; auto.
Intros rest.
simpl.
Intros. subst rest.

forward. (* des = intpair_message.deserialize; *)
forward_call (* des(&q, buf, 8); *)
        ((Vint (Int.repr 1), Vint (Int.repr 2)), v_q, buf, Tsh, Tsh, 8).
  simpl. fold t_struct_intpair. entailer!.
  split3; auto. simpl; computable.
(* after the call *)
forward. (* x = q.x; *)
forward. (* y = q.y; *)
forward. (* return x+y; *)
simpl.
entailer!.
sep_apply (data_at_memory_block Tsh (tarray tint 2) [Vint (Int.repr 1); Vint (Int.repr 2)] buf).
unfold sizeof; simpl Ctypes.sizeof.
sep_apply (memory_block_data_at__tarray_tuchar Tsh buf 8).
   computable.
entailer!.
Qed.


(**
This file is part of the Coquelicot formalization of real
analysis in Coq: http://coquelicot.saclay.inria.fr/

Copyright (C) 2011-2015 Sylvie Boldo
#
#
Copyright (C) 2011-2015 Catherine Lelay
#
#
Copyright (C) 2011-2015 Guillaume Melquiond
#
#
Copyright (C) 2016-2017 Thomas Sibut-Pinote

This library is free software; you can redistribute it and/or
modify it under the terms of the GNU Lesser General Public
License as published by the Free Software Foundation; either
version 3 of the License, or (at your option) any later version.

This library 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
COPYING file for more details.
*)

From Coq Require Import Reals Psatz ssreflect ssrbool.
From mathcomp Require Import eqtype seq.

Require Import Markov Rcomplements Rbar Lub Lim_seq Derive SF_seq.
Require Import Continuity Hierarchy Seq_fct RInt PSeries.

(** This file contains results about the integral as a function:
 continuity, differentiability, and composition. Theorems on
 parametric integrals are also provided. *)

(** * Continuity *)

Section Continuity.

Context {V : NormedModule R_AbsRing}.

Lemma continuous_RInt_0 :
  forall (f : R -> V) (a : R) If,
    locally a (fun x => is_RInt f a x (If x))
    -> continuous If a.
Proof.
  move => f a If [d1 /= CIf].
  assert (forall eps : posreal, norm (If a) < eps).
    move => eps.
    generalize (fun Hy => proj1 (filterlim_locally_ball_norm _ _) (CIf a Hy) eps)
      => /= {CIf} CIf.
      assert (Rabs (a + - a) < d1).
        rewrite -/(Rminus _ _) Rminus_eq_0 Rabs_R0.
        by apply d1.
      destruct (CIf H) as [d CIf'].
      assert (exists y : SF_seq,
        seq_step (SF_lx y) < d /\
        pointed_subdiv y /\
        SF_h y = Rmin a a /\ seq.last (SF_h y) (SF_lx y) = Rmax a a).
        apply filter_ex.
        exists d => y Hy Hy'.
        now split.
      case: H0 => {CIf H} ptd [Hstep Hptd].
      specialize (CIf' ptd Hstep Hptd).
      rewrite Rminus_eq_0 sign_0 in CIf'.
      rewrite -norm_opp.
      replace (opp (If a)) with (minus (scal 0 (Riemann_sum f ptd)) (If a)).
      by apply CIf'.
      replace (scal 0 (Riemann_sum f ptd) : V) with (zero : V).
      by rewrite /minus plus_zero_l.
      apply sym_eq ; apply: scal_zero_l.
  apply filterlim_locally_ball_norm.
  cut (forall eps : posreal, locally a (fun x : R => norm (If x) < eps)).
    move => H0 eps.
    specialize (H (pos_div_2 eps)).
    specialize (H0 (pos_div_2 eps)).
    destruct H0 as [d Hd].
    exists d => /= y Hy.
    apply Rle_lt_trans with (norm (If y) + norm (If a))%R.
    rewrite -(norm_opp (If a)).
    apply @norm_triangle.
    rewrite (double_var eps).
    apply Rplus_lt_compat.
    now apply Hd.
    by apply H.
  clear H.
  move => eps.
  destruct (ex_RInt_ub f (a - d1 / 2) (a + d1 / 2)) as [Mf HMf].
    apply ex_RInt_Chasles with a.
    apply ex_RInt_swap ; eexists ; apply CIf.
    rewrite /ball /= /AbsRing_ball /= /abs /minus /plus /opp /=.
    field_simplify (a - d1 / 2 + - a)%R.
    rewrite Rabs_left.
    apply Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1.
    by apply is_pos_div_2.
    apply Ropp_lt_cancel ; field_simplify ; rewrite ?Rdiv_1.
    by apply is_pos_div_2.
    eexists ; apply CIf.
    rewrite /ball /= /AbsRing_ball /= /abs /minus /plus /opp /=.
    field_simplify (a + d1 / 2 + - a)%R.
    rewrite Rabs_pos_eq.
    apply Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1.
    by apply is_pos_div_2.
    apply Rlt_le ; field_simplify ; rewrite ?Rdiv_1.
    by apply is_pos_div_2.
  assert ((a - d1 / 2) <= (a + d1 / 2)).
    apply Rminus_le_0.
    replace (a + d1 / 2 - (a - d1 / 2))%R with (d1 : R) by field.
    by apply Rlt_le, d1.
  move: HMf ; rewrite /Rmin /Rmax ; case: Rle_dec => // _ HMf.
  assert (0 <= Mf).
    eapply Rle_trans.
    2: apply (HMf (a - d1 / 2)%R) ; split => // ; by apply Rle_refl.
    by apply norm_ge_0.
  generalize (fun y Hy => proj1 (filterlim_locally_ball_norm _ _) (CIf y Hy) (pos_div_2 eps))
    => /= {CIf} CIf.
  assert (0 < Rmin (d1 / 2) (eps / (2 * (Mf + 1)))).
    apply Rmin_case.
    by apply is_pos_div_2.
    apply Rdiv_lt_0_compat.
    by apply eps.
    apply Rmult_lt_0_compat.
    by apply Rlt_0_2.
    apply Rplus_le_lt_0_compat.
    by [].
    by apply Rlt_0_1.
  set (d2 := mkposreal _ H1).
  exists d2 => x /= Hx.
  specialize (CIf x).
  destruct CIf as [d' CIf].
  apply Rlt_trans with (1 := Hx).
  apply Rle_lt_trans with (1 := Rmin_l _ _).
  apply Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1 ; by apply is_pos_div_2.
  assert (exists y0, seq_step (SF_lx y0) < d' /\
      pointed_subdiv y0 /\
      SF_h y0 = Rmin a x /\ seq.last (SF_h y0) (SF_lx y0) = Rmax a x).
    apply filter_ex.
    exists d' => y Hy Hy'.
    now split.
    case: H2 => ptd [Hstep Hptd].
    specialize (CIf ptd Hstep Hptd).
  rewrite -norm_opp.
  replace (opp (If x)) with
    (minus (minus (scal (sign (x - a)) (Riemann_sum f ptd)) (If x)) (scal (sign (x - a)) (Riemann_sum f ptd))).
  2: rewrite /minus plus_comm plus_assoc plus_opp_l.
  2: by apply plus_zero_l.
  apply Rle_lt_trans with (norm (minus (scal (sign (x - a)) (Riemann_sum f ptd)) (If x))
    + norm (opp (scal (sign (x - a)) (Riemann_sum f ptd))))%R.
  rewrite /minus ; by apply @norm_triangle.
  rewrite norm_opp (double_var eps).
  apply Rplus_lt_le_compat.
  by [].
  apply Rle_trans with (1 := norm_scal (sign (x - a)) _).
  apply Rle_trans with (1 * norm (Riemann_sum f ptd)).
  apply Rmult_le_compat_r.
  apply norm_ge_0.
  rewrite /abs /= /sign ; case: total_order_T => [[H2|H2]|H2].
  rewrite Rabs_R1.
  apply Rle_refl.
  rewrite Rabs_R0.
  apply Rle_0_1.
  rewrite Rabs_Ropp Rabs_R1.
  apply Rle_refl.
  rewrite Rmult_1_l.
  apply Rle_trans with (Riemann_sum (fun _ => Mf) ptd).
  apply Riemann_sum_norm.
  apply Hptd.
  move => t.
  rewrite (proj2 (proj2 Hptd)) (proj1 (proj2 Hptd)) => Ht.
  apply HMf ; split ; eapply Rle_trans ; try apply Ht.
  apply Rmin_case.
  apply Rlt_le, Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1 ; by apply is_pos_div_2.
  apply Rlt_le, Rabs_lt_between'.
  apply Rlt_le_trans with (1 := Hx).
  by apply Rmin_l.
  apply Rmax_case.
  apply Rlt_le, Rminus_lt_0 ; field_simplify ; rewrite ?Rdiv_1 ; by apply is_pos_div_2.
  apply Rlt_le, Rabs_lt_between'.
  apply Rlt_le_trans with (1 := Hx).
  by apply Rmin_l.
  rewrite Riemann_sum_const.
  rewrite (proj2 (proj2 Hptd)) (proj1 (proj2 Hptd)) /=.
  apply Rle_trans with (Rabs (x + - a) * Mf)%R.
  apply Rmult_le_compat_r.
  by [].
  rewrite /Rmin /Rmax ; case: Rle_dec => _.
  apply Rle_abs.
  rewrite -Ropp_minus_distr.
  apply Rabs_maj2.
  apply Rle_trans with (Rabs (x + - a) * (Mf + 1))%R.
  apply Rmult_le_compat_l.
  by apply Rabs_pos.
  apply Rminus_le_0 ; ring_simplify ; by apply Rle_0_1.
  apply Rle_div_r.
  apply Rlt_le_trans with (1 := Rlt_0_1).
  apply Rminus_le_0 ; by ring_simplify.
  apply Rlt_le, Rlt_le_trans with (1 := Hx).
  apply Rle_trans with (1 := Rmin_r _ _).
  apply Req_le ; field.
  apply Rgt_not_eq, Rlt_le_trans with (1 := Rlt_0_1).
  apply Rminus_le_0 ; by ring_simplify.
Qed.

Lemma continuous_RInt_1 (f : R -> V) (a b : R) (If : R -> V) :
  locally b (fun z : R => is_RInt f a z (If z))
  -> continuous If b.
Proof.
  intros.
  generalize (locally_singleton _ _ H) => /= Hab.
  apply continuous_ext with (fun z => plus (If b) (minus (If z) (If b))) ; simpl.
  intros x.
  by rewrite plus_comm -plus_assoc plus_opp_l plus_zero_r.
  eapply filterlim_comp_2, filterlim_plus.
  apply filterlim_const.
  apply (continuous_RInt_0 f _ (fun x : R_UniformSpace => minus (If x) (If b))).
  apply: filter_imp H => x Hx.
  rewrite /minus plus_comm.
  eapply is_RInt_Chasles, Hx.
  by apply is_RInt_swap.
Qed.
Lemma continuous_RInt_2 (f : R -> V) (a b : R) (If : R -> V) :
  locally a (fun z : R => is_RInt f z b (If z))
  -> continuous If a.
Proof.
  intros.
  generalize (locally_singleton _ _ H) => /= Hab.
  apply continuous_ext with (fun z => opp (plus (opp (If a)) (minus (If a) (If z)))) ; simpl.
  intros x.
  by rewrite /minus plus_assoc plus_opp_l plus_zero_l opp_opp.
  apply continuous_opp.
  apply continuous_plus.
  apply filterlim_const.
  apply (continuous_RInt_0 f _ (fun x : R_UniformSpace => minus (If a) (If x))).
  apply: filter_imp H => x Hx.
  eapply is_RInt_Chasles.
  by apply Hab.
  by apply is_RInt_swap.
Qed.
Lemma continuous_RInt (f : R -> V) (a b : R) (If : R -> R -> V) :
  locally (a,b) (fun z : R * R => is_RInt f (fst z) (snd z) (If (fst z) (snd z)))
  -> continuous (fun z : R * R => If (fst z) (snd z)) (a,b).
Proof.
  intros HIf.
  move: (locally_singleton _ _ HIf) => /= Hab.
  apply continuous_ext_loc
    with (fun z : R * R => plus (If (fst z) b) (plus (opp (If a b)) (If a (snd z)))) ; simpl.
    assert (Ha : locally (a,b) (fun z : R * R => is_RInt f a (snd z) (If a (snd z)))).
      case: HIf => /= d HIf.
      exists d => y /= Hy.
      apply (HIf (a,(snd y))) ; split => //=.
      by apply ball_center.
      by apply Hy.
    assert (Hb : locally (a,b) (fun z : R * R => is_RInt f (fst z) b (If (fst z) b))).
      case: HIf => /= d HIf.
      exists d => x /= Hx.
      apply (HIf (fst x,b)) ; split => //=.
      by apply Hx.
      by apply ball_center.
    generalize (filter_and _ _ HIf (filter_and _ _ Ha Hb)).
    apply filter_imp => {HIf Ha Hb} /= x [HIf [Ha Hb]].
    apply eq_close.
    eapply filterlim_locally_close.
    eapply is_RInt_Chasles.
    by apply Hb.
    eapply is_RInt_Chasles.
    by apply is_RInt_swap, Hab.
    by apply Ha.
    by apply HIf.
  eapply filterlim_comp_2, filterlim_plus ; simpl.
  apply (continuous_comp (fun x => fst x) (fun x => If x b)) ; simpl.
  apply continuous_fst.
  eapply (continuous_RInt_2 f _ b).
    case: HIf => /= d HIf.
    exists d => x /= Hx.
    apply (HIf (x,b)).
    split => //=.
    by apply ball_center.
  eapply filterlim_comp_2, filterlim_plus ; simpl.
  apply filterlim_const.
  apply (continuous_comp (fun x => snd x) (fun x => If a x)) ; simpl.
  apply continuous_snd.
  eapply (continuous_RInt_1 f a b).
    case: HIf => /= d HIf.
    exists d => x /= Hx.
    apply (HIf (a,x)).
    split => //=.
    by apply ball_center.
Qed.

End Continuity.

Lemma ex_RInt_locally {V : CompleteNormedModule R_AbsRing} (f : R -> V) (a b : R) :
  ex_RInt f a b
  -> (exists eps : posreal, ex_RInt f (a - eps) (a + eps))
  -> (exists eps : posreal, ex_RInt f (b - eps) (b + eps))
  -> locally (a,b) (fun z : R * R => ex_RInt f (fst z) (snd z)).
Proof.
  intros Hf (ea,Hea) (eb,Heb).
  exists (mkposreal _ (Rmin_stable_in_posreal ea eb)) => [[a' b'] [Ha' Hb']] ; simpl in *.
  apply ex_RInt_Chasles with (a - ea).
  eapply ex_RInt_swap, ex_RInt_Chasles_1 ; try eassumption.
  apply Rabs_le_between'.
  eapply Rlt_le, Rlt_le_trans, Rmin_l.
  by apply Ha'.
  apply ex_RInt_Chasles with a.
  eapply ex_RInt_Chasles_1 ; try eassumption.
  apply Rabs_le_between'.
  rewrite Rminus_eq_0 Rabs_R0.
  by apply Rlt_le, ea.
  apply ex_RInt_Chasles with b => //.
  apply ex_RInt_Chasles with (b - eb).
  eapply ex_RInt_swap, ex_RInt_Chasles_1; try eassumption.
  apply Rabs_le_between'.
  rewrite Rminus_eq_0 Rabs_R0.
  by apply Rlt_le, eb.
  eapply ex_RInt_Chasles_1 ; try eassumption.
  apply Rabs_le_between'.
  eapply Rlt_le, Rlt_le_trans, Rmin_r.
  by apply Hb'.
Qed.

(** * Riemann integral and differentiability *)

Section Derive.

Context {V : NormedModule R_AbsRing}.

Lemma is_derive_RInt_0 (f If : R -> V) (a : R) :
  locally a (fun b : R => is_RInt f a b (If b))
  -> continuous f a
  -> is_derive If a (f a).
Proof.
  intros HIf Hf.
  split ; simpl.
  apply is_linear_scal_l.
  intros y Hy.
  apply @is_filter_lim_locally_unique in Hy.
  rewrite -Hy {y Hy}.
  intros eps.
  generalize (proj1 (filterlim_locally _ _) Hf) => {Hf} Hf.
  eapply filter_imp.
  simpl ; intros y Hy.
  replace (If a) with (@zero V).
  rewrite @minus_zero_r.
  rewrite Rmult_comm ; eapply norm_RInt_le_const_abs ; last first.
  apply is_RInt_minus.
  instantiate (1 := f).
  eapply (proj1 Hy).
  apply is_RInt_const.
  simpl.
  apply (proj2 Hy).
  apply locally_singleton in HIf.
  assert (HIf_0 := is_RInt_point f a).
  apply (filterlim_locally_unique _ _ _ HIf_0 HIf).

  apply filter_and.
  by apply HIf.

  assert (0 < eps / @norm_factor _ V).
    apply Rdiv_lt_0_compat.
    by apply eps.
    by apply norm_factor_gt_0.
  case: (Hf (mkposreal _ H)) => {Hf} delta Hf.
  exists delta ; intros y Hy z Hz.
  eapply Rle_trans.
  apply Rlt_le, norm_compat2.
  apply Hf.
  apply Rabs_lt_between'.
  move/Rabs_lt_between': Hy => Hy.
  rewrite /Rmin /Rmax in Hz ; destruct (Rle_dec a y) as [Hxy | Hxy].
  split.
  eapply Rlt_le_trans, Hz.
  apply Rminus_lt_0 ; ring_simplify.
  by apply delta.
  eapply Rle_lt_trans, Hy.
  by apply Hz.
  split.
  eapply Rlt_le_trans, Hz.
  by apply Hy.
  eapply Rle_lt_trans.
  apply Hz.
  apply Rminus_lt_0 ; ring_simplify.
  by apply delta.
  simpl ; apply Req_le.
  field.
  apply Rgt_not_eq, norm_factor_gt_0.
Qed.

Lemma is_derive_RInt (f If : R -> V) (a b : R) :
  locally b (fun b => is_RInt f a b (If b))
  -> continuous f b
  -> is_derive If b (f b).
Proof.
  intros HIf Hf.
  apply is_derive_ext with (fun y => (plus (minus (If y) (If b)) (If b))).
  simpl ; intros.
  rewrite /minus -plus_assoc plus_opp_l.
  by apply plus_zero_r.
  evar_last.
  apply is_derive_plus.
  apply is_derive_RInt_0.
  2: apply Hf.
  eapply filter_imp.
  intros y Hy.
  evar_last.
  apply is_RInt_Chasles with a.
  apply is_RInt_swap.
  3: by apply plus_comm.
  by apply locally_singleton in HIf.
  by apply Hy.
  by apply HIf.
  apply is_derive_const.
  by apply plus_zero_r.
Qed.

Lemma is_derive_RInt' (f If : R -> V) (a b : R) :
  locally a (fun a => is_RInt f a b (If a))
  -> continuous f a
  -> is_derive If a (opp (f a)).
Proof.
  intros.
  apply is_derive_ext with (fun x => opp (opp (If x))).
  intros ; by rewrite opp_opp.
  apply is_derive_opp.
  apply is_derive_RInt with b => //.
  move: H ; apply filter_imp.
  intros x Hx.
  by apply is_RInt_swap.
Qed.

Lemma filterdiff_RInt (f : R -> V) (If : R -> R -> V) (a b : R) :
  locally (a,b) (fun u : R * R => is_RInt f (fst u) (snd u) (If (fst u) (snd u)))
  -> continuous f a -> continuous f b
  -> filterdiff (fun u : R * R => If (fst u) (snd u)) (locally (a,b))
                (fun u : R * R => minus (scal (snd u) (f b)) (scal (fst u) (f a))).
Proof.
  intros Hf Cfa Cfb.

  assert (Ha : locally a (fun a : R => is_RInt f a b (If a b))).
    case: Hf => /= e He.
    exists e => x Hx.
    apply (He (x,b)).
    split => //.
    by apply ball_center.
  assert (Hb : locally b (fun b : R => is_RInt f a b (If a b))).
    case: Hf => /= e He.
    exists e => x Hx.
    apply (He (a,x)).
    split => //.
    by apply ball_center.

  eapply filterdiff_ext_lin.

  apply (filterdiff_ext_loc (FF := @filter_filter _ _ (locally_filter _)) (fun u : R * R => plus (If (fst u) b) (minus (If a (snd u)) (If a b)))) ;
  last first.
  apply filterdiff_plus_fct.
  apply (filterdiff_comp' (fun u : R * R => fst u) (fun a : R => If a b)).
  by apply filterdiff_linear, is_linear_fst.
  eapply is_derive_RInt', Cfa.
  by apply Ha.
  apply filterdiff_plus_fct.
  apply (filterdiff_comp' (fun u : R * R => snd u) (fun b : R => If a b)).
  by apply filterdiff_linear, is_linear_snd.
  eapply is_derive_RInt, Cfb.
  by apply Hb.
  apply filterdiff_const.

  move => /= x Hx.
  apply @is_filter_lim_locally_unique in Hx.
  by rewrite -Hx /= minus_eq_zero plus_zero_r.
  simpl.

  have : (locally (a,b) (fun u : R * R => is_RInt f (fst u) b (If (fst u) b))) => [ | {Ha} Ha].
    case: Ha => /= e He.
    exists e => y Hy.
    apply He, Hy.
  have : (locally (a,b) (fun u : R * R => is_RInt f a (snd u) (If a (snd u)))) => [ | {Hb} Hb].
    case: Hb => /= e He.
    exists e => y Hy.
    apply He, Hy.
  move: (locally_singleton _ _ Hf) => /= Hab.
  generalize (filter_and _ _ Hf (filter_and _ _ Ha Hb)).
  apply filter_imp => {Hf Ha Hb} /= u [Hf [Ha Hb]].
  apply sym_eq, (filterlim_locally_unique _ _ _ Hf).
  apply is_RInt_Chasles with b => //.
  rewrite /minus plus_comm.
  apply is_RInt_Chasles with a => //.
  by apply is_RInt_swap.
  simpl => y.
  rewrite scal_opp_r plus_zero_r.
  apply plus_comm.
Qed.

End Derive.

Lemma Derive_RInt (f : R -> R) (a b : R) :
  locally b (ex_RInt f a) -> continuous f b
  -> Derive (RInt f a) b = f b.
Proof.
  intros If Cf.
  apply is_derive_unique, (is_derive_RInt _ _ a) => //.
  move: If ; apply filter_imp => y.
  exact: RInt_correct.
Qed.
Lemma Derive_RInt' (f : R -> R) (a b : R) :
  locally a (fun a => ex_RInt f a b) -> continuous f a
  -> Derive (fun a => RInt f a b) a = - f a.
Proof.
  intros If Cf.
  eapply is_derive_unique, (is_derive_RInt' (V := R_NormedModule) _ _ a b) => //.
  move: If ; apply filter_imp => y.
  exact: RInt_correct.
Qed.

Section Derive'.

Context {V : CompleteNormedModule R_AbsRing}.

Lemma is_RInt_derive (f df : R -> V) (a b : R) :
  (forall x : R, Rmin a b <= x <= Rmax a b -> is_derive f x (df x)) ->
  (forall x : R, Rmin a b <= x <= Rmax a b -> continuous df x) ->
  is_RInt df a b (minus (f b) (f a)).
Proof.
intros Hf Hdf.
wlog Hab: a b Hf Hdf / (a < b).
  intros H.
  destruct (Rlt_or_le a b) as [Hab|Hab].
    exact: H.
  destruct Hab as [Hab|Hab].
  + rewrite -(opp_opp (minus _ _)).
    apply: is_RInt_swap.
    rewrite opp_minus.
    apply H.
      by rewrite Rmin_comm Rmax_comm.
    by rewrite Rmin_comm Rmax_comm.
    easy.
  + rewrite Hab.
    rewrite /minus plus_opp_r.
    by apply: is_RInt_point.
rewrite Rmin_left in Hf; last by lra.
rewrite Rmax_right in Hf; last by lra.
rewrite Rmin_left in Hdf; last by lra.
rewrite Rmax_right in Hdf; last by lra.
have Hminab : Rmin a b = a by rewrite Rmin_left; lra.
have Hmaxab : Rmax a b = b by rewrite Rmax_right; lra.
evar_last.
  apply RInt_correct.
  apply (ex_RInt_continuous df) => t Ht.
  rewrite Hminab Hmaxab in Ht.
  exact:Hdf.
apply (plus_reg_r (opp (f b))).
rewrite /minus -plus_assoc (plus_comm (opp _)) plus_assoc plus_opp_r.
rewrite -(RInt_point a df).
apply: sym_eq.
have Hext :  forall x : R, Rmin a b < x < Rmax a b -> extension_C0 df a b x = df x.
  move => x; rewrite Hminab Hmaxab => Hx.
  by rewrite extension_C0_ext //=; lra.
rewrite -(RInt_ext _ _ _ _ Hext).
rewrite RInt_point -(RInt_point a (extension_C0 df a b)).
rewrite -!(extension_C1_ext f df a b) /=; try lra.
apply: (eq_is_derive (fun t => minus (RInt _ a t) (_ t))) => // t Ht.
have -> : zero = minus (extension_C0 df a b t) (extension_C0 df a b t) by rewrite minus_eq_zero.
apply: is_derive_minus; last first.
  apply: extension_C1_is_derive => /=; first by lra.
    by move => x Hax Hxb; apply: Hf; lra.
    apply: (is_derive_RInt _ _  a).
    apply: filter_forall.
    move => x; apply: RInt_correct.
    apply: ex_RInt_continuous.
    move => z Hz; apply: extension_C0_continuous => /=; try lra.
    by move => x0 Hax0 Hx0b; apply: Hdf; lra.
apply: extension_C0_continuous => /=; try lra.
move => x0 Hax0 Hx0b; apply: Hdf; lra.
Qed.

End Derive'.

Lemma RInt_Derive (f : R -> R) (a b : R):
  (forall x, Rmin a b <= x <= Rmax a b -> ex_derive f x) ->
  (forall x, Rmin a b <= x <= Rmax a b -> continuous (Derive f) x) ->
  RInt (Derive f) a b = f b - f a.
Proof.
intros Df Cdf.
apply is_RInt_unique.
apply: is_RInt_derive => //.
intros ; by apply Derive_correct, Df.
Qed.

(** ** Composition *)

Section Comp.

Context {V : CompleteNormedModule R_AbsRing}.

(* Notation consistent version of the lemmas used in is_RInt_comp *)

Lemma IVT_gen_consistent (f : R -> R) (a b y : R) :
  (forall x, continuous f x)
  -> Rmin (f a) (f b) <= y <= Rmax (f a) (f b)
  -> { x : R | Rmin a b <= x <= Rmax a b /\ f x = y }.
Proof.
  move => Hf.
  apply: IVT_gen.
  move => x. apply continuity_pt_filterlim.  exact: Hf.
Qed.

Lemma continuous_ab_maj_consistent :
forall (f : R -> R) (a b : R),
a <= b ->
(forall c : R, a <= c <= b -> continuous f c) ->
exists Mx : R, (forall c : R, a <= c <= b -> f c <= f Mx) /\ a <= Mx <= b.
Proof.
  move => f a b Hab Hc.
  apply: continuity_ab_maj => // .
  by move => c Hc1; apply continuity_pt_filterlim; exact: Hc.
Qed.

Lemma continuous_ab_min_consistent :
forall (f : R -> R) (a b : R),
a <= b ->
(forall c : R, a <= c <= b -> continuous f c) ->
exists mx : R, (forall c : R, a <= c <= b -> f mx <= f c) /\ a <= mx <= b.
Proof.
  move => f a b Hab Hc.
  apply: continuity_ab_min => // .
  by move => c Hc1; apply continuity_pt_filterlim; exact: Hc.
Qed.

Lemma is_RInt_comp (f : R -> V) (g dg : R -> R) (a b : R) :
  (forall x, Rmin a b <= x <= Rmax a b -> continuous f (g x)) ->
  (forall x, Rmin a b <= x <= Rmax a b -> is_derive g x (dg x) /\ continuous dg x) ->
  is_RInt (fun y => scal (dg y) (f (g y))) a b (RInt f (g a) (g b)).
Proof.
  wlog: a b / (a  [Hw|Hab].
    case: (total_order_T a b) => [[Hab'|Hab']|Hab'] Hf Hg.
    - exact: Hw.
    - rewrite Hab'.
      by rewrite RInt_point; apply: is_RInt_point.
    - rewrite <- (opp_opp (RInt f _ _)).
      apply: is_RInt_swap.
      rewrite opp_RInt_swap.
        apply Hw => // .
        by rewrite Rmin_comm Rmax_comm.
      by rewrite Rmin_comm Rmax_comm.

    apply: ex_RInt_continuous => z Hz.
    case: (IVT_gen_consistent (extension_C0 g b a) b a z).
    + apply: extension_C0_continuous => /=; try lra.
      move => x Hbx Hxa; apply: ex_derive_continuous.
      by exists (dg x); apply Hg; rewrite Rmin_right ?Rmax_left; try lra.
    + rewrite !(extension_C0_ext) /=; try lra.
      by rewrite Rmin_comm Rmax_comm.
    + move => x [Hx1 Hx2].
      rewrite -Hx2.
      rewrite Rmin_left ?Rmax_right in Hx1; try lra.
      rewrite (extension_C0_ext) /=; try lra.
      apply: Hf.
      by move: Hx1; rewrite Rmin_right ?Rmax_left; lra.
      rewrite -> Rmin_left by now apply Rlt_le.
      rewrite -> Rmax_right by now apply Rlt_le.

  wlog: g dg / (forall x : R, is_derive g x (dg x) /\ continuous dg x) => [Hw Hf Hg | Hg Hf _].
    rewrite -?(extension_C1_ext g dg a b) ; try by [left | right].
    set g0 := extension_C1 g dg a b.
    set dg0 := extension_C0 dg a b.
    apply is_RInt_ext with (fun y : R => scal (dg0 y) (f (g0 y))).
    + rewrite /Rmin /Rmax /g0 ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _ x Hx.
      apply f_equal2.
        by apply extension_C0_ext ; by apply Rlt_le, Hx.
      by apply f_equal, extension_C1_ext ; by apply Rlt_le, Hx.
    + apply Hw.
      * intros x ; split.
        apply extension_C1_is_derive.
          by apply Rlt_le.
            by intros ; apply Hg ; by split.
      * apply @extension_C0_continuous.
          by apply Rlt_le.
        intros ; apply Hg ; by split.
      * intros ; rewrite /g0 extension_C1_ext.
          by apply Hf.
          by apply H.
          by apply H.
    intros ; split.
      apply extension_C1_is_derive.
        by apply Rlt_le.
      intros ; apply Hg ; by split.
    apply @extension_C0_continuous.
      by apply Rlt_le.
    by intros ; apply Hg ; by split.

    have cg : forall x, continuous g x.
      move => t Ht; apply: ex_derive_continuous.
      by exists (dg t); apply Hg.

  wlog: f Hf / (forall x, continuous f x) => [Hw | {Hf} Hf].
    case: (continuous_ab_maj_consistent g a b (Rlt_le _ _ Hab)) => [ | M HM].
      move => x Hx; apply: ex_derive_continuous.
      by exists (dg x); apply Hg.
    case: (continuous_ab_min_consistent g a b (Rlt_le _ _ Hab)) => [ | m Hm].
      move => x Hx; apply: ex_derive_continuous.
      by exists (dg x) ; apply Hg.
    have H : g m <= g M.
      by apply Hm ; intuition.
    case: (C0_extension_le f (g m) (g M)) => [ y Hy | f0 Hf0].
    + case: (IVT_gen_consistent g m M y) => // .
        rewrite /Rmin /Rmax ; case: Rle_dec => // .
      move => x [Hx <-].
      apply Hf ; split.
        apply Rle_trans with (2 := proj1 Hx).
        by apply Rmin_case ; intuition.
      apply Rle_trans with (1 := proj2 Hx).
      apply Rmax_case ; intuition.
    apply is_RInt_ext with (fun y : R => scal (dg y) (f0 (g y))).
      rewrite /Rmin /Rmax ; case: Rle_dec (Rlt_le _ _ Hab) => // _ _ x Hc.
      apply f_equal.
      apply Hf0 ; split.
        by apply Hm ; split ; apply Rlt_le ; apply Hc.
      by apply HM ; split ; apply Rlt_le ; apply Hc.

    rewrite -(RInt_ext f0).
    + apply Hw.
        by move => x Hx ; apply Hf0.
      by move => x ; apply Hf0.
    + move => x Hx.
      case: (IVT_gen_consistent g a b x cg) => // .
        by lra.
      rewrite Rmin_left ?Rmax_right; try lra.
      move => x0 Hx0.
      case: Hx0 => Hx0 Hgx0x; rewrite -Hgx0x.
      apply Hf0; split.
        by apply Hm.
      by apply HM.

    evar_last.
    + apply (is_RInt_derive (fun x => RInt f (g a) (g x))).
        move => x Hx.
        evar_last.
          apply is_derive_comp.
            apply is_derive_RInt with (g a).
              apply filter_forall => y.
              apply RInt_correct, @ex_RInt_continuous.
              by intros ; apply Hf.
            by apply Hf.
          by apply Hg.
        reflexivity.
      intros x Hx.
      apply: @continuous_scal.
        by apply Hg.
      apply continuous_comp.
        apply @ex_derive_continuous.
        by eexists ; apply Hg.
      by apply Hf.
    + by rewrite RInt_point minus_zero_r.
Qed.

Lemma RInt_comp (f : R -> V) (g dg : R -> R) (a b : R) :
  (forall x, Rmin a b <= x <= Rmax a b -> continuous f (g x)) ->
  (forall x, Rmin a b <= x <= Rmax a b -> is_derive g x (dg x) /\ continuous dg x) ->
  RInt (fun y => scal (dg y) (f (g y))) a b = RInt f (g a) (g b).
Proof.
  move => Hfg Hg.
  have H := (is_RInt_comp _ _ _ _ _ Hfg Hg).
  exact: is_RInt_unique.
Qed.

End Comp.

Lemma RInt_Chasles_bound_comp_l_loc (f : R -> R -> R) (a : R -> R) (b x : R) :
  locally x (fun y => ex_RInt (f y) (a x) b) ->
  (exists eps : posreal, locally x (fun y => ex_RInt (f y) (a x - eps) (a x + eps))) ->
  continuous a x ->
  locally x (fun x' => RInt (f x') (a x') (a x) + RInt (f x') (a x) b =
    RInt (f x') (a x') b).
Proof.
intros Hab (eps,Hae) Ca.
generalize (proj1 (filterlim_locally _ _) Ca) => {Ca} Ca.
generalize (filter_and _ _ (Ca eps) (filter_and _ _ Hab Hae)).
apply filter_imp => {Ca Hae Hab} y [Hy [Hab Hae]].
apply RInt_Chasles with (2 := Hab).
apply ex_RInt_inside with (1 := Hae).
now apply Rlt_le.
rewrite /Rminus Rplus_opp_r Rabs_R0.
apply Rlt_le, cond_pos.
Qed.

Lemma RInt_Chasles_bound_comp_loc (f : R -> R -> R) (a b : R -> R) (x : R) :
  locally x (fun y => ex_RInt (f y) (a x) (b x)) ->
  (exists eps : posreal, locally x (fun y => ex_RInt (f y) (a x - eps) (a x + eps))) ->
  (exists eps : posreal, locally x (fun y => ex_RInt (f y) (b x - eps) (b x + eps))) ->
  continuous a x ->
  continuous b x ->
  locally x (fun x' => RInt (f x') (a x') (a x) + RInt (f x') (a x) (b x') =
    RInt (f x') (a x') (b x')).
Proof.
intros Hab (ea,Hae) (eb,Hbe) Ca Cb.
generalize (proj1 (filterlim_locally _ _) Ca) => {Ca} Ca.
generalize (proj1 (filterlim_locally _ _) Cb) => {Cb} Cb.
set (e := mkposreal _ (Rmin_stable_in_posreal ea eb)).
generalize (filter_and _ _ (filter_and _ _ (Ca e) (Cb e))
  (filter_and _ _ Hab (filter_and _ _ Hae Hbe))).
apply filter_imp => {Ca Cb Hab Hae Hbe} y [[Hay Hby] [Hab [Hae Hbe]]].
apply: RInt_Chasles.
apply ex_RInt_inside with (1 := Hae).
apply Rlt_le.
apply Rlt_le_trans with (1 := Hay).
exact: Rmin_l.
rewrite /Rminus Rplus_opp_r Rabs_R0.
apply Rlt_le, cond_pos.
apply ex_RInt_Chasles with (1 := Hab).
apply ex_RInt_inside with (1 := Hbe).
rewrite /Rminus Rplus_opp_r Rabs_R0.
apply Rlt_le, cond_pos.
apply Rlt_le.
apply Rlt_le_trans with (1 := Hby).
exact: Rmin_r.
Qed.

Section RInt_comp.

Context {V : NormedModule R_AbsRing}.

Lemma is_derive_RInt_bound_comp (f : R -> V) (If : R -> R -> V) (a b : R -> R) (da db x : R) :
  locally (a x, b x)
    (fun u : R * R => is_RInt f (fst u) (snd u) (If (fst u) (snd u))) ->
  continuous f (a x) ->
  continuous f (b x) ->
  is_derive a x da ->
  is_derive b x db ->
  is_derive (fun x => If (a x) (b x)) x (minus (scal db (f (b x))) (scal da (f (a x)))).
Proof.
  intros Iab Ca Cb Da Db.
  unfold is_derive.
  eapply filterdiff_ext_lin.
  apply @filterdiff_comp'_2.
  apply Da.
  apply Db.
  eapply filterdiff_ext_lin.
  apply (filterdiff_RInt f If (a x) (b x)).
  exact Iab.
  exact Ca.
  exact Cb.
  by case => y z /=.
  simpl => y.
  by rewrite -!scal_assoc scal_minus_distr_l.
Qed.

End RInt_comp.

(** * Parametric integrals *)

Lemma is_derive_RInt_param_aux : forall (f : R -> R -> R) (a b x : R),
  locally x (fun x : R => forall t, Rmin a b <= t <= Rmax a b -> ex_derive (fun u : R => f u t) x) ->
  (forall t, Rmin a b <= t <= Rmax a b -> continuity_2d_pt (fun u v => Derive (fun z => f z v) u) x t) ->
  locally x (fun y : R => ex_RInt (fun t => f y t) a b) ->
  ex_RInt (fun t => Derive (fun u => f u t) x) a b ->
  is_derive (fun x : R => RInt (fun t => f x t) a b) x
    (RInt (fun t => Derive (fun u => f u t) x) a b).
Proof.
intros f a b x.
wlog: a b / a  H.
(* *)
destruct (total_order_T a b) as [[Hab|Hab]|Hab].
now apply H.
intros _ _ _ _.
rewrite Hab.
rewrite RInt_point.
apply is_derive_ext with (fun _ => 0).
simpl => t.
apply sym_eq.
apply: RInt_point.
apply: is_derive_const.
simpl => H1 H2 H3 H4.
apply is_derive_ext_loc with (fun u => - RInt (fun t => f u t) b a).
apply: filter_imp H3 => t Ht.
apply: opp_RInt_swap.
exact: ex_RInt_swap.
eapply filterdiff_ext_lin.
apply @filterdiff_opp_fct ; try by apply locally_filter.
apply H.
exact Hab.
now rewrite Rmin_comm Rmax_comm.
now rewrite Rmin_comm Rmax_comm.
move: H3 ; apply filter_imp => y H3.
now apply ex_RInt_swap.
now apply ex_RInt_swap.
rewrite -opp_RInt_swap //=.
intros y.
by rewrite -scal_opp_r opp_opp.
(* *)
rewrite Rmin_left. 2: now apply Rlt_le.
rewrite Rmax_right. 2: now apply Rlt_le.
intros Df Cdf If IDf.
split => [ | y Hy].
by apply @is_linear_scal_l.
rewrite -(is_filter_lim_locally_unique _ _ Hy) => {y Hy}.
assert (Cdf'' : forall t : R, a <= t <= b ->
        continuity_2d_pt (fun u v : R => Derive (fun z : R => f z u) v) t x).
intros t Ht eps.
specialize (Cdf t Ht eps).
simpl in Cdf.
destruct Cdf as (d,Cdf).
exists d.
intros v u Hv Hu.
now apply Cdf.
assert (Cdf' := uniform_continuity_2d_1d (fun u v => Derive (fun z => f z u) v) a b x Cdf'').
intros eps. (* 8.4/8.5 compatibility: *) try clearbody Cdf'. clear Cdf.
assert (H': 0 < eps / Rabs (b - a)).
apply Rmult_lt_0_compat.
apply cond_pos.
apply Rinv_0_lt_compat.
apply Rabs_pos_lt.
apply Rgt_not_eq.
now apply Rgt_minus.
move: (Cdf' (mkposreal _ H')) => {Cdf'} [d1 Cdf].
generalize (filter_and _ _ Df If). move => {Df If} [d2 DIf].
exists (mkposreal _ (Rmin_stable_in_posreal d1 (pos_div_2 d2))) => /= y Hy.
assert (D1: ex_RInt (fun t => f y t) a b).
apply DIf.
apply Rlt_le_trans with (1 := Hy).
apply Rle_trans with (1 := Rmin_r _ _).
apply Rlt_le.
apply Rlt_eps2_eps.
apply cond_pos.
assert (D2: ex_RInt (fun t => f x t) a b).
apply DIf.
apply ball_center.
rewrite -RInt_minus // -RInt_scal //.
assert (D3: ex_RInt (fun t => f y t - f x t) a b).
  apply @ex_RInt_minus.
  by apply D1.
  by apply D2.
assert (D4: ex_RInt (fun t => (y - x) * Derive (fun u => f u t) x) a b) by now apply @ex_RInt_scal.
rewrite -RInt_minus //.
assert (D5: ex_RInt (fun t => f y t - f x t - (y - x) * Derive (fun u => f u t) x) a b) by now apply @ex_RInt_minus.
rewrite (RInt_Reals _ _ _ (ex_RInt_Reals_0 _ _ _ D5)).
assert (D6: ex_RInt (fun t => Rabs (f y t - f x t - (y - x) * Derive (fun u => f u t) x)) a b) by now apply ex_RInt_norm.
apply Rle_trans with (1 := RiemannInt_P17 _ (ex_RInt_Reals_0 _ _ _ D6) (Rlt_le _ _ H)).
refine (Rle_trans _ _ _ (RiemannInt_P19 _ (RiemannInt_P14 a b (eps / Rabs (b - a) * Rabs (y - x))) (Rlt_le _ _ H) _) _).
intros u Hu.
destruct (MVT_cor4 (fun t => f t u) (Derive (fun t => f t u)) x) with (eps := pos_div_2 d2) (b := y) as (z,Hz).
intros z Hz.
apply Derive_correct, DIf.
apply Rle_lt_trans with (1 := Hz).
apply: Rlt_eps2_eps.
apply cond_pos.
split ; now apply Rlt_le.
apply Rlt_le.
apply Rlt_le_trans with (1 := Hy).
apply Rmin_r.
rewrite (proj1 Hz).
rewrite Rmult_comm.
rewrite -Rmult_minus_distr_l Rabs_mult.
rewrite Rmult_comm.
apply Rmult_le_compat_r.
apply Rabs_pos.
apply Rlt_le.
apply Cdf.
split ; now apply Rlt_le.
apply Rabs_le_between'.
rewrite /Rminus Rplus_opp_r Rabs_R0.
apply Rlt_le.
apply cond_pos.
split ; now apply Rlt_le.
apply Rabs_le_between'.
apply Rle_trans with (1 := proj2 Hz).
apply Rlt_le.
apply Rlt_le_trans with (1 := Hy).
apply Rmin_l.
rewrite /Rminus Rplus_opp_r Rabs_R0.
apply cond_pos.
rewrite RiemannInt_P15.
rewrite Rabs_pos_eq.
right.
change (norm (minus y x)) with (Rabs (y - x)).
field.
apply Rgt_not_eq.
now apply Rgt_minus.
apply Rge_le.
apply Rge_minus.
now apply Rgt_ge.
Qed.

Lemma is_derive_RInt_param : forall f a b x,
  locally x (fun x => forall t, Rmin a b <= t <= Rmax a b -> ex_derive (fun u => f u t) x) ->
  (forall t, Rmin a b <= t <= Rmax a b -> continuity_2d_pt (fun u v => Derive (fun z => f z v) u) x t) ->
  locally x (fun y => ex_RInt (fun t => f y t) a b) ->
  is_derive (fun x => RInt (fun t => f x t) a b) x
    (RInt (fun t => Derive (fun u => f u t) x) a b).
Proof.
intros f a b x H1 H2 H3.
apply is_derive_RInt_param_aux; try easy.
apply ex_RInt_Reals_1.
clear H1 H3.
wlog: a b H2 / a  H.
case (total_order_T a b).
intro Y; case Y.
now apply H.
intros Heq; rewrite Heq.
apply RiemannInt_P7.
intros  Y.
apply RiemannInt_P1.
apply H.
intros; apply H2.
rewrite Rmin_comm Rmax_comm.
exact H0.
exact Y.
rewrite Rmin_left in H2.
2: now left.
rewrite Rmax_right in H2.
2: now left.
apply continuity_implies_RiemannInt.
now left.
intros y Hy eps Heps.
destruct (H2 _ Hy (mkposreal eps Heps)) as (d,Hd).
simpl in Hd.
exists d; split.
apply cond_pos.
unfold dist; simpl; unfold R_dist; simpl.
intros z (_,Hz).
apply Hd.
rewrite /Rminus Rplus_opp_r Rabs_R0.
apply cond_pos.
exact Hz.
Qed.

Lemma is_derive_RInt_param_bound_comp_aux1 :
  forall (f : R -> R -> R) (a : R -> R) (x : R),
  (exists eps:posreal, locally x (fun y : R => ex_RInt (fun t => f y t) (a x - eps) (a x + eps))) ->
  (exists eps:posreal, locally x
    (fun x0 : R =>
       forall t : R,
        a x-eps <= t <= a x+eps ->
        ex_derive (fun u : R => f u t) x0)) ->
  (locally_2d (fun x' t =>
         continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x' t) x (a x)) ->

  continuity_2d_pt
     (fun u v : R => Derive (fun z : R => RInt (fun t : R => f z t) v (a x)) u) x (a x).
Proof.
intros f a x (d1,(d2,Ia)) (d3,(d4,Df)) Cdf e.
assert (J1:(continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x (a x)))
   by now apply locally_2d_singleton in Cdf.
destruct Cdf as (d5,Cdf).
destruct (J1 (mkposreal _ Rlt_0_1)) as (d6,Df1); simpl in Df1.
assert (J2: 0 < e / (Rabs (Derive (fun z : R => f z (a x)) x)+1)).
apply Rdiv_lt_0_compat.
apply cond_pos.
apply Rlt_le_trans with (0+1).
rewrite Rplus_0_l; apply Rlt_0_1.
apply Rplus_le_compat_r; apply Rabs_pos.
exists (mkposreal _ (Rmin_stable_in_posreal
                  (mkposreal _ (Rmin_stable_in_posreal
                        d1
                       (mkposreal _ (Rmin_stable_in_posreal (pos_div_2 d2) d3))))
                  (mkposreal _ (Rmin_stable_in_posreal
                       (mkposreal _ (Rmin_stable_in_posreal (pos_div_2 d4) d5))
                       (mkposreal _ (Rmin_stable_in_posreal d6 (mkposreal _ J2))))))).
simpl; intros u v Hu Hv.
rewrite (Derive_ext (fun z : R => RInt (fun t : R => f z t) (a x) (a x)) (fun z => 0)).
2: intros t; exact: RInt_point.
replace (Derive (fun _ : R => 0) x) with 0%R.
2: apply sym_eq, Derive_const.
rewrite Rminus_0_r.
replace (Derive (fun z : R => RInt (fun t : R => f z t) v (a x)) u) with
  (RInt (fun z => Derive (fun u => f u z) u) v (a x)).
(* *)
apply Rle_lt_trans with (Rabs (a x -v) *
   (Rabs (Derive (fun z : R => f z (a x)) x) +1)).
apply (norm_RInt_le_const_abs (fun z : R => Derive (fun u0 : R => f u0 z) u) v (a x)).
intros t Ht.
apply Rplus_le_reg_r with (-Rabs (Derive (fun z : R => f z (a x)) x)).
apply Rle_trans with (1:=Rabs_triang_inv _ _).
ring_simplify.
left; apply Df1.
apply Rlt_le_trans with (1:=Hu).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rmin_l.
apply Rle_lt_trans with (Rabs (v - a x)).
now apply Rabs_le_between_min_max.
apply Rlt_le_trans with (1:=Hv).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rmin_l.
apply: RInt_correct.
apply: ex_RInt_continuous.
intros y Hy ; apply continuity_pt_filterlim.
intros eps Heps.
assert (Y1:(Rabs (u - x) < d5)).
apply Rlt_le_trans with (1:=Hu).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rle_trans with (1:=Rmin_l _ _).
apply Rmin_r.
assert (Y2:(Rabs (y - a x) < d5)).
apply Rle_lt_trans with (Rabs (v-a x)).
now apply Rabs_le_between_min_max.
apply Rlt_le_trans with (1:=Hv).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rle_trans with (1:=Rmin_l _ _).
apply Rmin_r.
destruct (Cdf u y Y1 Y2 (mkposreal eps Heps)) as (d,Hd); simpl in Hd.
exists d; split.
apply cond_pos.
unfold dist; simpl; unfold R_dist.
intros z (_,Hz).
apply Hd.
rewrite /Rminus Rplus_opp_r Rabs_R0.
apply cond_pos.
exact Hz.
replace (a x -v) with (-(v - a x)) by ring; rewrite Rabs_Ropp.
apply Rlt_le_trans with ((e / (Rabs (Derive (fun z : R => f z (a x)) x) + 1))
  * (Rabs (Derive (fun z : R => f z (a x)) x) + 1)).
apply Rmult_lt_compat_r.
apply Rlt_le_trans with (0+1).
rewrite Rplus_0_l; apply Rlt_0_1.
apply Rplus_le_compat_r; apply Rabs_pos.
apply Rlt_le_trans with (1:=Hv).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rmin_r.
right; field.
apply sym_not_eq, Rlt_not_eq.
apply Rlt_le_trans with (0+1).
rewrite Rplus_0_l; apply Rlt_0_1.
apply Rplus_le_compat_r; apply Rabs_pos.
(* *)
apply sym_eq, is_derive_unique.
apply is_derive_RInt_param.
exists (pos_div_2 d4).
intros y Hy t Ht.
apply Df.
rewrite (double_var d4).
apply ball_triangle with u.
apply Rlt_le_trans with (1:=Hu).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rle_trans with (1:=Rmin_l _ _).
apply Rmin_l.
by apply Hy.
apply (proj1 (Rabs_le_between' t (a x) d3)).
apply Rle_trans with (Rabs (v - a x)).
now apply Rabs_le_between_min_max.
left; apply Rlt_le_trans with (1:=Hv).
apply Rle_trans with (1:=Rmin_l _ _).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rmin_r.
intros t Ht.
apply Cdf.
apply Rlt_le_trans with (1:=Hu).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rle_trans with (1:=Rmin_l _ _).
apply Rmin_r.
apply Rle_lt_trans with (Rabs (v - a x)).
now apply Rabs_le_between_min_max.
apply Rlt_le_trans with (1:=Hv).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rle_trans with (1:=Rmin_l _ _).
apply Rmin_r.
exists (pos_div_2 d2).
intros y Hy.
apply (ex_RInt_inside (f y)) with (a x) d1.
apply Ia.
rewrite (double_var d2).
apply ball_triangle with u.
apply Rlt_le_trans with (1:=Hu).
apply Rle_trans with (1:=Rmin_l _ _).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rmin_l.
apply Hy.
left; apply Rlt_le_trans with (1:=Hv).
apply Rle_trans with (1:=Rmin_l _ _).
apply Rmin_l.
rewrite /Rminus Rplus_opp_r Rabs_R0.
left; apply cond_pos.
Qed.

Lemma is_derive_RInt_param_bound_comp_aux2 :
  forall (f : R -> R -> R) (a : R -> R) (b x da : R),
  (locally x (fun y : R => ex_RInt (fun t => f y t) (a x) b)) ->
  (exists eps:posreal, locally x (fun y : R => ex_RInt (fun t => f y t) (a x - eps) (a x + eps))) ->
  is_derive a x da ->
  (exists eps:posreal, locally x
    (fun x0 : R =>
       forall t : R,
        Rmin (a x-eps) b <= t <= Rmax (a x+eps) b ->
        ex_derive (fun u : R => f u t) x0)) ->
  (forall t : R,
          Rmin (a x) b <= t <= Rmax (a x) b ->
         continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x t) ->
  (locally_2d (fun x' t =>
         continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x' t) x (a x)) ->
   continuity_pt (fun t => f x t) (a x) ->

  is_derive (fun x : R => RInt (fun t => f x t) (a x) b) x
    (RInt (fun t : R => Derive (fun u => f u t) x) (a x) b+(-f x (a x))*da).
Proof.
intros f a b x da Hi [d0 Ia] Da [d1 Df] Cdf1 Cdf2 Cfa.
rewrite Rplus_comm.
apply is_derive_ext_loc with (fun x0 => plus (RInt (fun t : R => f x0 t) (a x0) (a x)) (RInt (fun t : R => f x0 t) (a x) b)).
apply RInt_Chasles_bound_comp_l_loc.
exact Hi.
now exists d0.
apply: filterdiff_continuous.
eexists.
apply Da.
apply: is_derive_plus.
(* *)
eapply filterdiff_ext_lin.
apply @filterdiff_comp'_2 with
   (h := fun x0 y => RInt (fun t : R => f x0 t) y (a x)).
apply filterdiff_id.
apply Da.
eapply filterdiff_ext_lin.
apply (is_derive_filterdiff
  (fun u v => RInt (fun t0 : R => f u t0) v (a x)) x (a x)
  (fun u v => Derive (fun z => RInt (fun t => f z t) v (a x)) u)).
(* . *)
destruct Df as (d2,Df).
destruct Cdf2 as (d3,Cdf2).
destruct Ia as (d4,Ia).
exists (mkposreal _ (Rmin_stable_in_posreal
                (mkposreal _ (Rmin_stable_in_posreal d1 (pos_div_2 d2)))
                (mkposreal _ (Rmin_stable_in_posreal d3
                            (mkposreal _ (Rmin_stable_in_posreal d0 (pos_div_2 d4))))))).
intros [u v] [Hu Hv] ; simpl in *.
apply: Derive_correct.
eexists ; apply is_derive_RInt_param.
exists (pos_div_2 d2).
intros y Hy t Ht.
apply Df.
rewrite (double_var d2).
apply: ball_triangle Hy.
apply Rlt_le_trans with (1:=Hu).
apply Rle_trans with (1:=Rmin_l _ _).
apply Rmin_r.
split.
apply Rle_trans with (2:=proj1 Ht).
apply Rle_trans with (1 := Rmin_l _ _).
apply Rmin_glb.
apply Rabs_le_between'.
left; apply Rlt_le_trans with (1:=Hv).
apply Rle_trans with (1:=Rmin_l _ _).
apply Rmin_l.
apply Rplus_le_reg_l with (- a x + d1); ring_simplify.
left; apply cond_pos.
apply Rle_trans with (1:=proj2 Ht).
apply Rle_trans with (a x + d1).
apply Rmax_lub.
apply Rabs_le_between'.
left; apply Rlt_le_trans with (1:=Hv).
apply Rle_trans with (1:=Rmin_l _ _).
apply Rmin_l.
apply Rplus_le_reg_l with (- a x); ring_simplify.
left; apply cond_pos.
apply Rmax_l.
intros t Ht.
apply Cdf2.
apply Rlt_le_trans with (1:=Hu).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rmin_l.
apply Rle_lt_trans with (Rabs (v - a x)).
now apply Rabs_le_between_min_max.
apply Rlt_le_trans with (1:=Hv).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rmin_l.
exists (pos_div_2 d4).
intros y Hy.
apply (ex_RInt_inside (f y)) with (a x) d0.
apply Ia.
rewrite (double_var d4).
apply: ball_triangle Hy.
apply Rlt_le_trans with (1:=Hu).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rmin_r.
left; apply Rlt_le_trans with (1:=Hv).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rle_trans with (1:=Rmin_r _ _).
apply Rmin_l.
rewrite /Rminus Rplus_opp_r Rabs_R0.
left; apply cond_pos.
(* . *)
apply is_derive_RInt' with (a x).
apply locally_singleton in Ia.
exists d0 => /= y Hy.
apply: RInt_correct.
generalize (proj1 (Rabs_lt_between' _ _ _) Hy) => {Hy} Hy.
eapply ex_RInt_Chasles.
eapply ex_RInt_Chasles, Ia.
apply ex_RInt_swap.
eapply @ex_RInt_Chasles_1, Ia.
split ; apply Rlt_le, Hy.
apply ex_RInt_swap.
eapply @ex_RInt_Chasles_2, Ia.
apply Rabs_le_between'.
rewrite /Rminus Rplus_opp_r Rabs_R0.
left; apply cond_pos.
by apply continuity_pt_filterlim, Cfa.
(* . *)
apply (continuity_2d_pt_filterlim (fun u v =>
   Derive (fun z : R => RInt (fun t0 : R => f z t0) v (a x)) u)).
simpl.
apply is_derive_RInt_param_bound_comp_aux1; try easy.
exists d0; exact Ia.
exists d1.
move: Df ; apply filter_imp.
intros y H t Ht.
apply H.
split.
apply Rle_trans with (2:=proj1 Ht).
apply Rmin_l.
apply Rle_trans with (1:=proj2 Ht).
apply Rmax_l.

case => /= u v.
erewrite Derive_ext.
2: intros ; by rewrite RInt_point.
by rewrite Derive_const scal_zero_r plus_zero_l.
move => /= y ; apply Rminus_diag_uniq.
rewrite /plus /scal /opp /= /mult /=.
ring.
(* *)
apply is_derive_RInt_param with (2 := Cdf1) (3 := Hi).
move: Df ; apply filter_imp.
intros y Hy t Ht; apply Hy.
split.
apply Rle_trans with (2:=proj1 Ht).
apply Rle_min_compat_r.
apply Rplus_le_reg_l with (-a x+d1); ring_simplify.
left; apply cond_pos.
apply Rle_trans with (1:=proj2 Ht).
apply Rle_max_compat_r.
apply Rplus_le_reg_l with (-a x); ring_simplify.
left; apply cond_pos.
Qed.

Lemma is_derive_RInt_param_bound_comp_aux3 :
  forall (f : R -> R -> R) a (b : R -> R) (x db : R),
  (locally x (fun y : R => ex_RInt (fun t => f y t) a (b x))) ->
  (exists eps:posreal, locally x (fun y : R => ex_RInt (fun t => f y t) (b x - eps) (b x + eps))) ->
  is_derive b x db ->
  (exists eps:posreal, locally x
    (fun x0 : R =>
       forall t : R,
        Rmin a (b x-eps) <= t <= Rmax a (b x+eps) ->
        ex_derive (fun u : R => f u t) x0)) ->
  (forall t : R,
          Rmin a (b x) <= t <= Rmax a (b x) ->
         continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x t) ->
  (locally_2d (fun x' t =>
         continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x' t) x (b x)) ->
   continuity_pt (fun t => f x t) (b x) ->

  is_derive (fun x : R => RInt (fun t => f x t) a (b x)) x
    (RInt (fun t : R => Derive (fun u => f u t) x) a (b x) +f x (b x)*db).
Proof.
intros f a b x db If Ib Db Df Cf1 Cf2 Cfb.
apply is_derive_ext_loc with (fun x0 => - RInt (fun t : R => f x0 t) (b x0) a).
  destruct Ib as [eps Ib].
  cut (locally x (fun t : R => ex_RInt (fun u => f t u) a (b t))).
  apply: filter_imp.
  intros y H.
  apply: opp_RInt_swap.
  exact: ex_RInt_swap.
  assert (locally x (fun t : R => Rabs (b t - b x) <= eps)).
    generalize (ex_derive_continuous b _ (ex_intro _ _ Db)).
    move /filterlim_locally /(_ eps).
    apply: filter_imp => t.
    exact: Rlt_le.
  generalize (filter_and _ _ If (filter_and _ _ Ib H)).
  apply: filter_imp => t [Ht1 [Ht2 Ht3]].
  apply ex_RInt_Chasles with (1 := Ht1).
  apply: ex_RInt_inside Ht2 _ Ht3.
  rewrite Rminus_eq_0 Rabs_R0.
  apply Rlt_le, cond_pos.
evar_last.
apply: is_derive_opp.
apply: is_derive_RInt_param_bound_comp_aux2 Ib Db _ _ Cf2 Cfb.
apply: filter_imp If => y H.
now apply ex_RInt_swap.
destruct Df as (e,H).
exists e.
move: H ; apply filter_imp.
intros y H' t Ht.
apply H'.
now rewrite Rmin_comm Rmax_comm.
intros t Ht.
apply Cf1.
now rewrite Rmin_comm Rmax_comm.
rewrite -(opp_RInt_swap _ _ a).
rewrite /opp /=.
ring.
apply ex_RInt_swap.
apply ex_RInt_continuous.
intros z Hz.
specialize (Cf1 z Hz).
apply continuity_2d_pt_filterlim in Cf1.
intros c Hc.
destruct (Cf1 c Hc) as [e He].
exists e.
intros d Hd.
apply (He (x,d)).
split.
apply ball_center.
apply Hd.
Qed.

Lemma is_derive_RInt_param_bound_comp :
 forall (f : R -> R -> R) (a b : R -> R) (x da db : R),
  (locally x (fun y : R => ex_RInt (fun t => f y t) (a x) (b x))) ->
  (exists eps:posreal, locally x (fun y : R => ex_RInt (fun t => f y t) (a x - eps) (a x + eps))) ->
  (exists eps:posreal, locally x (fun y : R => ex_RInt (fun t => f y t) (b x - eps) (b x + eps))) ->
  is_derive a x da ->
  is_derive b x db ->
  (exists eps:posreal, locally x
    (fun x0 : R =>
       forall t : R,
        Rmin (a x-eps) (b x -eps) <= t <= Rmax (a x+eps) (b x+eps) ->
        ex_derive (fun u : R => f u t) x0)) ->
  (forall t : R,
          Rmin (a x) (b x) <= t <= Rmax (a x) (b x) ->
         continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x t) ->
  (locally_2d (fun x' t =>
         continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x' t) x (a x)) ->
  (locally_2d (fun x' t =>
         continuity_2d_pt (fun u v : R => Derive (fun z : R => f z v) u) x' t) x (b x)) ->
   continuity_pt (fun t => f x t) (a x) ->
   continuity_pt (fun t => f x t) (b x) ->

  is_derive (fun x : R => RInt (fun t => f x t) (a x) (b x)) x
    (RInt (fun t : R => Derive (fun u => f u t) x) (a x) (b x)+(-f x (a x))*da+(f x (b x))*db).
Proof.
intros f a b x da db If Ifa Ifb Da Db Df Cf Cfa Cfb Ca Cb.
apply is_derive_ext_loc with (fun x0 : R => RInt (fun t : R => f x0 t) (a x0) (a x)
    + RInt (fun t : R => f x0 t) (a x) (b x0)).
apply RInt_Chasles_bound_comp_loc ; trivial.
apply @filterdiff_continuous.
eexists.
apply Da.
apply @filterdiff_continuous.
eexists.
apply Db.
eapply filterdiff_ext_lin.
apply @filterdiff_plus_fct.
by apply locally_filter.
(* *)
apply is_derive_RInt_param_bound_comp_aux2; try easy.
exists (mkposreal _ Rlt_0_1).
intros y Hy.
apply ex_RInt_point.
by apply Da.
destruct Df as (e,H).
exists e.
move: H ; apply filter_imp.
intros y H' t Ht.
apply H'.
split.
apply Rle_trans with (2:=proj1 Ht).
apply Rle_trans with (1:=Rmin_l _ _).
right; apply sym_eq, Rmin_left.
apply Rplus_le_reg_l with (-a x + e); ring_simplify.
left; apply cond_pos.
apply Rle_trans with (1:=proj2 Ht).
apply Rle_trans with (2:=Rmax_l _ _).
right; apply Rmax_left.
apply Rplus_le_reg_l with (-a x); ring_simplify.
left; apply cond_pos.
intros t Ht.
apply Cf.
split.
apply Rle_trans with (2:=proj1 Ht).
apply Rle_trans with (1:=Rmin_l _ _).
right; apply sym_eq, Rmin_left.
now right.
apply Rle_trans with (1:=proj2 Ht).
apply Rle_trans with (2:=Rmax_l _ _).
right; apply Rmax_left.
now right.
(* *)
apply is_derive_RInt_param_bound_comp_aux3; try easy.
by apply Db.
destruct Df as (e,H).
exists e.
move: H ; apply filter_imp.
intros y H' t Ht.
apply H'.
split.
apply Rle_trans with (2:=proj1 Ht).
apply Rle_min_compat_r.
apply Rplus_le_reg_l with (-a x + e); ring_simplify.
left; apply cond_pos.
apply Rle_trans with (1:=proj2 Ht).
apply Rle_max_compat_r.
apply Rplus_le_reg_l with (-a x); ring_simplify.
left; apply cond_pos.
rewrite RInt_point.
simpl => y.
rewrite /plus /scal /zero /= /mult /=.
ring.
Qed.

(** * Power series *)

Definition PS_Int (a : nat -> R) (n : nat) : R :=
  match n with
    | O => 0
    | S n => a n / INR (S n)
  end.

Lemma CV_radius_Int (a : nat -> R) :
  CV_radius (PS_Int a) = CV_radius a.
Proof.
  rewrite -CV_radius_derive.
  apply CV_radius_ext.
  rewrite /PS_derive /PS_Int => n ; rewrite S_INR.
  field.
  apply Rgt_not_eq, INRp1_pos.
Qed.

Lemma is_RInt_PSeries (a : nat -> R) (x : R) :
  Rbar_lt (Rabs x) (CV_radius a)
  -> is_RInt (PSeries a) 0 x (PSeries (PS_Int a) x).
Proof.
  move => Hx.
  have H : forall y, Rmin 0 x <= y <= Rmax 0 x -> Rbar_lt (Rabs y) (CV_radius a).
    move => y Hy.
    apply: Rbar_le_lt_trans Hx.
    apply Rabs_le_between.
    split.
    apply Rle_trans with (2 := proj1 Hy).
    rewrite /Rabs /Rmin.
    case: Rcase_abs ; case: Rle_dec => // Hx Hx' ; rewrite ?Ropp_involutive.
    by apply Rlt_le.
    by apply Req_le.
    apply Ropp_le_cancel ; by rewrite Ropp_involutive Ropp_0.
    by apply Rge_le in Hx'.
    apply Rle_trans with (1 := proj2 Hy).
    rewrite /Rabs /Rmax.
    case: Rcase_abs ; case: Rle_dec => // Hx Hx'.
    by apply Rlt_not_le in Hx'.
    apply Ropp_le_cancel, Rlt_le ; by rewrite Ropp_involutive Ropp_0.
    by apply Req_le.
    by apply Rge_le in Hx'.

  apply is_RInt_ext with (Derive (PSeries (PS_Int a))).
  move => y Hy.
  rewrite Derive_PSeries.
  apply PSeries_ext ; rewrite /PS_derive /PS_Int => n ; rewrite S_INR.
  field.
  apply Rgt_not_eq, INRp1_pos.
  rewrite CV_radius_Int.
  by apply H ; split ; apply Rlt_le ; apply Hy.
  evar_last.
  apply: is_RInt_derive.
  move => y Hy.
  apply Derive_correct, ex_derive_PSeries.
  rewrite CV_radius_Int.
  by apply H.
  move => y Hy.
  apply continuous_ext_loc with (PSeries a).

  apply locally_interval with (Rbar_opp (CV_radius a)) (CV_radius a).
  apply Rbar_opp_lt ; rewrite Rbar_opp_involutive.
  apply: Rbar_le_lt_trans (H _ Hy).
  apply Rabs_maj2.
  apply: Rbar_le_lt_trans (H _ Hy).
  apply Rle_abs.
  move => z Hz Hz'.
  rewrite Derive_PSeries.
  apply PSeries_ext ; rewrite /PS_derive /PS_Int => n ; rewrite S_INR.
  field.
  apply Rgt_not_eq, INRp1_pos.
  rewrite CV_radius_Int.
  apply (Rbar_abs_lt_between z) ; by split.
  apply continuity_pt_filterlim, PSeries_continuity.
  by apply H.

  rewrite PSeries_0 /(PS_Int _ 0) ; by rewrite minus_zero_r.
Qed.

Lemma ex_RInt_PSeries (a : nat -> R) (x : R) :
  Rbar_lt (Rabs x) (CV_radius a)
  -> ex_RInt (PSeries a) 0 x.
Proof.
  move => Hx.
  exists (PSeries (PS_Int a) x).
  by apply is_RInt_PSeries.
Qed.

Lemma RInt_PSeries (a : nat -> R) (x : R) :
  Rbar_lt (Rabs x) (CV_radius a)
  -> RInt (PSeries a) 0 x = PSeries (PS_Int a) x.
Proof.
  move => Hx.
  apply is_RInt_unique.
  by apply is_RInt_PSeries.
Qed.

Lemma is_pseries_RInt (a : nat -> R) :
  forall x, Rbar_lt (Rabs x) (CV_radius a)
    -> is_pseries (PS_Int a) x (RInt (PSeries a) 0 x).
Proof.
  move => x Hx.
  erewrite is_RInt_unique.
  apply PSeries_correct.
  apply CV_radius_inside.
  by rewrite CV_radius_Int.
  exact: is_RInt_PSeries.
Qed.

(** * Integration by parts *)

Section ByParts.

Context {V : CompleteNormedModule R_AbsRing}.

Lemma is_RInt_scal_derive :
  forall (f : R -> R) (g : R -> V) (f' : R -> R) (g' : R -> V) (a b : R),
  (forall t, Rmin a b <= t <= Rmax a b -> is_derive f t (f' t)) ->
  (forall t, Rmin a b <= t <= Rmax a b -> is_derive g t (g' t)) ->
  (forall t, Rmin a b <= t <= Rmax a b -> continuous f' t) ->
  (forall t, Rmin a b <= t <= Rmax a b -> continuous g' t) ->
  is_RInt (fun t => plus (scal (f' t) (g t)) (scal (f t) (g' t))) a b (minus (scal (f b) (g b)) (scal (f a) (g a))).
Proof.
intros f g f' g' a b Df Dg Cf' Cg' If'g.
apply (is_RInt_derive (fun t => scal (f t) (g t))).
intros t Ht.
refine (_ (filterdiff_scal_fct t f g _ _ _ (Df _ Ht) (Dg _ Ht))).
intros H.
apply: filterdiff_ext_lin H _ => u.
by rewrite scal_distr_l !scal_assoc /mult /= Rmult_comm.
exact Rmult_comm.
intros t Ht.
apply: continuous_plus.
apply: continuous_scal.
now apply Cf'.
apply ex_derive_continuous.
eexists.
now apply Dg.
apply: continuous_scal.
apply: ex_derive_continuous.
eexists.
now apply Df.
now apply Cg'.
Qed.

Lemma is_RInt_scal_derive_r :
  forall (f : R -> R) (g : R -> V) (f' : R -> R) (g' : R -> V) (a b : R) (l : V),
  (forall t, Rmin a b <= t <= Rmax a b -> is_derive f t (f' t)) ->
  (forall t, Rmin a b <= t <= Rmax a b -> is_derive g t (g' t)) ->
  (forall t, Rmin a b <= t <= Rmax a b -> continuous f' t) ->
  (forall t, Rmin a b <= t <= Rmax a b -> continuous g' t) ->
  is_RInt (fun t => scal (f' t) (g t)) a b l ->
  is_RInt (fun t => scal (f t) (g' t)) a b (minus (minus (scal (f b) (g b)) (scal (f a) (g a))) l).
Proof.
intros f g f' g' a b l Df Dg Cf' Cg' If'g.
apply (is_RInt_ext (fun t =>
  minus (plus (scal (f' t) (g t)) (scal (f t) (g' t))) (scal (f' t) (g t)))).
intros x H.
by rewrite /minus (plus_comm (scal (f' x) _)) -plus_assoc plus_opp_r plus_zero_r.
apply is_RInt_minus with (2 := If'g).
exact: is_RInt_scal_derive.
Qed.

Lemma is_RInt_scal_derive_l :
  forall (f : R -> R) (g : R -> V) (f' : R -> R) (g' : R -> V) (a b : R) (l : V),
  (forall t, Rmin a b <= t <= Rmax a b -> is_derive f t (f' t)) ->
  (forall t, Rmin a b <= t <= Rmax a b -> is_derive g t (g' t)) ->
  (forall t, Rmin a b <= t <= Rmax a b -> continuous f' t) ->
  (forall t, Rmin a b <= t <= Rmax a b -> continuous g' t) ->
  is_RInt (fun t => scal (f t) (g' t)) a b l ->
  is_RInt (fun t => scal (f' t) (g t)) a b (minus (minus (scal (f b) (g b)) (scal (f a) (g a))) l).
Proof.
intros f g f' g' a b l Df Dg Cf' Cg' If'g.
apply (is_RInt_ext (fun t =>
  minus (plus (scal (f' t) (g t)) (scal (f t) (g' t))) (scal (f t) (g' t)))).
intros x H.
by rewrite /minus -plus_assoc plus_opp_r plus_zero_r.
apply is_RInt_minus with (2 := If'g).
exact: is_RInt_scal_derive.
Qed.

End ByParts.


Require Import Crypto.Compilers.Syntax.
Require Import Crypto.Compilers.ExprInversion.

Section language.
  Context {base_type_code : Type}
          {op : flat_type base_type_code -> flat_type base_type_code -> Type}.
  Local Notation Expr := (@Expr base_type_code op).
  Section with_var.
    Context {var : base_type_code -> Type}.
    Local Notation exprf := (@exprf base_type_code op var).
    Local Notation expr := (@expr base_type_code op var).

    Section gen_flat_type.
      Context (eta : forall {A B}, A * B -> A * B).
      Fixpoint interp_flat_type_eta_gen {t T} : (interp_flat_type var t -> T) -> interp_flat_type var t -> T
        := match t return (interp_flat_type var t -> T) -> interp_flat_type var t -> T with
           | Tbase T => fun f => f
           | Unit => fun f => f
           | Prod A B
             => fun f x
                => let '(a, b) := eta _ _ x in
                   @interp_flat_type_eta_gen
                     A _
                     (fun a' => @interp_flat_type_eta_gen B _ (fun b' => f (a', b')) b)
                     a
           end.

      Section gen_type.
        Context (exprf_eta : forall {t} (e : exprf t), exprf t).
        Definition expr_eta_gen {t} (e : expr t) : expr (Arrow (domain t) (codomain t))
          := Abs (interp_flat_type_eta_gen (fun x => exprf_eta _ (invert_Abs e x))).
      End gen_type.

      Fixpoint exprf_eta_gen {t} (e : exprf t) : exprf t
        := match e in Syntax.exprf _ _ t return exprf t with
           | TT => TT
           | Var t v => Var v
           | Op t1 tR opc args => Op opc (@exprf_eta_gen _ args)
           | LetIn tx ex tC eC
             => LetIn (@exprf_eta_gen _ ex)
                      (interp_flat_type_eta_gen (fun x => @exprf_eta_gen _ (eC x)))
           | Pair tx ex ty ey => Pair (@exprf_eta_gen _ ex) (@exprf_eta_gen _ ey)
           end.
    End gen_flat_type.

    Definition interp_flat_type_eta {t T}
      := @interp_flat_type_eta_gen (fun _ _ x => x) t T.
    Definition interp_flat_type_eta' {t T}
      := @interp_flat_type_eta_gen (fun _ _ x => (fst x, snd x)) t T.
    Definition exprf_eta {t}
      := @exprf_eta_gen (fun _ _ x => x) t.
    Definition exprf_eta' {t}
      := @exprf_eta_gen (fun _ _ x => (fst x, snd x)) t.
    Definition expr_eta {t}
      := @expr_eta_gen (fun _ _ x => x) (@exprf_eta) t.
    Definition expr_eta' {t}
      := @expr_eta_gen (fun _ _ x => (fst x, snd x)) (@exprf_eta') t.
  End with_var.
  Definition ExprEtaGen eta {t} (e : Expr t) : Expr (Arrow (domain t) (codomain t))
    := fun var => expr_eta_gen eta (@exprf_eta_gen var eta) (e var).
  Definition ExprEta {t} (e : Expr t) : Expr (Arrow (domain t) (codomain t))
    := fun var => expr_eta (e var).
  Definition ExprEta' {t} (e : Expr t) : Expr (Arrow (domain t) (codomain t))
    := fun var => expr_eta' (e var).
End language.
(* put these outside the section so the argument order lines up with
   [interp] and [Interp] *)
Definition interp_eta {base_type_code interp_base_type op} interp_op
           {t} (e : @expr base_type_code op interp_base_type t)
  : interp_type interp_base_type t
  := interp_flat_type_eta (interp interp_op e).
Definition InterpEta {base_type_code interp_base_type op} interp_op
           {t} (e : @Expr base_type_code op t)
  : interp_type interp_base_type t
  := interp_eta interp_op (e _).


Require Export parser.
Require Export refine.

Definition P2: IA := parse
"IA [DISC_1_S, IDLE_S, DISC_2_S, CONN_S, WFDIS_S, DISC_3_S, SA_HP_S, DISC_4_S,
    WFTC_S, T_DA_S, DATA_S, SA_DA_S, T_HP_S, CONF_S, WFAR_S, AR_S] (IDLE_S)
 [Sa_CONN_req_S, Sa_DISC_req_S, T_DISC_ind_S, Sa_HPDATA_req_S, T_DATA_ind_S,
  T_CONN_conf_S, Sa_DATA_req_S, T_HPDATA_ind_S]
 [T_CONN_req_S, T_DISC_req_S, Sa_DISC_ind_S, T_HPDATA_req_S, Sa_DATA_ind_S,
  Sa_CONN_conf_S, T_DATA_req_S, Sa_HPDATA_ind_S] [e]
 [DISC_1_S->(Sa_DISC_ind_S)IDLE_S, DISC_2_S->(T_DISC_req_S)IDLE_S,
 IDLE_S->(Sa_CONN_req_S)CONN_S, CONN_S->(e)DISC_1_S,
 WFDIS_S->(T_DISC_req_S)IDLE_S,
 DISC_3_S->(T_DISC_req_S)IDLE_S, DISC_4_S->(Sa_DISC_ind_S)IDLE_S,
 CONN_S->(T_CONN_req_S)WFTC_S, WFTC_S->(Sa_DISC_ind_S)WFDIS_S,
 WFTC_S->(T_DISC_ind_S)DISC_1_S,
 WFTC_S->(T_CONN_conf_S)CONF_S, CONF_S->(T_DISC_req_S)DISC_1_S,
 CONF_S->(T_DATA_req_S)WFAR_S, WFAR_S->(T_DISC_ind_S)DISC_1_S,
 WFAR_S->(Sa_DISC_req_S)DISC_2_S,
 WFAR_S->(T_DATA_ind_S)AR_S, AR_S->(Sa_DISC_ind_S)DISC_2_S,
 AR_S->(Sa_CONN_conf_S)DATA_S,
 DATA_S->(T_DISC_ind_S)DISC_4_S, DATA_S->(Sa_DISC_req_S)DISC_2_S,
 DATA_S->(Sa_HPDATA_req_S)SA_HP_S, SA_HP_S->(T_HPDATA_req_S)DATA_S,
 DATA_S->(T_DATA_ind_S)T_DA_S, T_DA_S->(Sa_DATA_ind_S)DATA_S,
 DATA_S->(Sa_DATA_req_S)SA_DA_S, SA_DA_S->(T_DATA_req_S)DATA_S,
 DATA_S->(T_HPDATA_ind_S)T_HP_S, T_HP_S->(Sa_HPDATA_ind_S)DATA_S,
 T_DA_S->(Sa_DISC_ind_S)DISC_3_S]".

(*,WFAR_S->(Sa_DISC_ind_S)DISC_2_S, WFTC_S->(T_DISC_req_S)DISC_1_S*)

(* SME-NI: true *)
Definition P2_hid: IA :=
 IAutomaton.hiding P2 (ASet.GenActs [&"Sa_HPDATA_req_S",&"T_HPDATA_req_S",
   &"Sa_HPDATA_ind_S",&"T_HPDATA_ind_S"]).

Definition P2_rep: IA :=
 IAutomaton.hiding
 ( IAutomaton.replacement P2 (&"tau") (ASet.GenActs [&"Sa_HPDATA_req_S",&"T_HPDATA_ind_S"]) )
 (ASet.GenActs [&"T_HPDATA_req_S", &"Sa_HPDATA_ind_S"]).

Eval compute in :> P2_hid.
Eval compute in :> P2_rep.
Eval compute in SMENI_refinement P2_rep P2_hid.


Load LFindLoad.
Load LFindLoad.
From adtind Require Import goal86.

From lfind Require Import LFind.
Lemma lfind_state  (x:natural) (y:natural) (IHx:@eq natural (plus (mult x y) x) (mult x (Succ y))):@eq natural (Succ (plus (plus (mult x y) y) x))
  (plus (mult x (Succ y)) (Succ y)).
Admitted.
From QuickChick Require Import QuickChick.
QCInclude "/home/yousef/lemmafinder/benchmark/_lfind_clam_lf_goal86_mult_succ_80_plus_assoc/".
QCInclude ".".
Extract Constant defNumTests => "50".
Derive Show for natural.

              Derive Arbitrary for natural.

              Instance Dec_Eq_natural : Dec_Eq natural.

              Proof. dec_eq. Qed.

Open Scope string_scope.

Parameter print : natural -> string -> natural.
Extract Constant print => "Extract.print".
Definition collect_data  (x:natural) (y:natural) :=
 let lfind_var := "x:" ++ "(" ++ show x ++ ")"++ "|" ++"y:" ++ "(" ++ show y ++ ")"
 in let lfind_v := print x lfind_var
 in lfind_state lfind_v  y.
QuickChick collect_data.
Success.


Require Import Blech.Defaults.

Require Import Coq.Setoids.Setoid.
Require Import Coq.Classes.SetoidClass.

Require Import Blech.Bishop.
Require Import Blech.Functor.
Require Import Blech.Category.
Require Import Blech.Category.Funct.
Require Import Blech.Category.Prod.

Import BishopNotations.
Import CategoryNotations.
Import FunctorNotations.

Open Scope category_scope.
Open Scope bishop_scope.

#[local]
Obligation Tactic := Reflect.category_simpl.

Reserved Notation "·".
Reserved Notation "X ⊗ Y" (at level 50, left associativity).

#[universes(cumulative)]
Class Category := {
  C: Category.Category ;

  pt: C ;
  app: Functor.Functor (C * C) C ;

  (* FIXME add laws *)
}.
(* Lax monoidal functor *)

#[universes(cumulative)]
Class Functor (M N: Category) := {
  F: Functor.Functor (@C M) (@C N) ;
  mon_pt: C pt (F pt) ;
  mon_app {A B}: C (app (F A, F B)) (F (app (A, B)));
}.

Arguments F [M N].

Module Import MonoidalNotations.
  Existing Instance C.
  Coercion C: Category >-> Category.Category.

  Notation "·" := pt.
  Notation "x ⊗ y" := (app (x, y)).

  Existing Instance F.
  Coercion F: Functor >-> Functor.Functor.
End MonoidalNotations.

#[program]
Definition Funct (K L: Category): Category.Category := {|
  Obj := Functor K L ;
  Mor A B := Funct _ _ (F A) (F B) ;

  id _ := id _ ;
  compose _ _ _ := @compose _ _ _ _ ;
|}.


Load LFindLoad.
From lfind Require Import LFind.
From QuickChick Require Import QuickChick.
From adtind Require Import goal33.

Derive Show for natural.

              Derive Arbitrary for natural.

              Instance Dec_Eq_natural : Dec_Eq natural.

              Proof. dec_eq. Qed.

Lemma conj16synthconj5 : forall  (lv0 : natural) (lv1 : natural) (lv2 : natural), (@eq natural (plus (plus lv0 lv1) lv2) (plus lv1 (plus lv0 lv2))).
Admitted.
QuickChick conj16synthconj5.


From Categories Require Import Essentials.Notations.
From Categories Require Import Essentials.Types.
From Categories Require Import Essentials.Facts_Tactics.
From Categories Require Import Category.Main.
From Categories Require Import Functor.Main.
From Categories Require Import Ext_Cons.Comma.
From Categories Require Import Limits.Limit.
From Categories Require Import Archetypal.Discr.Discr.
From Categories Require Import
        Adjunction.Adjunction
        Adjunction.Univ_Morph
.
From Categories Require Import
        Adjunction.AFT.Solution_Set_Cond
        Adjunction.AFT.Commas_Complete.Commas_Complete
.

Section AFT.
  Local Open Scope functor_scope.

  Context
    {C D : Category}
    {CC : Complete C}
    {G : C –≻ D}
    (GCont : Continuous CC G)
    (SSC : ∀ x, Solution_Set_Cond (Comma (Func_From_SingletonCat x) G))
  .

  Program Definition Adjoint_Functor_Theorem : _ ⊣ G :=
    Universal_Morphism_Right_Adjonit
      G
      (fun x : D => Complete_SSC_Initial (Commas_Complete GCont x) (SSC x))
  .

End AFT.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

Variable wd_ : Universe -> Universe -> Prop.
Variable col_ : Universe -> Universe -> Universe -> Prop.

Variable col_swap1_1 : (forall A B C : Universe, (col_ A B C -> col_ B A C)).
Variable col_swap2_2 : (forall A B C : Universe, (col_ A B C -> col_ B C A)).
Variable col_triv_3 : (forall A B : Universe, col_ A B B).
Variable wd_swap_4 : (forall A B : Universe, (wd_ A B -> wd_ B A)).
Variable col_trans_5 : (forall P Q A B C : Universe, ((wd_ P Q /\ (col_ P Q A /\ (col_ P Q B /\ col_ P Q C))) -> col_ A B C)).

Theorem pipo_6 : (forall A B C Aprime Bprime Cprime O : Universe, ((wd_ B O /\ (wd_ C O /\ (wd_ Bprime O /\ (wd_ Cprime O /\ (wd_ A O /\ (wd_ Aprime O /\ (wd_ A B /\ (wd_ A Aprime /\ (col_ O A B /\ (col_ O B C /\ (col_ O Aprime Bprime /\ (col_ O Bprime Cprime /\ (col_ O A C /\ col_ O C Bprime))))))))))))) -> col_ O A Aprime)).
Proof.
  time tac.
Qed.

End FOFProblem.