(**************************************************************)
(*   Copyright Dominique Larchey-Wendling [*]                 *)
(*                                                            *)
(*                             [*] Affiliation LORIA -- CNRS  *)
(**************************************************************)
(*      This file is distributed under the terms of the       *)
(*         CeCILL v2 FREE SOFTWARE LICENSE AGREEMENT          *)
(**************************************************************)

Require Import List Bool Utf8. (* → λ ∀ ∃ ↔ ∧ ∨ ≤ ¬ ≠ *)

Require Import unif_graph_def.

Set Implicit Arguments.

Reserved Notation "a '<sc' b" (at level 70, no associativity).

Inductive unif_sub_call : Λ*Λ → Λ*Λ → Prop :=
  | in_usc_0 m n m' n' : (m,m') <sc (m⋄n,m'⋄n')
  | in_usc_1 m n m' n' σ : m ⋉ m' ⟼u Some σ → (n⦃σ⦄,n'⦃σ⦄) <sc (m⋄n,m'⋄n')
where "p <sc q" := (unif_sub_call p q).

Definition 𝔻unif m n := Acc unif_sub_call (m,n).

Section unif.

  (** The actual recursive definition of unif, fully dependent,
      with computational contents separated from logical contents *)

  (* → λ ∀ ∃ ↔ ∧ ∨ ≤ ¬ ≠ *)

  (* The explicit dependent pattern matching

       match u as u' return u = u' → ** 𝔻unif u' _ → {r | u'⋉_ ⟼u r} ** with

     ** ... ** added is not needed anymore for Coq version 8.11+

     there are other cases as well *)

  Let Fixpoint unif_pwc u v (D : 𝔻unif u v) {struct D} : {r | u⋉v ⟼u r}.
  Proof. refine (
    match u as u' return u = u' → 𝔻unif u' _ → {r | u'⋉_ ⟼u r} with
      | µ x   => λ E D,
      match occ_check_dec x v with
        | left H  => exist _ None _
        | right H => exist _ (Some ((x,v)::∅)) _
      end
      | φ c => λ E D,
      match v as v' return 𝔻unif _ v' → {r | _⋉v' ⟼u r} with
        | µ y => λ D, exist _ (Some ((y,u)::∅)) _
        | φ d => λ D,
        match eqC_dec c d with
          | left H  => exist _ (Some ∅) _
          | right H => exist _ None _
        end
        | m'⋄n' => λ D, exist _ None _
      end D
      | m⋄n  => λ E D,
      match v as v' return 𝔻unif _ v' → {r | _⋉v' ⟼u r} with
        | µ y => λ D,
        match occ_check_dec y u with
          | left H  => exist _ None _
          | right H => exist _ (Some ((y,u)::∅)) _
        end
        | φ d => λ D, exist _ None _
        | m'⋄n' => λ D,
        let (r,Cr) := @unif_pwc m m' _
        in match r return _⋉_ ⟼u r → _ with
          | Some r => λ Cr,
          let (s,Cs) := @unif_pwc n⦃r⦄ n'⦃r⦄ _
          in match s return _⋉_ ⟼u s → _ with
            | Some s => λ Cs, exist _ (Some (r o s)) _
            | None   => λ Cs, exist _ None _
          end Cs
          | None   => λ Cr, exist _ None _
        end Cr
      end D
    end eq_refl D).
    1-11: cycle 9.
    1-2: apply Acc_inv with (1 := D); constructor; trivial.
    11: constructor 11 with r; trivial.
    all: subst u; constructor; trivial.
  Qed.

  (** Now we project to get two projections *)

  Definition unif u v (D : 𝔻unif u v) := proj1_sig (@unif_pwc _ _ D).

  Fact unif_spec u v D : u ⋉ v ⟼u @unif u v D.
  Proof. apply (proj2_sig _). Qed.

End unif.

Hint Resolve unif_spec : core.

Fact 𝔻unif_1 c m n : 𝔻unif (φ c) (m⋄n).     Proof. constructor; inversion 1. Qed.
Fact 𝔻unif_2 c m n : 𝔻unif (m⋄n) (φ c).     Proof. constructor; inversion 1. Qed.
Fact 𝔻unif_3 c x :   𝔻unif (φ c) (µ x).     Proof. constructor; inversion 1. Qed.
Fact 𝔻unif_4 m n x : 𝔻unif (m⋄n) (µ x).     Proof. constructor; inversion 1. Qed.
Fact 𝔻unif_5 x t :   𝔻unif (µ x) t.         Proof. constructor; inversion 1. Qed.
Fact 𝔻unif_6 c d :   𝔻unif (φ c) (φ d).     Proof. constructor; inversion 1. Qed.

(* → λ ∀ ∃ ↔ ∧ ∨ ≤ ¬ ≠ *)

Fact 𝔻unif_7 m n m' n' (D : 𝔻unif m m') :
       unif D = None → 𝔻unif (m⋄n) (m'⋄n').
Proof.
  intros H; constructor.
  inversion 1; trivial.
  generalize (𝔾unif_fun H3 (unif_spec D)); rewrite -> H; discriminate.
Qed.

Fact 𝔻unif_8 m n m' n' (D : 𝔻unif  m m') σ :
       unif D = Some σ → 𝔻unif n⦃σ⦄ n'⦃σ⦄ → 𝔻unif (m⋄n) (m'⋄n').
Proof.
  intros H1 D2.
  constructor.
  inversion 1; trivial.
  subst.
  generalize (𝔾unif_fun H3 (unif_spec D)); rewrite -> H1.
  inversion 1; trivial.
Qed.

Section 𝔻unif_rect.

  Variable   P   : ∀ u v, 𝔻unif u v → Type.

  Hypothesis HPi : ∀ u v (D1 D2 : 𝔻unif  u v), P D1 → P D2.

  Hypothesis HP1 : ∀ c m n, P (𝔻unif_1 c m n).
  Hypothesis HP2 : ∀ c m n, P (𝔻unif_2 c m n).
  Hypothesis HP3 : ∀ c x,   P (𝔻unif_3 c x).
  Hypothesis HP4 : ∀ m n x, P (𝔻unif_4 m n x).
  Hypothesis HP5 : ∀ x m,   P (𝔻unif_5 x m).
  Hypothesis HP6 : ∀ c d,   P (𝔻unif_6 c d).
  Hypothesis HP7 : ∀ m n m' n' (D1 : 𝔻unif m m') (ID1 : P D1) (H1 : unif D1 = None), P (𝔻unif_7 n n' D1 H1).
  Hypothesis HP8 : ∀ m n m' n' (D1 : 𝔻unif m m') (ID1 : P D1) σ (H1 : unif D1 = Some σ)
                               (D2 : 𝔻unif n⦃σ⦄ n'⦃σ⦄) (ID2 : P D2), P (𝔻unif_8 _ _ D1 H1 D2).

  Fixpoint 𝔻unif_rect u v (D : 𝔻unif u v) { struct D } : P D.
  Proof.
    destruct u as [ x | c | m n ].
    + apply HPi with (1 := HP5 _ _).
    + destruct v as [ y | d | m' n' ].
      * apply HPi with (1 := HP3 _ _).
      * apply HPi with (1 := HP6 _ _).
      * apply HPi with (1 := HP1 _ _ _).
    + destruct v as [ y | d | m' n' ].
      * apply HPi with (1 := HP4 _ _ _).
      * apply HPi with (1 := HP2 _ _ _).
      * assert (𝔻unif m m') as D'.
        { apply Acc_inv with (1 := D); constructor. }
        case_eq (unif D').
        - intros σ Hσ.
          refine (HPi _ (HP8 _ _ (𝔻unif_rect m m' D') Hσ (𝔻unif_rect _ _ _))).
          apply Acc_inv with (1 := D); constructor.
          rewrite <- Hσ; apply unif_spec.
        - intros H.
          apply HPi with (1 := HP7 _ _ (𝔻unif_rect m m' D') H).
  Qed.

End 𝔻unif_rect.


Require Import List.

Require Import Net.
Require Import StructTact.StructTactics.

Class InverseTraceRelation `{State : Type} `{Event : Type} (step : step_relation State Event) :=
  {
    init : State;
    T : (list Event) -> Prop;
    R : State -> Prop;
    R_dec : forall s, {R s} + {~ R s};
    T_monotonic : forall tr o, T tr -> T (tr ++ o);
    R_false_init : ~ R init;
    R_implies_T : forall s s' o tr,
                    refl_trans_1n_trace step init s tr ->
                    ~ R s ->
                    step s s' o ->
                    R s' ->
                    T (tr ++ o)
  }.

Section InverseTraceRelations.
  Context `{ITR : InverseTraceRelation}.

  Theorem inverse_trace_relations_work :
    forall s tr,
      refl_trans_1n_trace step init s tr ->
      R s ->
      T tr.
  Proof using.
    intros. find_apply_lem_hyp refl_trans_1n_n1_trace.
    remember init as s'.
    induction H.
    - subst. exfalso. eauto using R_false_init.
    - subst. concludes.
      destruct (R_dec x');
        intuition eauto using T_monotonic, refl_trans_n1_1n_trace, R_implies_T.
  Qed.
End InverseTraceRelations.


(************************************************************************)
(*         *   The Coq Proof Assistant / The Coq Development Team       *)
(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
(* <O___,, *       (see CREDITS file for the list of authors)           *)
(*   \VV/  **************************************************************)
(*    //   *    This file is distributed under the terms of the         *)
(*         *     GNU Lesser General Public License Version 2.1          *)
(*         *     (see LICENSE file for the text of the license)         *)
(************************************************************************)

Require Import XRbase.
Require Import XRfunctions.
Require Import XSeqSeries.
Require Import XRtrigo1.
Require Import XRanalysis1.
Require Import XPSeries_reg.
Require Import Div2.
Require Import Even.
Require Import Max.
Require Import Omega.
Local Open Scope nat_scope.
Local Open Scope XR_scope.

Definition E1 (x:R) (N:nat) : R :=
  sum_f_R0 (fun k:nat => / INR (fact k) * x ^ k) N.

Lemma E1_cvg : forall x:R, Un_cv (E1 x) (exp x).
Proof.
  intro; unfold exp; unfold projT1.
  case (exist_exp x); intro.
  unfold exp_in, Un_cv; unfold infinite_sum, E1; trivial.
Qed.

Definition Reste_E (x y:R) (N:nat) : R :=
  sum_f_R0
  (fun k:nat =>
    sum_f_R0
    (fun l:nat =>
      / INR (fact (S (l + k))) * x ^ S (l + k) *
      (/ INR (fact (N - l)) * y ^ (N - l))) (
        pred (N - k))) (pred N).

Lemma exp_form :
  forall (x y:R) (n:nat),
    (0 < n)%nat -> E1 x n * E1 y n - Reste_E x y n = E1 (x + y) n.
Proof.
  intros; unfold E1.
  rewrite cauchy_finite.
  unfold Reste_E; unfold Rminus; rewrite Rplus_assoc;
    rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq;
      intros.
  rewrite binomial.
  rewrite scal_sum; apply sum_eq; intros.
  unfold C; unfold Rdiv; repeat rewrite Rmult_assoc;
    rewrite (Rmult_comm (INR (fact i))); repeat rewrite Rmult_assoc;
      rewrite <- Rinv_l_sym.
  rewrite Rmult_1_r; rewrite Rinv_mult_distr.
{
  repeat rewrite Rmult_assoc.
  apply Rmult_eq_compat_l.
  rewrite Rmult_comm.
  repeat rewrite Rmult_assoc.
  apply Rmult_eq_compat_l.
  rewrite Rmult_comm.
  reflexivity.
}
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  apply H.
Qed.

Definition maj_Reste_E (x y:R) (N:nat) : R :=
  R4 *
  (Rmax R1 (Rmax (Rabs x) (Rabs y)) ^ (2 * N) /
    Rsqr (INR (fact (div2 (pred N))))).

(**********)
Lemma div2_double : forall N:nat, div2 (2 * N) = N.
Proof.
  intro; induction  N as [| N HrecN].
  reflexivity.
  replace (2 * S N)%nat with (S (S (2 * N))).
  simpl; simpl in HrecN; rewrite HrecN; reflexivity.
  ring.
Qed.

Lemma div2_S_double : forall N:nat, div2 (S (2 * N)) = N.
Proof.
  intro; induction  N as [| N HrecN].
  reflexivity.
  replace (2 * S N)%nat with (S (S (2 * N))).
  simpl; simpl in HrecN; rewrite HrecN; reflexivity.
  ring.
Qed.

Lemma div2_not_R0 : forall N:nat, (1 < N)%nat -> (0 < div2 N)%nat.
Proof.
  intros; induction N as [| N HrecN].
  - elim (lt_n_O _ H).
  - cut ((1 < N)%nat \/ N = 1%nat).
    { intro; elim H0; intro.
      + destruct (even_odd_dec N) as [Heq|Heq].
        * rewrite <- (even_div2 _ Heq); apply HrecN; assumption.
        * rewrite <- (odd_div2 _ Heq); apply lt_O_Sn.
      + rewrite H1; simpl; apply lt_O_Sn. }
    inversion H.
    right; reflexivity.
    left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ].
Qed.

Lemma Reste_E_maj :
  forall (x y:R) (N:nat),
    (0 < N)%nat -> Rabs (Reste_E x y N) <= maj_Reste_E x y N.
Proof.
  intros; set (M := Rmax R1 (Rmax (Rabs x) (Rabs y))).
  apply Rle_trans with
    (M ^ (2 * N) *
      sum_f_R0
      (fun k:nat =>
        sum_f_R0 (fun l:nat => / Rsqr (INR (fact (div2 (S N)))))
        (pred (N - k))) (pred N)).
  unfold Reste_E.
  apply Rle_trans with
    (sum_f_R0
      (fun k:nat =>
        Rabs
        (sum_f_R0
          (fun l:nat =>
            / INR (fact (S (l + k))) * x ^ S (l + k) *
            (/ INR (fact (N - l)) * y ^ (N - l))) (
              pred (N - k)))) (pred N)).
  apply
    (Rsum_abs
      (fun k:nat =>
        sum_f_R0
        (fun l:nat =>
          / INR (fact (S (l + k))) * x ^ S (l + k) *
          (/ INR (fact (N - l)) * y ^ (N - l))) (
            pred (N - k))) (pred N)).
  apply Rle_trans with
    (sum_f_R0
      (fun k:nat =>
        sum_f_R0
        (fun l:nat =>
          Rabs
          (/ INR (fact (S (l + k))) * x ^ S (l + k) *
            (/ INR (fact (N - l)) * y ^ (N - l)))) (
              pred (N - k))) (pred N)).
  apply sum_Rle; intros.
  apply
    (Rsum_abs
      (fun l:nat =>
        / INR (fact (S (l + n))) * x ^ S (l + n) *
        (/ INR (fact (N - l)) * y ^ (N - l)))).
  apply Rle_trans with
    (sum_f_R0
      (fun k:nat =>
        sum_f_R0
        (fun l:nat =>
          M ^ (2 * N) * / INR (fact (S l)) * / INR (fact (N - l)))
        (pred (N - k))) (pred N)).
  apply sum_Rle; intros.
  apply sum_Rle; intros.
  repeat rewrite Rabs_mult.
  do 2 rewrite <- RPow_abs.
  rewrite (Rabs_right (/ INR (fact (S (n0 + n))))).
  rewrite (Rabs_right (/ INR (fact (N - n0)))).
  replace
  (/ INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) *
    (/ INR (fact (N - n0)) * Rabs y ^ (N - n0))) with
  (/ INR (fact (N - n0)) * / INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) *
    Rabs y ^ (N - n0)).
2:{
  repeat rewrite Rmult_assoc.
  rewrite Rmult_comm.
  repeat rewrite Rmult_assoc.
  repeat apply Rmult_eq_compat_l.
  rewrite Rmult_comm.
  reflexivity.
}
  rewrite <- (Rmult_comm (/ INR (fact (N - n0)))).
  repeat rewrite Rmult_assoc.
  apply Rmult_le_compat_l.
  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
  apply Rle_trans with
    (/ INR (fact (S n0)) * Rabs x ^ S (n0 + n) * Rabs y ^ (N - n0)).
  rewrite (Rmult_comm (/ INR (fact (S (n0 + n)))));
    rewrite (Rmult_comm (/ INR (fact (S n0)))); repeat rewrite Rmult_assoc;
      apply Rmult_le_compat_l.
  apply pow_le; apply Rabs_pos.
  rewrite (Rmult_comm (/ INR (fact (S n0)))); apply Rmult_le_compat_l.
  apply pow_le; apply Rabs_pos.
  apply Rinv_le_contravar.
  apply INR_fact_lt_0.
  apply le_INR; apply fact_le; apply le_n_S.
  apply le_plus_l.
  rewrite (Rmult_comm (M ^ (2 * N))); rewrite Rmult_assoc;
    apply Rmult_le_compat_l.
  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
  apply Rle_trans with (M ^ S (n0 + n) * Rabs y ^ (N - n0)).
  do 2 rewrite <- (Rmult_comm (Rabs y ^ (N - n0))).
  apply Rmult_le_compat_l.
  apply pow_le; apply Rabs_pos.
  apply pow_incr; split.
  apply Rabs_pos.
  apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
  apply RmaxLess1.
  unfold M; apply RmaxLess2.
  apply Rle_trans with (M ^ S (n0 + n) * M ^ (N - n0)).
  apply Rmult_le_compat_l.
  apply pow_le; apply Rle_trans with R1.
  left; apply Rlt_0_1.
  unfold M; apply RmaxLess1.
  apply pow_incr; split.
  apply Rabs_pos.
  apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
  apply RmaxLess2.
  unfold M; apply RmaxLess2.
  rewrite <- pow_add; replace (S (n0 + n) + (N - n0))%nat with (N + S n)%nat.
  apply Rle_pow.
  unfold M; apply RmaxLess1.
  replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ].
  apply plus_le_compat_l.
  replace N with (S (pred N)).
  apply le_n_S; apply H0.
  symmetry ; apply S_pred with 0%nat; apply H.
  apply INR_eq; do 2 rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR;
    rewrite minus_INR.
{
  unfold Rminus.
  symmetry.
  repeat rewrite Rplus_assoc.
  rewrite Rplus_comm.
  repeat rewrite Rplus_assoc.
  rewrite Rplus_comm.
  repeat rewrite Rplus_assoc.
  rewrite Rplus_comm.
  repeat rewrite Rplus_assoc.
  apply Rplus_eq_compat_l.
  repeat rewrite <- Rplus_assoc.
  rewrite Rplus_opp_l.
  rewrite Rplus_0_l.
  reflexivity.
}
  apply le_trans with (pred (N - n)).
  apply H1.
  apply le_S_n.
  replace (S (pred (N - n))) with (N - n)%nat.
  apply le_trans with N.
  apply (fun p n m:nat => plus_le_reg_l n m p) with n.
  rewrite <- le_plus_minus.
  apply le_plus_r.
  apply le_trans with (pred N).
  apply H0.
  apply le_pred_n.
  apply le_n_Sn.
  apply S_pred with 0%nat.
  apply plus_lt_reg_l with n.
  rewrite <- le_plus_minus.
  replace (n + 0)%nat with n; [ idtac | ring ].
  apply le_lt_trans with (pred N).
  apply H0.
  apply lt_pred_n_n.
  apply H.
  apply le_trans with (pred N).
  apply H0.
  apply le_pred_n.
  apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
  apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
  rewrite scal_sum.
  apply sum_Rle; intros.
  rewrite <- Rmult_comm.
  rewrite scal_sum.
  apply sum_Rle; intros.
  rewrite (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))).
  rewrite Rmult_assoc; apply Rmult_le_compat_l.
  apply pow_le.
  apply Rle_trans with R1.
  left; apply Rlt_0_1.
  unfold M; apply RmaxLess1.
  assert (H2 := even_odd_cor N).
  elim H2; intros N0 H3.
  elim H3; intro.
  apply Rle_trans with (/ INR (fact n0) * / INR (fact (N - n0))).
  do 2 rewrite <- (Rmult_comm (/ INR (fact (N - n0)))).
  apply Rmult_le_compat_l.
  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
  apply Rinv_le_contravar.
  apply INR_fact_lt_0.
  apply le_INR.
  apply fact_le.
  apply le_n_Sn.
  replace (/ INR (fact n0) * / INR (fact (N - n0))) with
  (C N n0 / INR (fact N)).
  pattern N at 1; rewrite H4.
  apply Rle_trans with (C N N0 / INR (fact N)).
  unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ INR (fact N))).
  apply Rmult_le_compat_l.
  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
  rewrite H4.
  apply C_maj.
  rewrite <- H4; apply le_trans with (pred (N - n)).
  apply H1.
  apply le_S_n.
  replace (S (pred (N - n))) with (N - n)%nat.
  apply le_trans with N.
  apply (fun p n m:nat => plus_le_reg_l n m p) with n.
  rewrite <- le_plus_minus.
  apply le_plus_r.
  apply le_trans with (pred N).
  apply H0.
  apply le_pred_n.
  apply le_n_Sn.
  apply S_pred with 0%nat.
  apply plus_lt_reg_l with n.
  rewrite <- le_plus_minus.
  replace (n + 0)%nat with n; [ idtac | ring ].
  apply le_lt_trans with (pred N).
  apply H0.
  apply lt_pred_n_n.
  apply H.
  apply le_trans with (pred N).
  apply H0.
  apply le_pred_n.
  replace (C N N0 / INR (fact N)) with (/ Rsqr (INR (fact N0))).
  rewrite H4; rewrite div2_S_double; right; reflexivity.
  unfold Rsqr, C, Rdiv.
  repeat rewrite Rinv_mult_distr.
  rewrite (Rmult_comm (INR (fact N))).
  repeat rewrite Rmult_assoc.
  rewrite <- Rinv_r_sym.
  rewrite Rmult_1_r; replace (N - N0)%nat with N0.
{
  reflexivity.
}
  replace N with (N0 + N0)%nat.
  symmetry ; apply minus_plus.
  rewrite H4.
  ring.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  unfold C, Rdiv.
  rewrite (Rmult_comm (INR (fact N))).
  repeat rewrite Rmult_assoc.
  rewrite <- Rinv_r_sym.
  rewrite Rinv_mult_distr.
  rewrite Rmult_1_r. reflexivity.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  replace (/ INR (fact (S n0)) * / INR (fact (N - n0))) with
  (C (S N) (S n0) / INR (fact (S N))).
  apply Rle_trans with (C (S N) (S N0) / INR (fact (S N))).
  unfold Rdiv; do 2 rewrite <- (Rmult_comm (/ INR (fact (S N)))).
  apply Rmult_le_compat_l.
  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
  cut (S N = (2 * S N0)%nat).
  intro; rewrite H5; apply C_maj.
  rewrite <- H5; apply le_n_S.
  apply le_trans with (pred (N - n)).
  apply H1.
  apply le_S_n.
  replace (S (pred (N - n))) with (N - n)%nat.
  apply le_trans with N.
  apply (fun p n m:nat => plus_le_reg_l n m p) with n.
  rewrite <- le_plus_minus.
  apply le_plus_r.
  apply le_trans with (pred N).
  apply H0.
  apply le_pred_n.
  apply le_n_Sn.
  apply S_pred with 0%nat.
  apply plus_lt_reg_l with n.
  rewrite <- le_plus_minus.
  replace (n + 0)%nat with n; [ idtac | ring ].
  apply le_lt_trans with (pred N).
  apply H0.
  apply lt_pred_n_n.
  apply H.
  apply le_trans with (pred N).
  apply H0.
  apply le_pred_n.
  rewrite H4; ring.
  cut (S N = (2 * S N0)%nat).
  intro.
  replace (C (S N) (S N0) / INR (fact (S N))) with (/ Rsqr (INR (fact (S N0)))).
  rewrite H5; rewrite div2_double.
  right; reflexivity.
  unfold Rsqr, C, Rdiv.
  repeat rewrite Rinv_mult_distr.
  replace (S N - S N0)%nat with (S N0).
  rewrite (Rmult_comm (INR (fact (S N)))).
  repeat rewrite Rmult_assoc.
  rewrite <- Rinv_r_sym.
  rewrite Rmult_1_r; reflexivity.
  apply INR_fact_neq_0.
  replace (S N) with (S N0 + S N0)%nat.
  symmetry ; apply minus_plus.
  rewrite H5; ring.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  rewrite H4; ring.
  unfold C, Rdiv.
  rewrite (Rmult_comm (INR (fact (S N)))).
  rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
  rewrite Rmult_1_r; rewrite Rinv_mult_distr.
  reflexivity.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  unfold maj_Reste_E.
  unfold Rdiv; rewrite (Rmult_comm R4).
  rewrite Rmult_assoc.
  apply Rmult_le_compat_l.
  apply pow_le.
  apply Rle_trans with R1.
  left; apply Rlt_0_1.
  apply RmaxLess1.
  apply Rle_trans with
    (sum_f_R0 (fun k:nat => INR (N - k) * / Rsqr (INR (fact (div2 (S N)))))
      (pred N)).
  apply sum_Rle; intros.
  rewrite sum_cte.
  replace (S (pred (N - n))) with (N - n)%nat.
  right; apply Rmult_comm.
  apply S_pred with 0%nat.
  apply plus_lt_reg_l with n.
  rewrite <- le_plus_minus.
  replace (n + 0)%nat with n; [ idtac | ring ].
  apply le_lt_trans with (pred N).
  apply H0.
  apply lt_pred_n_n.
  apply H.
  apply le_trans with (pred N).
  apply H0.
  apply le_pred_n.
  apply Rle_trans with
    (sum_f_R0 (fun k:nat => INR N * / Rsqr (INR (fact (div2 (S N))))) (pred N)).
  apply sum_Rle; intros.
  do 2 rewrite <- (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))).
  apply Rmult_le_compat_l.
  left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt.
  apply INR_fact_neq_0.
  apply le_INR.
  apply (fun p n m:nat => plus_le_reg_l n m p) with n.
  rewrite <- le_plus_minus.
  apply le_plus_r.
  apply le_trans with (pred N).
  apply H0.
  apply le_pred_n.
  rewrite sum_cte; replace (S (pred N)) with N.
  cut (div2 (S N) = S (div2 (pred N))).
  intro; rewrite H0.
  rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR; rewrite Rsqr_mult.
  rewrite Rinv_mult_distr.
  rewrite (Rmult_comm (INR N)); repeat rewrite Rmult_assoc;
    apply Rmult_le_compat_l.
  left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0.
  rewrite <- H0.
  cut (INR N <= INR (2 * div2 (S N))).
  intro; apply Rmult_le_reg_l with (Rsqr (INR (div2 (S N)))).
  apply Rsqr_pos_lt.
  apply not_O_INR; red; intro.
  cut (1 < S N)%nat.
  intro; assert (H4 := div2_not_R0 _ H3).
  rewrite H2 in H4; elim (lt_n_O _ H4).
  apply lt_n_S; apply H.
  repeat rewrite <- Rmult_assoc.
  rewrite <- Rinv_r_sym.
  rewrite Rmult_1_l.
  replace R4 with (Rsqr R2).
  rewrite <- Rsqr_mult.
  apply Rsqr_incr_1.
  change R2 with (INR 2).
  rewrite Rmult_comm, <- mult_INR; apply H1.
  left; apply lt_INR_0; apply H.
  left; apply Rmult_lt_0_compat.
  apply lt_INR_0; apply div2_not_R0.
  apply lt_n_S; apply H.
exact Rlt_0_2.
unfold Rsqr. {
  unfold R4.
  unfold R2.
  repeat rewrite Rmult_plus_distr_l.
  repeat rewrite Rmult_plus_distr_r.
  repeat rewrite Rmult_1_r.
  repeat rewrite <- Rplus_assoc.
  reflexivity.
}
  cut (1 < S N)%nat.
  intro; unfold Rsqr; apply prod_neq_R0; apply not_O_INR; intro;
    assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4;
      elim (lt_n_O _ H4).
  apply lt_n_S; apply H.
  assert (H1 := even_odd_cor N).
  elim H1; intros N0 H2.
  elim H2; intro.
  pattern N at 2; rewrite H3.
  rewrite div2_S_double.
  right; rewrite H3; reflexivity.
  pattern N at 2; rewrite H3.
  replace (S (S (2 * N0))) with (2 * S N0)%nat.
  rewrite div2_double.
  rewrite H3.
  rewrite S_INR; do 2 rewrite mult_INR.
  rewrite (S_INR N0).
  rewrite Rmult_plus_distr_l.
  apply Rplus_le_compat_l.
  rewrite Rmult_1_r.
  simpl.
  pattern R1 at 1; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
    apply Rlt_0_1.
  ring.
  unfold Rsqr; apply prod_neq_R0; apply INR_fact_neq_0.
  unfold Rsqr; apply prod_neq_R0; apply not_O_INR; discriminate.
  assert (H0 := even_odd_cor N).
  elim H0; intros N0 H1.
  elim H1; intro.
  cut (0 < N0)%nat.
  intro; rewrite H2.
  rewrite div2_S_double.
  replace (2 * N0)%nat with (S (S (2 * pred N0))).
  replace (pred (S (S (2 * pred N0)))) with (S (2 * pred N0)).
  rewrite div2_S_double.
  apply S_pred with 0%nat; apply H3.
  reflexivity.
  omega.
  omega.
  rewrite H2.
  replace (pred (S (2 * N0))) with (2 * N0)%nat; [ idtac | reflexivity ].
  replace (S (S (2 * N0))) with (2 * S N0)%nat.
  do 2 rewrite div2_double.
  reflexivity.
  ring.
  apply S_pred with 0%nat; apply H.
Qed.

Lemma maj_Reste_cv_R0 : forall x y:R, Un_cv (maj_Reste_E x y) R0.
Proof.
  intros; assert (H := Majxy_cv_R0 x y).
  unfold Un_cv in H; unfold Un_cv; intros.
  cut (R0 < eps / R4);
    [ intro
      | unfold Rdiv; apply Rmult_lt_0_compat;
        [ assumption | apply Rinv_0_lt_compat; idtac ] ].
2:exact Rlt_0_4.
  elim (H _ H1); intros N0 H2.
  exists (max (2 * S N0) 2); intros.
  unfold R_dist in H2; unfold R_dist; rewrite Rminus_0_r;
    unfold Majxy in H2; unfold maj_Reste_E.
  rewrite Rabs_right.
  apply Rle_lt_trans with
    (R4 *
      (Rmax R1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) /
        INR (fact (div2 (pred n))))).
  apply Rmult_le_compat_l.
  left; exact Rlt_0_4.
  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr.
  rewrite (Rmult_comm (Rmax R1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)));
    rewrite
      (Rmult_comm (Rmax R1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n)))))
      ; rewrite Rmult_assoc; apply Rmult_le_compat_l.
  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
  apply Rle_trans with (Rmax R1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)).
  rewrite Rmult_comm;
    pattern (Rmax R1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)) at 2;
      rewrite <- Rmult_1_r; apply Rmult_le_compat_l.
  apply pow_le; apply Rle_trans with R1.
  left; apply Rlt_0_1.
  apply RmaxLess1.
  apply Rmult_le_reg_l with (INR (fact (div2 (pred n)))).
  apply INR_fact_lt_0.
  rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
  apply (le_INR 1).
  apply lt_le_S.
  apply INR_lt.
  apply INR_fact_lt_0.
  apply INR_fact_neq_0.
  apply Rle_pow.
  apply RmaxLess1.
  assert (H4 := even_odd_cor n).
  elim H4; intros N1 H5.
  elim H5; intro.
  cut (0 < N1)%nat.
  intro.
  rewrite H6.
  replace (pred (2 * N1)) with (S (2 * pred N1)).
  rewrite div2_S_double.
  omega.
  omega.
  assert (0 < n)%nat.
  apply lt_le_trans with 2%nat.
  apply lt_O_Sn.
  apply le_trans with (max (2 * S N0) 2).
  apply le_max_r.
  apply H3.
  omega.
  rewrite H6.
  replace (pred (S (2 * N1))) with (2 * N1)%nat.
  rewrite div2_double.
  replace (4 * S N1)%nat with (2 * (2 * S N1))%nat.
  apply (fun m n p:nat => mult_le_compat_l p n m).
  replace (2 * S N1)%nat with (S (S (2 * N1))).
  apply le_n_Sn.
  ring.
  ring.
  reflexivity.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  apply Rmult_lt_reg_l with (/ R4).
  apply Rinv_0_lt_compat; exact Rlt_0_4.
  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
  rewrite Rmult_1_l; rewrite Rmult_comm.
  replace
  (Rmax R1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) /
    INR (fact (div2 (pred n)))) with
  (Rabs
    (Rmax R1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) /
      INR (fact (div2 (pred n))) - R0)).
  apply H2; unfold ge.
  cut (2 * S N0 <= n)%nat.
  intro; apply le_S_n.
  apply INR_le; apply Rmult_le_reg_l with (INR 2).
  simpl; exact Rlt_0_2.
  do 2 rewrite <- mult_INR; apply le_INR.
  apply le_trans with n.
  apply H4.
  assert (H5 := even_odd_cor n).
  elim H5; intros N1 H6.
  elim H6; intro.
  cut (0 < N1)%nat.
  intro.
  rewrite H7.
  apply (fun m n p:nat => mult_le_compat_l p n m).
  replace (pred (2 * N1)) with (S (2 * pred N1)).
  rewrite div2_S_double.
  replace (S (pred N1)) with N1.
  apply le_n.
  apply S_pred with 0%nat; apply H8.
  replace (2 * N1)%nat with (S (S (2 * pred N1))).
  reflexivity.
  pattern N1 at 2; replace N1 with (S (pred N1)).
  ring.
  symmetry ; apply S_pred with 0%nat; apply H8.
  apply INR_lt.
  apply Rmult_lt_reg_l with (INR 2).
  simpl; exact Rlt_0_2.
  rewrite Rmult_0_r; rewrite <- mult_INR.
  apply lt_INR_0.
  rewrite <- H7.
  apply lt_le_trans with 2%nat.
  apply lt_O_Sn.
  apply le_trans with (max (2 * S N0) 2).
  apply le_max_r.
  apply H3.
  rewrite H7.
  replace (pred (S (2 * N1))) with (2 * N1)%nat.
  rewrite div2_double.
  replace (2 * S N1)%nat with (S (S (2 * N1))).
  apply le_n_Sn.
  ring.
  reflexivity.
  apply le_trans with (max (2 * S N0) 2).
  apply le_max_l.
  apply H3.
  rewrite Rminus_0_r; apply Rabs_right.
  apply Rle_ge.
  unfold Rdiv; apply Rmult_le_pos.
  apply pow_le.
  apply Rle_trans with R1.
  left; apply Rlt_0_1.
  apply RmaxLess1.
  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
  apply Rlt_not_eq';exact Rlt_0_4.
  apply Rle_ge.
  unfold Rdiv; apply Rmult_le_pos.
  left; exact Rlt_0_4.
  apply Rmult_le_pos.
  apply pow_le.
  apply Rle_trans with R1.
  left; apply Rlt_0_1.
  apply RmaxLess1.
  left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0.
Qed.

(**********)
Lemma Reste_E_cv : forall x y:R, Un_cv (Reste_E x y) R0.
Proof.
  intros; assert (H := maj_Reste_cv_R0 x y).
  unfold Un_cv in H; unfold Un_cv; intros; elim (H _ H0); intros.
  exists (max x0 1); intros.
  unfold R_dist; rewrite Rminus_0_r.
  apply Rle_lt_trans with (maj_Reste_E x y n).
  apply Reste_E_maj.
  apply lt_le_trans with 1%nat.
  apply lt_O_Sn.
  apply le_trans with (max x0 1).
  apply le_max_r.
  apply H2.
  replace (maj_Reste_E x y n) with (R_dist (maj_Reste_E x y n) R0).
  apply H1.
  unfold ge; apply le_trans with (max x0 1).
  apply le_max_l.
  apply H2.
  unfold R_dist; rewrite Rminus_0_r; apply Rabs_right.
  apply Rle_ge; apply Rle_trans with (Rabs (Reste_E x y n)).
  apply Rabs_pos.
  apply Reste_E_maj.
  apply lt_le_trans with 1%nat.
  apply lt_O_Sn.
  apply le_trans with (max x0 1).
  apply le_max_r.
  apply H2.
Qed.

(**********)
Lemma exp_plus : forall x y:R, exp (x + y) = exp x * exp y.
Proof.
  intros; assert (H0 := E1_cvg x).
  assert (H := E1_cvg y).
  assert (H1 := E1_cvg (x + y)).
  eapply UL_sequence.
  apply H1.
  assert (H2 := CV_mult _ _ _ _ H0 H).
  assert (H3 := CV_minus _ _ _ _ H2 (Reste_E_cv x y)).
  unfold Un_cv; unfold Un_cv in H3; intros.
  elim (H3 _ H4); intros.
  exists (S x0); intros.
  rewrite <- (exp_form x y n).
  rewrite Rminus_0_r in H5.
  apply H5.
  unfold ge; apply le_trans with (S x0).
  apply le_n_Sn.
  apply H6.
  apply lt_le_trans with (S x0).
  apply lt_O_Sn.
  apply H6.
Qed.

(**********)
Lemma exp_pos_pos : forall x:R, R0 < x -> R0 < exp x.
Proof.
  intros; set (An := fun N:nat => / INR (fact N) * x ^ N).
  cut (Un_cv (fun n:nat => sum_f_R0 An n) (exp x)).
  intro; apply Rlt_le_trans with (sum_f_R0 An 0).
  unfold An; simpl; rewrite Rinv_1; rewrite Rmult_1_r;
    apply Rlt_0_1.
  apply sum_incr.
  assumption.
  intro; unfold An; left; apply Rmult_lt_0_compat.
  apply Rinv_0_lt_compat; apply INR_fact_lt_0.
  apply (pow_lt _ n H).
  unfold exp; unfold projT1; case (exist_exp x); intro.
  unfold exp_in; unfold infinite_sum, Un_cv; trivial.
Qed.

Lemma Ropp_0_gt_lt_contravar : forall r, r < R0 -> R0 < - r.
Proof.
  intros x h.
  rewrite <- Ropp_0.
  apply Ropp_lt_contravar.
  assumption.
Qed.

(**********)
Lemma exp_pos : forall x:R, R0 < exp x.
Proof.
  intro; destruct (total_order_T R0 x) as [[Hlt|<-]|Hgt].
  apply (exp_pos_pos _ Hlt).
  rewrite exp_0; apply Rlt_0_1.
  replace (exp x) with (R1 / exp (- x)).
  unfold Rdiv; apply Rmult_lt_0_compat.
  apply Rlt_0_1.
  apply Rinv_0_lt_compat; apply exp_pos_pos.
  apply (Ropp_0_gt_lt_contravar _ Hgt).
  cut (exp (- x) <> R0).
  intro; unfold Rdiv; apply Rmult_eq_reg_l with (exp (- x)).
  rewrite Rmult_1_l; rewrite <- Rinv_r_sym.
  rewrite <- exp_plus.
  rewrite Rplus_opp_l; rewrite exp_0; reflexivity.
  apply H.
  apply H.
  assert (H := exp_plus x (- x)).
  rewrite Rplus_opp_r in H; rewrite exp_0 in H.
  red; intro; rewrite H0 in H.
  rewrite Rmult_0_r in H.
  elim R1_neq_R0; assumption.
Qed.

(* ((exp h)-1)/h -> 0 quand h->0 *)
Lemma derivable_pt_lim_exp_0 : derivable_pt_lim exp R0 R1.
Proof.
  unfold derivable_pt_lim; intros.
  set (fn := fun (N:nat) (x:R) => x ^ N / INR (fact (S N))).
  cut (CVN_R fn).
  intro; cut (forall x:R, { l:R | Un_cv (fun N:nat => SP fn N x) l }).
  intro cv; cut (forall n:nat, continuity (fn n)).
  intro; cut (continuity (SFL fn cv)).
  intro; unfold continuity in H1.
  assert (H2 := H1 R0).
  unfold continuity_pt in H2; unfold continue_in in H2; unfold limit1_in in H2;
    unfold limit_in in H2; simpl in H2; unfold R_dist in H2.
  elim (H2 _ H); intros alp H3.
  elim H3; intros.
  exists (mkposreal _ H4); intros.
  rewrite Rplus_0_l; rewrite exp_0.
  replace ((exp h - R1) / h) with (SFL fn cv h).
  replace R1 with (SFL fn cv R0).
  apply H5.
  split.
  unfold D_x, no_cond; split.
  trivial.
  apply (not_eq_sym H6).
  rewrite Rminus_0_r; apply H7.
  unfold SFL.
  case (cv R0) as (x,Hu).
  eapply UL_sequence.
  apply Hu.
  unfold Un_cv, SP in |- *.
  intros; exists 1%nat; intros.
  unfold R_dist; rewrite decomp_sum.
  rewrite (Rplus_comm (fn 0%nat R0)).
  replace (fn 0%nat R0) with R1.
  unfold Rminus; rewrite Rplus_assoc; rewrite Rplus_opp_r;
    rewrite Rplus_0_r.
  replace (sum_f_R0 (fun i:nat => fn (S i) R0) (pred n)) with R0.
  rewrite Rabs_R0; apply H8.
  symmetry ; apply sum_eq_R0; intros.
  unfold fn.
  simpl.
  unfold Rdiv; do 2 rewrite Rmult_0_l; reflexivity.
  unfold fn; simpl.
  unfold Rdiv; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
  apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H9 ].
  unfold SFL, exp.
  case (cv h) as (x0,Hu); case (exist_exp h) as (x,Hexp); simpl.
  eapply UL_sequence.
  apply Hu.
  unfold Un_cv; intros.
  unfold exp_in, infinite_sum in Hexp.
  cut (R0 < eps0 * Rabs h).
  intro; elim (Hexp _ H9); intros N0 H10.
  exists N0; intros.
  unfold R_dist.
  apply Rmult_lt_reg_l with (Rabs h).
  apply Rabs_pos_lt; assumption.
  rewrite <- Rabs_mult.
  rewrite Rmult_minus_distr_l.
  replace (h * ((x - R1) / h)) with (x - R1).
  unfold R_dist in H10.
  replace (h * SP fn n h - (x - R1)) with
  (sum_f_R0 (fun i:nat => / INR (fact i) * h ^ i) (S n) - x).
  rewrite (Rmult_comm (Rabs h)).
  apply H10.
  unfold ge.
  apply le_trans with (S N0).
  apply le_n_Sn.
  apply le_n_S; apply H11.
  rewrite decomp_sum.
  replace (/ INR (fact 0) * h ^ 0) with R1.
  unfold Rminus.
  rewrite Ropp_plus_distr.
  rewrite Ropp_involutive.
  rewrite <- (Rplus_comm (- x)).
  rewrite <- (Rplus_comm (- x + R1)).
  rewrite Rplus_assoc; repeat apply Rplus_eq_compat_l.
  replace (pred (S n)) with n; [ idtac | reflexivity ].
  unfold SP.
  rewrite scal_sum.
  apply sum_eq; intros.
  unfold fn.
  replace (h ^ S i) with (h * h ^ i).
{
  unfold Rdiv. simpl.
repeat rewrite Rmult_assoc.
rewrite Rmult_comm.
repeat rewrite Rmult_assoc.
rewrite Rmult_comm.
repeat rewrite Rmult_assoc.
reflexivity.
}

  simpl; reflexivity.
  simpl; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
  apply lt_O_Sn.
  unfold Rdiv.
  rewrite <- Rmult_assoc.
  symmetry ; apply Rinv_r_simpl_m.
  assumption.
  apply Rmult_lt_0_compat.
  apply H8.
  apply Rabs_pos_lt; assumption.
  apply SFL_continuity; assumption.
  intro; unfold fn.
  replace (fun x:R => x ^ n / INR (fact (S n))) with
  (pow_fct n / fct_cte (INR (fact (S n))))%F; [ idtac | reflexivity ].
  apply continuity_div.
  apply derivable_continuous; apply (derivable_pow n).
  apply derivable_continuous; apply derivable_const.
  intro; unfold fct_cte; apply INR_fact_neq_0.
  apply (CVN_R_CVS _ X).
  assert (H0 := Alembert_exp).
  unfold CVN_R.
  intro; unfold CVN_r.
  exists (fun N:nat => r ^ N / INR (fact (S N))).
  cut
    { l:R |
        Un_cv
        (fun n:nat =>
          sum_f_R0 (fun k:nat => Rabs (r ^ k / INR (fact (S k)))) n) l }.
  intros (x,p).
  exists x; intros.
  split.
  apply p.
  unfold Boule; intros.
  rewrite Rminus_0_r in H1.
  unfold fn.
  unfold Rdiv; rewrite Rabs_mult.
  cut (R0 < INR (fact (S n))).
  intro.
  rewrite (Rabs_right (/ INR (fact (S n)))).
  do 2 rewrite <- (Rmult_comm (/ INR (fact (S n)))).
  apply Rmult_le_compat_l.
  left; apply Rinv_0_lt_compat; apply H2.
  rewrite <- RPow_abs.
  apply pow_maj_Rabs.
  rewrite Rabs_Rabsolu; left; apply H1.
  apply Rle_ge; left; apply Rinv_0_lt_compat; apply H2.
  apply INR_fact_lt_0.
  cut ((r:R) <> R0).
  intro; apply Alembert_C2.
  intro; apply Rabs_no_R0.
  unfold Rdiv; apply prod_neq_R0.
  apply pow_nonzero; assumption.
  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
  unfold Un_cv in H0.
  unfold Un_cv; intros.
  cut (R0 < eps0 / r);
    [ intro
      | unfold Rdiv; apply Rmult_lt_0_compat;
        [ assumption | apply Rinv_0_lt_compat; apply (cond_pos r) ] ].
  elim (H0 _ H3); intros N0 H4.
  exists N0; intros.
  cut (S n >= N0)%nat.
  intro hyp_sn.
  assert (H6 := H4 _ hyp_sn).
  unfold R_dist in H6; rewrite Rminus_0_r in H6.
  rewrite Rabs_Rabsolu in H6.
  unfold R_dist; rewrite Rminus_0_r.
  rewrite Rabs_Rabsolu.
  replace
  (Rabs (r ^ S n / INR (fact (S (S n)))) / Rabs (r ^ n / INR (fact (S n))))
    with (r * / INR (fact (S (S n))) * / / INR (fact (S n))).
  rewrite Rmult_assoc; rewrite Rabs_mult.
  rewrite (Rabs_right r).
  apply Rmult_lt_reg_l with (/ r).
  apply Rinv_0_lt_compat; apply (cond_pos r).
  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
  rewrite Rmult_1_l; rewrite <- (Rmult_comm eps0).
  apply H6.
  assumption.
  apply Rle_ge; left; apply (cond_pos r).
  unfold Rdiv.
  repeat rewrite Rabs_mult.
  repeat rewrite Rabs_Rinv.
  rewrite Rinv_mult_distr.
  repeat rewrite Rabs_right.
  rewrite Rinv_involutive.
  rewrite (Rmult_comm r).
  rewrite (Rmult_comm (r ^ S n)).
  repeat rewrite Rmult_assoc.
  apply Rmult_eq_compat_l.
  rewrite (Rmult_comm r).
  rewrite <- Rmult_assoc; rewrite <- (Rmult_comm (INR (fact (S n)))).
  apply Rmult_eq_compat_l.
  simpl.
  rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
  rewrite Rmult_1_r. reflexivity.
  apply pow_nonzero; assumption.
  apply INR_fact_neq_0.
  apply Rle_ge; left; apply INR_fact_lt_0.
  apply Rle_ge; left; apply pow_lt; apply (cond_pos r).
  apply Rle_ge; left; apply INR_fact_lt_0.
  apply Rle_ge; left; apply pow_lt; apply (cond_pos r).
  apply Rabs_no_R0; apply pow_nonzero; assumption.
  apply Rinv_neq_0_compat; apply Rabs_no_R0; apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  apply INR_fact_neq_0.
  unfold ge; apply le_trans with n.
  apply H5.
  apply le_n_Sn.
  assert (H1 := cond_pos r); red; intro; rewrite H2 in H1;
    elim (Rlt_irrefl _ H1).
Qed.

(**********)
Lemma derivable_pt_lim_exp : forall x:R, derivable_pt_lim exp x (exp x).
Proof.
  intro; assert (H0 := derivable_pt_lim_exp_0).
  unfold derivable_pt_lim in H0; unfold derivable_pt_lim; intros.
  cut (R0 < eps / exp x);
    [ intro
      | unfold Rdiv; apply Rmult_lt_0_compat;
        [ apply H | apply Rinv_0_lt_compat; apply exp_pos ] ].
  elim (H0 _ H1); intros del H2.
  exists del; intros.
  assert (H5 := H2 _ H3 H4).
  rewrite Rplus_0_l in H5; rewrite exp_0 in H5.
  replace ((exp (x + h) - exp x) / h - exp x) with
  (exp x * ((exp h - R1) / h - R1)).
  rewrite Rabs_mult; rewrite (Rabs_right (exp x)).
  apply Rmult_lt_reg_l with (/ exp x).
  apply Rinv_0_lt_compat; apply exp_pos.
  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
  rewrite Rmult_1_l; rewrite <- (Rmult_comm eps).
  apply H5.
  assert (H6 := exp_pos x); red; intro; rewrite H7 in H6;
    elim (Rlt_irrefl _ H6).
  apply Rle_ge; left; apply exp_pos.
  rewrite Rmult_minus_distr_l.
  rewrite Rmult_1_r; unfold Rdiv; rewrite <- Rmult_assoc;
    rewrite Rmult_minus_distr_l.
  rewrite Rmult_1_r; rewrite exp_plus; reflexivity.
Qed.


Require Import VST.floyd.proofauto.
From Iterative Require Import floatlib jacob_list_fun_model.
From Iterative.sparse Require Import jacobi sparse_model.
Import PlaceHolder.
Import RelationPairs.
Require Import vcfloat.VCFloat.
Require Import vcfloat.FPCompCert.
Require Import VSTlib.spec_math.
Require Import VSTlib.spec_malloc.
#[export] Declare Instance M: MallocAPD.

Set Bullet Behavior "Strict Subproofs".

Open Scope logic.

Require Import Iterative.sparse.spec_sparse.

Definition jacobi2_oneiter_spec :=
 DECLARE _jacobi2_oneiter
 WITH shA1: share, shA2: share, shb: share, shx: share, shy: share,
      A1p: val, A1: vector Tdouble, A2p: val, A2: matrix Tdouble,
      bp: val, b: vector Tdouble, xp: val, x: vector Tdouble,
      yp: val
 PRE [ tptr tdouble, tptr t_crs, tptr tdouble, tptr tdouble, tptr tdouble ]
    PROP(readable_share shA1; readable_share shA2; readable_share shb;
             readable_share shx; writable_share shy;
             matrix_cols A2 (matrix_rows A2);
             matrix_rows A2 < Int.max_unsigned;
             Forall (Forall finite) A2;
             Forall finite b; Forall finite x)
    PARAMS(A1p; A2p; bp; xp; yp)
    SEP (data_at shA1 (tarray tdouble (matrix_rows A2)) (map Vfloat A1) A1p;
           crs_rep shA2 A2 A2p;
           data_at shb (tarray tdouble (matrix_rows A2)) (map Vfloat b) bp;
           data_at shx (tarray tdouble (matrix_rows A2)) (map Vfloat x) xp;
           data_at_ shy (tarray tdouble (matrix_rows A2)) yp)
 POST [ tdouble ]
   EX y: vector Tdouble, EX s: ftype Tdouble,
    PROP( Forall2 feq y  (jacobi_iter A1 A2 b x);
              feq s (norm2 (jacobi_residual A1 A2 b x)))
    RETURN(Vfloat s)
    SEP (data_at shA1 (tarray tdouble (matrix_rows A2)) (map Vfloat A1) A1p;
           crs_rep shA2 A2 A2p;
           data_at shb (tarray tdouble (matrix_rows A2)) (map Vfloat b) bp;
           data_at shx (tarray tdouble (matrix_rows A2)) (map Vfloat x) xp;
           data_at shy (tarray tdouble (matrix_rows A2)) (map Vfloat y) yp).

Definition jacobi2_spec :=
 DECLARE _jacobi2
 WITH shA1: share, shA2: share, shb: share,
      A: matrix Tdouble, A1p: val, A2p: val,
      bp: val, b: vector Tdouble, xp: val, x: vector Tdouble,
      acc: ftype Tdouble, maxiter: Z, gv: globals
 PRE [ tptr tdouble, tptr t_crs, tptr tdouble, tptr tdouble, tdouble, tuint ]
    PROP(readable_share shA1; readable_share shA2; readable_share shb;
             matrix_cols A (matrix_rows A);
             0 < matrix_rows A < Int.max_unsigned;
             Forall (Forall finite) A;
             Forall finite (invert_diagmatrix (diag_of_matrix A));
             Forall finite b; Forall finite x; finite acc;
             0 < maxiter <= Int.max_unsigned)
    PARAMS(A1p; A2p; bp; xp; Vfloat acc; Vint (Int.repr maxiter)) GLOBALS(gv)
    SEP (mem_mgr gv;
           data_at shA1 (tarray tdouble (matrix_rows A)) (map Vfloat (diag_of_matrix A)) A1p;
           crs_rep shA2 (remove_diag A) A2p;
           data_at shb (tarray tdouble (matrix_rows A)) (map Vfloat b) bp;
           data_at Ews (tarray tdouble (matrix_rows A)) (map Vfloat x) xp)
 POST [ tdouble ]
   EX y: vector Tdouble, EX s: ftype Tdouble,
    PROP(RelProd feq (Forall2 feq) (s,y) (jacobi A b x acc (Z.to_nat maxiter)))
    RETURN(Vfloat s)
    SEP (mem_mgr gv;
           data_at shA1 (tarray tdouble (matrix_rows A)) (map Vfloat (diag_of_matrix A)) A1p;
           crs_rep shA2 (remove_diag A) A2p;
           data_at shb (tarray tdouble (matrix_rows A)) (map Vfloat b) bp;
           data_at Ews (tarray tdouble (matrix_rows A)) (map Vfloat y) xp).

Definition jacobi2_highspec :=
 DECLARE _jacobi2
 WITH shA1: share, shA2: share, shb: share,
      A: matrix Tdouble, A1p: val, A2p: val,
      bp: val, b: vector Tdouble, xp: val,
      acc: ftype Tdouble, maxiter: Z, gv: globals
 PRE [ tptr tdouble, tptr t_crs, tptr tdouble, tptr tdouble, tdouble, tuint ]
    PROP(readable_share shA1; readable_share shA2; readable_share shb;
             jacobi_preconditions A b acc (Z.to_nat (maxiter-1));
             0 < matrix_rows A < Int.max_unsigned;
             0 < maxiter <= Int.max_unsigned)
    PARAMS(A1p; A2p; bp; xp; Vfloat acc; Vint (Int.repr maxiter)) GLOBALS(gv)
    SEP (mem_mgr gv;
           data_at shA1 (tarray tdouble (matrix_rows A)) (map Vfloat (diag_of_matrix A)) A1p;
           crs_rep shA2 (remove_diag A) A2p;
           data_at shb (tarray tdouble (matrix_rows A)) (map Vfloat b) bp;
           data_at Ews (tarray tdouble (matrix_rows A)) (map Vfloat (Zrepeat (Zconst Tdouble 0) (matrix_rows A))) xp)
 POST [ tdouble ]
   EX y: vector Tdouble, EX s: ftype Tdouble,
    PROP(feq s (norm2 (jacobi_residual (diag_of_matrix A) (remove_diag A) b y));
             BCMP Lt true s acc = true)
    RETURN(Vfloat s)
    SEP (mem_mgr gv;
           data_at shA1 (tarray tdouble (matrix_rows A)) (map Vfloat (diag_of_matrix A)) A1p;
           crs_rep shA2 (remove_diag A) A2p;
           data_at shb (tarray tdouble (matrix_rows A)) (map Vfloat b) bp;
           data_at Ews (tarray tdouble (matrix_rows A)) (map Vfloat y) xp).

Definition JacobiASI : funspecs := [ jacobi2_oneiter_spec; jacobi2_spec ].


(*===============================================================================
    Model for the EVM storage in EVM execution environment

    Note that operations are partial, as not all storage is mapped.
    Each storage cell is a EVMWORD - 256-bits.
  ==============================================================================*)

Require Import mathcomp.ssreflect.ssreflect.
From mathcomp Require Import ssrfun ssrbool eqtype ssrnat seq fintype finfun.

Require Import bitsrep bitsops cursor pmap reader writer mem.

Set Implicit Arguments.
Unset Strict Implicit.
Import Prenex Implicits.

(* 256-bit addressable storage of EVMWORD *)
(*=Storage *)
Definition Storage := PMAP EVMWORD 256.
(*= End *)

(* Initialize the storage, no cell is mapped *)
Definition initialStorage : Storage := @EmptyPMap EVMWORD 256.

(* Check the storage region from pointer [p] to just below pointer [p'] in [sto]
   consists exactly the evmwords in [xs] *)
Fixpoint stoIs (sto : Storage) (p p' : PTR) xs :=
  if xs is x::xs then sto p = Some x /\ stoIs sto (incB p) p' xs
  else p = p'.

(* Map an evmword at [p] with 1-bits *)
Definition reserveStorageEVMWORD (sto: Storage) (p : PTR) : Storage :=
  sto !p := ones 256.

(* Map storage region of [c] words at [p] with 1-bits *)
Definition reserveStorage (sto : Storage) (p : PTR) (c : EVMWORD) : Storage :=
  bIterFrom p c (fun p sto => sto !p := ones 256) sto.

Definition isMappedStorage (p : PTR) (sto : Storage) : bool := sto p.

(* Update EVMWORD at [p] on [sto] *)
Definition updateEVMWORD (sto : Storage) (p : PTR) (evmw : EVMWORD) : option Storage :=
  if isMappedStorage p sto then Some (sto !p := evmw)
  else None.

(* Write EVMWORD at [pos] on [sto].
   If sto p is mapped, update it.
   Otherwise, reserve a word at p and write
 *)
Definition writeStorageEVMWORD (sto : Storage) (pos : EVMWORDCursor) (evmw : EVMWORD) : option (EVMWORDCursor * Storage) :=
  if pos is mkCursor p then
    if sto p is Some x then
      Some ((next p), (sto !p := evmw))
    else Some ((next p), ((reserveStorageEVMWORD sto p) !p := evmw))
  else None.

(* Read EVMWORD at [pos] on [sto].
   It is equivalent to using the [readStorage] with [readEVMWORD].
 *)
Definition readStorageEVMWORD (sto : Storage) (pos : EVMWORDCursor) : readerResult EVMWORD :=
  if pos is mkCursor p then
    if sto p is Some x then
      readerOk x (next p)
    else readerFail
  else readerWrap.

(*--------------------------------------------------------------------------------------------
  Storage layout to string
 --------------------------------------------------------------------------------------------*)
Require Import Coq.Strings.String.
Import Ascii.

(* Storage to string *)
Fixpoint enumStorageToString (xs : seq (EVMWORD * EVMWORD)) :=
  (if xs is (p, w)::xs then
     toHex p ++ ":=" ++ toHex w ++ ", " ++ enumStorageToString xs
   else "")%string.

Definition storagetoString (sto : Storage) := enumStorageToString (enumPMap sto).

(*----------------------------------------------------------------------------------------------
 A simple unit test
 ----------------------------------------------------------------------------------------------*)
Example s: Storage := (@EmptyPMap _ _) ! #5 := (#12 : EVMWORD) ! #6 := (#10 : EVMWORD).
Compute (storagetoString s).

(* Read a word at pos 5 *)
Compute (
    let rw := readStorageEVMWORD s (#5) in
    readerResultToString rw
  ).

(* Write a word at pos 9 *)
Compute (
    let os := writeStorageEVMWORD s (#9) (#15 : EVMWORD) in
    match os with
      | Some (c, s) => storagetoString s
      | None => ("Write error!")%string
    end
  ).