(************************************************************************)
(*         *   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 XRanalysis1.
Require Import XRanalysis2.
Local Open Scope XR_scope.

(** Division *)
Theorem derivable_pt_lim_div :
  forall (f1 f2:R -> R) (x l1 l2:R),
    derivable_pt_lim f1 x l1 ->
    derivable_pt_lim f2 x l2 ->
    f2 x <> R0 ->
    derivable_pt_lim (f1 / f2) x ((l1 * f2 x - l2 * f1 x) / Rsqr (f2 x)).
Proof.
  intros f1 f2 x l1 l2 H H0 H1.
  cut (derivable_pt f2 x);
    [ intro X | unfold derivable_pt; exists l2; exact H0 ].
  assert (H2 := continuous_neq_0 _ _ (derivable_continuous_pt _ _ X) H1).
  elim H2; clear H2; intros eps_f2 H2.
  unfold div_fct.
  assert (H3 := derivable_continuous_pt _ _ X).
  unfold continuity_pt in H3; unfold continue_in in H3; unfold limit1_in in H3;
    unfold limit_in in H3; unfold dist in H3.
  simpl in H3; unfold R_dist in H3.
  elim (H3 (Rabs (f2 x) / R2));
    [ idtac
      | unfold Rdiv; change (R0 < Rabs (f2 x) * / R2);
        apply Rmult_lt_0_compat;
          [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; idtac ] ].
  2:exact Rlt_0_2.
  clear H3; intros alp_f2 H3.
  cut
    (forall x0:R,
      Rabs (x0 - x) < alp_f2 -> Rabs (f2 x0 - f2 x) < Rabs (f2 x) / R2).
{
  intro H4.
  cut (forall a:R, Rabs (a - x) < alp_f2 -> Rabs (f2 x) / R2 < Rabs (f2 a)).
{
  intro H5.
  cut
    (forall a:R,
      Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < R2 / Rabs (f2 x)).
{
  intro Maj.
  unfold derivable_pt_lim; intros.
  elim (H (Rabs (eps * f2 x / R8)));
    [ idtac
      | unfold Rdiv; change (R0 < Rabs (eps * f2 x * / R8));
        apply Rabs_pos_lt; repeat apply prod_neq_R0;
          [ red; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6)
            | assumption
            | apply Rinv_neq_0_compat; discrR ] ].
  intros alp_f1d H7.
  case (Req_dec (f1 x) R0); intro.
{
  case (Req_dec l1 R0); intro.
{
(***********************************)
(*              First case         *)
(*           (f1 x)=0  l1 =0       *)
(***********************************)
  cut (R0 < Rmin eps_f2 (Rmin alp_f2 alp_f1d));
    [ intro
      | repeat apply Rmin_pos;
        [ apply (cond_pos eps_f2)
          | elim H3; intros; assumption
          | apply (cond_pos alp_f1d) ] ].
  exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10).
  simpl; intros.
  assert (H13 := Rlt_le_trans _ _ _ H12 (Rmin_r _ _)).
  assert (H14 := Rlt_le_trans _ _ _ H12 (Rmin_l _ _)).
  assert (H15 := Rlt_le_trans _ _ _ H13 (Rmin_r _ _)).
  assert (H16 := Rlt_le_trans _ _ _ H13 (Rmin_l _ _)).
  assert (H17 := H7 _ H11 H15).
  rewrite formule; [ idtac | assumption | assumption | apply H2; apply H14 ].
  apply Rle_lt_trans with
    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
{
  unfold Rminus.
  rewrite <-
    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
    .
  apply Rabs_4.
}
{
  repeat rewrite Rabs_mult.
  apply Rlt_le_trans with (eps / R4 + eps / R4 + eps / R4 + eps / R4).
{
  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / R4).
{
  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / R4).
{
  cut
    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
      eps / R4).
{
  cut
    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
      eps / R4).
{
  intros.
  apply Rlt_4; assumption.
}
{
  rewrite H8.
  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
  rewrite Rabs_R0; rewrite Rmult_0_l.
  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; idtac ].
  exact Rlt_0_4.
}
}
{
  rewrite H8.
  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
  rewrite Rabs_R0; rewrite Rmult_0_l.
  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; idtac ].
  exact Rlt_0_4.
}
}
{
  rewrite H9.
  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
  rewrite Rabs_R0; rewrite Rmult_0_l.
  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; idtac ].
  exact Rlt_0_4.
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2);
    try assumption || apply H2.
{
  apply H14.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  right; symmetry ; apply quadruple_var.
}
}
}
{
(***********************************)
(*           Second case           *)
(*           (f1 x)=0  l1<>0       *)
(***********************************)
  assert (H10 := derivable_continuous_pt _ _ X).
  unfold continuity_pt in H10.
  unfold continue_in in H10.
  unfold limit1_in in H10.
  unfold limit_in in H10.
  unfold dist in H10.
  simpl in H10.
  unfold R_dist in H10.
  elim (H10 (Rabs (eps * Rsqr (f2 x) / (R8 * l1)))).
{
  clear H10; intros alp_f2t2 H10.
  cut
    (forall a:R,
      Rabs a < alp_f2t2 ->
      Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (R8 * l1))).
{
  intro H11.
  cut (R0 < Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)).
{
  intro.
  exists (mkposreal (Rmin (Rmin eps_f2 alp_f1d) (Rmin alp_f2 alp_f2t2)) H12).
  simpl.
  intros.
  assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)).
  assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)).
  assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)).
  assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)).
  assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)).
  assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)).
  clear H14 H15 H16.
  rewrite formule; try assumption.
{
  apply Rle_lt_trans with
    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
{
  unfold Rminus.
  rewrite <-
    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
    .
  apply Rabs_4.
}
{
  repeat rewrite Rabs_mult.
  apply Rlt_le_trans with (eps / R4 + eps / R4 + eps / R4 + eps / R4).
{
  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / R4).
{
  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / R4).
{
  cut
    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
      eps / R4).
{
  cut
    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
      eps / R4).
{
  intros.
  apply Rlt_4; assumption.
}
{
  rewrite H8.
  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
  rewrite Rabs_R0; rewrite Rmult_0_l.
  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; idtac ].
  exact Rlt_0_4.
}
}
{
  rewrite H8.
  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
  rewrite Rabs_R0; rewrite Rmult_0_l.
  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; idtac ].
  exact Rlt_0_4.
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  right; symmetry ; apply quadruple_var.
}
}
}
{
  apply H2; assumption.
}
}
{
  repeat apply Rmin_pos.
{
  apply (cond_pos eps_f2).
}
{
  apply (cond_pos alp_f1d).
}
{
  elim H3; intros; assumption.
}
{
  elim H10; intros; assumption.
}
}
}
{
  intros.
  elim H10; intros.
  case (Req_dec a R0); intro.
{
  rewrite H14; rewrite Rplus_0_r.
  unfold Rminus; rewrite Rplus_opp_r.
  rewrite Rabs_R0.
  apply Rabs_pos_lt.
  unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc.
  repeat apply prod_neq_R0; try assumption.
{
  now apply Rgt_not_eq.
}
{
  apply Rinv_neq_0_compat; apply prod_neq_R0; [discrR | assumption].
  apply Rlt_not_eq'. exact Rlt_0_8.
}
}
{
  apply H13.
  split.
{
  apply D_x_no_cond; assumption.
}
{
  replace (x + a - x) with a; [ assumption | idtac ].
  unfold Rminus.
  rewrite Rplus_comm, <- Rplus_assoc, Rplus_opp_l, Rplus_0_l.
  reflexivity.
}
}
}
}
{
  change (R0 < Rabs (eps * Rsqr (f2 x) / (R8 * l1))).
  apply Rabs_pos_lt; unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc;
    repeat apply prod_neq_R0.
{
  red; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6).
}
{
  assumption.
}
{
  assumption.
}
{
  apply Rinv_neq_0_compat; apply prod_neq_R0; [discrR | assumption].
  apply Rlt_not_eq'. exact Rlt_0_8.
}
}
}
}
{
(***********************************)
(*        Third case               *)
(*     (f1 x)<>0  l1=0  l2=0       *)
(***********************************)
  case (Req_dec l1 R0); intro.
{
  case (Req_dec l2 R0); intro.
{
  elim (H0 (Rabs (Rsqr (f2 x) * eps / (R8 * f1 x))));
    [ idtac
      | apply Rabs_pos_lt; unfold Rdiv, Rsqr; repeat rewrite Rmult_assoc;
        repeat apply prod_neq_R0 ;
          [ assumption
            | assumption
            | now apply Rgt_not_eq
            | apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || (try assumption) ] ].
  intros alp_f2d H12.
  cut (R0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)).
{
  intro.
  exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11).
  simpl.
  intros.
  assert (H15 := Rlt_le_trans _ _ _ H14 (Rmin_l _ _)).
  assert (H16 := Rlt_le_trans _ _ _ H14 (Rmin_r _ _)).
  assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)).
  assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)).
  assert (H19 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)).
  assert (H20 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)).
  clear H15 H16.
  rewrite formule; try assumption.
{
  apply Rle_lt_trans with
    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
{
  unfold Rminus.
  rewrite <-
    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
    .
  apply Rabs_4.
}
{
  repeat rewrite Rabs_mult.
  apply Rlt_le_trans with (eps / R4 + eps / R4 + eps / R4 + eps / R4).
{
  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / R4).
{
  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / R4).
{
  cut
    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
      eps / R4).
{
  cut
    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
      eps / R4).
{
  intros.
  apply Rlt_4; assumption.
}
{
  rewrite H10.
  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
  rewrite Rabs_R0; rewrite Rmult_0_l.
  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; idtac ].
  exact Rlt_0_4.
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  rewrite H9.
  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
  rewrite Rabs_R0; rewrite Rmult_0_l.
  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; idtac ].
  exact Rlt_0_4.
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); assumption || idtac.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  right; symmetry ; apply quadruple_var.
}
}
}
{
  apply H2; assumption.
}
}
{
  repeat apply Rmin_pos.
{
  apply (cond_pos eps_f2).
}
{
  elim H3; intros; assumption.
}
{
  apply (cond_pos alp_f1d).
}
{
  apply (cond_pos alp_f2d).
}
}
apply Rlt_not_eq'. exact Rlt_0_8.
}
{
(***********************************)
(*      Fourth case                *)
(*    (f1 x)<>0  l1=0  l2<>0       *)
(***********************************)
  elim (H0 (Rabs (Rsqr (f2 x) * eps / (R8 * f1 x))));
    [ idtac
      | apply Rabs_pos_lt; unfold Rsqr, Rdiv;
        repeat apply prod_neq_R0 ;
          [ assumption..
            | now apply Rgt_not_eq
            | apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || (try assumption) ] ].
  intros alp_f2d H11.
  assert (H12 := derivable_continuous_pt _ _ X).
  unfold continuity_pt in H12.
  unfold continue_in in H12.
  unfold limit1_in in H12.
  unfold limit_in in H12.
  unfold dist in H12.
  simpl in H12.
  unfold R_dist in H12.
  elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (R8 * f1 x * l2)))).
{
  intros alp_f2c H13.
  cut (R0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))).
{
  intro.
  exists
    (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c)))
      H14).
  simpl; intros.
  assert (H17 := Rlt_le_trans _ _ _ H16 (Rmin_l _ _)).
  assert (H18 := Rlt_le_trans _ _ _ H16 (Rmin_r _ _)).
  assert (H19 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)).
  assert (H20 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)).
  assert (H21 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)).
  assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)).
  assert (H23 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)).
  assert (H24 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)).
  clear H16 H17 H18 H19.
  cut
    (forall a:R,
      Rabs a < alp_f2c ->
      Rabs (f2 (x + a) - f2 x) <
      Rabs (Rsqr (f2 x) * f2 x * eps / (R8 * f1 x * l2))).
{
  intro.
  rewrite formule; try assumption.
{
  apply Rle_lt_trans with
    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
{
  unfold Rminus.
  rewrite <-
    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
    .
  apply Rabs_4.
}
{
  repeat rewrite Rabs_mult.
  apply Rlt_le_trans with (eps / R4 + eps / R4 + eps / R4 + eps / R4).
{
  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / R4).
{
  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / R4).
{
  cut
    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
      eps / R4).
{
  cut
    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
      eps / R4).
{
  intros.
  apply Rlt_4; assumption.
}
{
  rewrite <- Rabs_mult.
  apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  rewrite H9.
  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
  rewrite Rabs_R0; rewrite Rmult_0_l.
  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; idtac ].
  exact Rlt_0_4.
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  right; symmetry ; apply quadruple_var.
}
}
}
{
  apply H2; assumption.
}
}
{
  intros.
  case (Req_dec a R0); intro.
{
  rewrite H17; rewrite Rplus_0_r.
  unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0.
  apply Rabs_pos_lt.
  unfold Rdiv, Rsqr.
  repeat rewrite Rinv_mult_distr; try assumption.
{
  repeat apply prod_neq_R0; try assumption.
{
  red; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6).
}
{
  apply Rinv_neq_0_compat; discrR.
  apply Rlt_not_eq'. exact Rlt_0_8.
}
{
  apply Rinv_neq_0_compat; assumption.
}
{
  apply Rinv_neq_0_compat; assumption.
}
}
{
  apply Rlt_not_eq'. exact Rlt_0_8.
}
{
  apply prod_neq_R0; [ discrR | assumption ].
  apply Rlt_not_eq'. exact Rlt_0_8.
}
}
{
  elim H13; intros.
  apply H19.
  split.
{
  apply D_x_no_cond; assumption.
}
{
  replace (x + a - x) with a; [ assumption | idtac ].
  unfold Rminus.
  rewrite Rplus_comm, <- Rplus_assoc, Rplus_opp_l, Rplus_0_l.
  reflexivity.
}
}
}
}
{
  repeat apply Rmin_pos.
{
  apply (cond_pos eps_f2).
}
{
  elim H3; intros; assumption.
}
{
  apply (cond_pos alp_f1d).
}
{
  apply (cond_pos alp_f2d).
}
{
  elim H13; intros; assumption.
}
}
}
{
  change (R0 < Rabs (Rsqr (f2 x) * f2 x * eps / (R8 * f1 x * l2))).
  apply Rabs_pos_lt.
  unfold Rsqr, Rdiv.
  repeat rewrite Rinv_mult_distr; try assumption || discrR.
{
  repeat apply prod_neq_R0; try assumption.
{
  red; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6).
}
{
  apply Rinv_neq_0_compat; discrR.
  apply Rlt_not_eq'. exact Rlt_0_8.
}
{
  apply Rinv_neq_0_compat; assumption.
}
{
  apply Rinv_neq_0_compat; assumption.
}
}
{
  apply Rlt_not_eq'. exact Rlt_0_8.
}
  apply prod_neq_R0; [ discrR | assumption ].
  apply Rlt_not_eq'. exact Rlt_0_8.
}
  apply Rlt_not_eq'. exact Rlt_0_8.
}
}
{
(***********************************)
(*         Fifth case              *)
(*    (f1 x)<>0  l1<>0  l2=0       *)
(***********************************)
  case (Req_dec l2 R0); intro.
{
  assert (H11 := derivable_continuous_pt _ _ X).
  unfold continuity_pt in H11.
  unfold continue_in in H11.
  unfold limit1_in in H11.
  unfold limit_in in H11.
  unfold dist in H11.
  simpl in H11.
  unfold R_dist in H11.
  elim (H11 (Rabs (eps * Rsqr (f2 x) / (R8 * l1)))).
{
  clear H11; intros alp_f2t2 H11.
  elim (H0 (Rabs (Rsqr (f2 x) * eps / (R8 * f1 x)))).
{
  intros alp_f2d H12.
  cut (R0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))).
{
  intro.
  exists
    (mkposreal
      (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13).
  simpl.
  intros.
  cut
    (forall a:R,
      Rabs a < alp_f2t2 ->
      Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (R8 * l1))).
{
  intro.
  assert (H17 := Rlt_le_trans _ _ _ H15 (Rmin_l _ _)).
  assert (H18 := Rlt_le_trans _ _ _ H15 (Rmin_r _ _)).
  assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)).
  assert (H20 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)).
  assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)).
  assert (H22 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)).
  assert (H23 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)).
  assert (H24 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)).
  clear H15 H17 H18 H21.
  rewrite formule; try assumption.
{
  apply Rle_lt_trans with
    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
{
  unfold Rminus.
  rewrite <-
    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
    .
  apply Rabs_4.
}
{
  repeat rewrite Rabs_mult.
  apply Rlt_le_trans with (eps / R4 + eps / R4 + eps / R4 + eps / R4).
{
  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / R4).
{
  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / R4).
{
  cut
    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
      eps / R4).
{
  cut
    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
      eps / R4).
{
  intros.
  apply Rlt_4; assumption.
}
{
  rewrite H10.
  unfold Rdiv; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
  rewrite Rabs_R0; rewrite Rmult_0_l.
  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; idtac ].
  exact Rlt_0_4.
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  right; symmetry ; apply quadruple_var.
}
}
}
{
  apply H2; assumption.
}
}
{
  intros.
  case (Req_dec a R0); intro.
{
  rewrite H17; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r;
    rewrite Rabs_R0.
  apply Rabs_pos_lt.
  unfold Rdiv; rewrite Rinv_mult_distr; try discrR || assumption.
  unfold Rsqr.
  repeat apply prod_neq_R0;
    assumption ||
      (apply Rinv_neq_0_compat; assumption) ||
        (apply Rinv_neq_0_compat; discrR) ||
          (red; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6)).
  apply Rlt_not_eq'. exact Rlt_0_8.
  apply Rlt_not_eq'. exact Rlt_0_8.
}
{
  elim H11; intros.
  apply H19.
  split.
{
  apply D_x_no_cond; assumption.
}
{
  replace (x + a - x) with a; [ assumption | idtac ].
  unfold Rminus.
  now rewrite Rplus_comm, <- Rplus_assoc, Rplus_opp_l, Rplus_0_l.
}
}
}
}
{
  repeat apply Rmin_pos.
{
  apply (cond_pos eps_f2).
}
{
  elim H3; intros; assumption.
}
{
  apply (cond_pos alp_f1d).
}
{
  apply (cond_pos alp_f2d).
}
{
  elim H11; intros; assumption.
}
}
}
{
  apply Rabs_pos_lt.
  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr; try discrR || assumption.
  repeat apply prod_neq_R0;
    assumption ||
      (apply Rinv_neq_0_compat; assumption) ||
        (apply Rinv_neq_0_compat; discrR) ||
          (red; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
  apply Rlt_not_eq'. exact Rlt_0_8.
  apply Rlt_not_eq'. exact Rlt_0_8.
}
}
{
  change (R0 < Rabs (eps * Rsqr (f2 x) / (R8 * l1))).
  apply Rabs_pos_lt.
  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr; try discrR || assumption.
  repeat apply prod_neq_R0;
    assumption ||
      (apply Rinv_neq_0_compat; assumption) ||
        (apply Rinv_neq_0_compat; discrR) ||
          (red; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
  apply Rlt_not_eq'. exact Rlt_0_8.
  apply Rlt_not_eq'. exact Rlt_0_8.
}
}
{
(***********************************)
(*       Sixth case                *)
(*    (f1 x)<>0  l1<>0  l2<>0      *)
(***********************************)
  elim (H0 (Rabs (Rsqr (f2 x) * eps / (R8 * f1 x)))).
{
  intros alp_f2d H11.
  assert (H12 := derivable_continuous_pt _ _ X).
  unfold continuity_pt in H12.
  unfold continue_in in H12.
  unfold limit1_in in H12.
  unfold limit_in in H12.
  unfold dist in H12.
  simpl in H12.
  unfold R_dist in H12.
  elim (H12 (Rabs (Rsqr (f2 x) * f2 x * eps / (R8 * f1 x * l2)))).
{
  intros alp_f2c H13.
  elim (H12 (Rabs (eps * Rsqr (f2 x) / (R8 * l1)))).
{
  intros alp_f2t2 H14.
  cut
    (R0 <
      Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d))
      (Rmin alp_f2c alp_f2t2)).
{
  intro.
  exists
    (mkposreal
      (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d))
        (Rmin alp_f2c alp_f2t2)) H15).
  simpl.
  intros.
  assert (H18 := Rlt_le_trans _ _ _ H17 (Rmin_l _ _)).
  assert (H19 := Rlt_le_trans _ _ _ H17 (Rmin_r _ _)).
  assert (H20 := Rlt_le_trans _ _ _ H18 (Rmin_l _ _)).
  assert (H21 := Rlt_le_trans _ _ _ H18 (Rmin_r _ _)).
  assert (H22 := Rlt_le_trans _ _ _ H19 (Rmin_l _ _)).
  assert (H23 := Rlt_le_trans _ _ _ H19 (Rmin_r _ _)).
  assert (H24 := Rlt_le_trans _ _ _ H20 (Rmin_l _ _)).
  assert (H25 := Rlt_le_trans _ _ _ H20 (Rmin_r _ _)).
  assert (H26 := Rlt_le_trans _ _ _ H21 (Rmin_l _ _)).
  assert (H27 := Rlt_le_trans _ _ _ H21 (Rmin_r _ _)).
  clear H17 H18 H19 H20 H21.
  cut
    (forall a:R,
      Rabs a < alp_f2t2 ->
      Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (R8 * l1))).
{
  cut
    (forall a:R,
      Rabs a < alp_f2c ->
      Rabs (f2 (x + a) - f2 x) <
      Rabs (Rsqr (f2 x) * f2 x * eps / (R8 * f1 x * l2))).
{
  intros.
  rewrite formule; try assumption.
{
  apply Rle_lt_trans with
    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
{
  unfold Rminus.
  rewrite <-
    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
    .
  apply Rabs_4.
}
{
  repeat rewrite Rabs_mult.
  apply Rlt_le_trans with (eps / R4 + eps / R4 + eps / R4 + eps / R4).
{
  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / R4).
{
  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / R4).
{
  cut
    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
      eps / R4).
{
  cut
    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
      eps / R4).
{
  intros.
  apply Rlt_4; assumption.
}
{
  rewrite <- Rabs_mult.
  apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  rewrite <- Rabs_mult.
  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
{
  apply H2; assumption.
}
{
  apply Rmin_2; assumption.
}
}
}
{
  right; symmetry ; apply quadruple_var.
}
}
}
{
  apply H2; assumption.
}
}
{
  intros.
  case (Req_dec a R0); intro.
{
  rewrite H18; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r;
    rewrite Rabs_R0; apply Rabs_pos_lt.
  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr.
{
  repeat apply prod_neq_R0;
    assumption ||
      (apply Rinv_neq_0_compat; assumption) ||
        (apply Rinv_neq_0_compat; discrR) ||
          (red; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
  apply prod_neq_R0; [ discrR | assumption ].
  apply Rlt_not_eq'. exact Rlt_0_8.
}
{
  apply prod_neq_R0; [ discrR | assumption ].
  apply Rlt_not_eq'. exact Rlt_0_8.
}
{
  assumption.
}
}
{
  elim H13; intros.
  apply H20.
  split.
{
  apply D_x_no_cond; assumption.
}
{
  replace (x + a - x) with a; [ assumption | idtac ].
  unfold Rminus.
  now rewrite Rplus_comm, <- Rplus_assoc, Rplus_opp_l, Rplus_0_l.
}
}
}
}
{
  intros.
  case (Req_dec a R0); intro.
{
  rewrite H18; rewrite Rplus_0_r; unfold Rminus; rewrite Rplus_opp_r;
    rewrite Rabs_R0; apply Rabs_pos_lt.
  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr.
{
  repeat apply prod_neq_R0;
    assumption ||
      (apply Rinv_neq_0_compat; assumption) ||
        (apply Rinv_neq_0_compat; discrR) ||
          (red; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
  apply Rlt_not_eq'. exact Rlt_0_8.
}
{
  discrR.
  apply Rlt_not_eq'. exact Rlt_0_8.
}
{
  assumption.
}
}
{
  elim H14; intros.
  apply H20.
  split.
{
  unfold D_x, no_cond; split.
{
  trivial.
}
{
  apply Rminus_not_eq_right.
  replace (x + a - x) with a; [ assumption | idtac ].
  unfold Rminus.
  now rewrite Rplus_comm, <- Rplus_assoc, Rplus_opp_l, Rplus_0_l.
}
}
{
  replace (x + a - x) with a; [ assumption | idtac ].
  unfold Rminus.
  now rewrite Rplus_comm, <- Rplus_assoc, Rplus_opp_l, Rplus_0_l.
}
}
}
}
{
  repeat apply Rmin_pos.
{
  apply (cond_pos eps_f2).
}
{
  elim H3; intros; assumption.
}
{
  apply (cond_pos alp_f1d).
}
{
  apply (cond_pos alp_f2d).
}
{
  elim H13; intros; assumption.
}
{
  elim H14; intros; assumption.
}
}
}
{
  change (R0 < Rabs (eps * Rsqr (f2 x) / (R8 * l1))); apply Rabs_pos_lt.
  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr; try discrR || assumption.
  repeat apply prod_neq_R0;
    assumption ||
      (apply Rinv_neq_0_compat; assumption) ||
        (apply Rinv_neq_0_compat; discrR) ||
          (red; intro H14; rewrite H14 in H6; elim (Rlt_irrefl _ H6)).
  apply Rlt_not_eq'. exact Rlt_0_8.
  apply Rlt_not_eq'. exact Rlt_0_8.
}
}
{
  change (R0 < Rabs (Rsqr (f2 x) * f2 x * eps / (R8 * f1 x * l2)));
    apply Rabs_pos_lt.
  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr.
{
  repeat apply prod_neq_R0;
    assumption ||
      (apply Rinv_neq_0_compat; assumption) ||
        (apply Rinv_neq_0_compat; discrR) ||
          (red; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6)).
  apply prod_neq_R0; [ discrR | assumption ].
  apply Rlt_not_eq'. exact Rlt_0_8.
}
{
  apply prod_neq_R0; [ discrR | assumption ].
  apply Rlt_not_eq'. exact Rlt_0_8.
}
{
  assumption.
}
}
}
{
  apply Rabs_pos_lt.
  unfold Rdiv, Rsqr; rewrite Rinv_mult_distr;
    [ idtac | discrR | assumption ].
  repeat apply prod_neq_R0;
    assumption ||
      (apply Rinv_neq_0_compat; assumption) ||
        (apply Rinv_neq_0_compat; discrR) ||
          (red; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6)).
  apply Rlt_not_eq'. exact Rlt_0_8.
  apply Rlt_not_eq'. exact Rlt_0_8.
}
}
}
}
  apply Rlt_not_eq'. exact Rlt_0_8.
}
{
  intros.
  unfold Rdiv.
  apply Rmult_lt_reg_l with (Rabs (f2 (x + a))).
{
  apply Rabs_pos_lt; apply H2.
  apply Rlt_le_trans with (Rmin eps_f2 alp_f2).
{
  assumption.
}
{
  apply Rmin_l.
}
}
{
  rewrite <- Rinv_r_sym.
{
  apply Rmult_lt_reg_l with (Rabs (f2 x)).
{
  apply Rabs_pos_lt; assumption.
}
{
  rewrite Rmult_1_r.
  rewrite (Rmult_comm (Rabs (f2 x))).
  repeat rewrite Rmult_assoc.
  rewrite <- Rinv_l_sym.
{
  rewrite Rmult_1_r.
  apply Rmult_lt_reg_l with (/ R2).
{
  apply Rinv_0_lt_compat. exact Rlt_0_2.
}
{
  repeat rewrite Rmult_assoc.
  apply Rmult_lt_compat_l.
  apply Rinv_0_lt_compat. exact Rlt_0_2.
  specialize (H2 a).
  destruct H3.
  specialize (H5 (x+a)).
  apply Rmult_lt_reg_r with (/R2).
  apply Rinv_0_lt_compat. exact Rlt_0_2.
  repeat rewrite Rmult_assoc.
  rewrite Rinv_r. rewrite Rmult_1_r.
  apply H5.
  rename alp_f2 into AAA.
  unfold Rminus.
  rewrite Rplus_comm, <- Rplus_assoc, Rplus_opp_l, Rplus_0_l.
  rename a into YYY.
  eapply Rlt_le_trans.
  apply H6.
  apply Rmin_r.
  exact Neq_2_0.
}
}
{
  apply Rabs_no_R0; assumption.
}
}
}
{
  apply Rabs_no_R0; apply H2.
  assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_l _ _)); assumption.
}
}
}
}
{
  intros.
  assert (H6 := H4 a H5).
  rewrite <- (Rabs_Ropp (f2 a - f2 x)) in H6.
  rewrite Ropp_minus_distr in H6.
  assert (H7 := Rle_lt_trans _ _ _ (Rabs_triang_inv _ _) H6).
  apply Rplus_lt_reg_l with (- Rabs (f2 a) + Rabs (f2 x) / R2).
  rewrite Rplus_assoc.
  rewrite <- double_var.
  do 2 rewrite (Rplus_comm (- Rabs (f2 a))).
  rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
  unfold Rminus in H7; assumption.
}
}
{
  intros.
  case (Req_dec x x0); intro.
{
  rewrite <- H5; unfold Rminus; rewrite Rplus_opp_r; rewrite Rabs_R0;
    unfold Rdiv; apply Rmult_lt_0_compat;
      [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; idtac ].
  exact Rlt_0_2.
}
{
  elim H3; intros.
  apply H7.
  split.
{
  unfold D_x, no_cond; split.
{
  trivial.
}
{
  assumption.
}
}
{
  assumption.
}
}
}
Qed.

Lemma derivable_pt_div :
  forall (f1 f2:R -> R) (x:R),
    derivable_pt f1 x ->
    derivable_pt f2 x -> f2 x <> R0 -> derivable_pt (f1 / f2) x.
Proof.
  unfold derivable_pt.
  intros f1 f2 x X X0 H.
  elim X; intros.
  elim X0; intros.
  exists ((x0 * f2 x - x1 * f1 x) / Rsqr (f2 x)).
  apply derivable_pt_lim_div; assumption.
Qed.

Lemma derivable_div :
  forall f1 f2:R -> R,
    derivable f1 ->
    derivable f2 -> (forall x:R, f2 x <> R0) -> derivable (f1 / f2).
Proof.
  unfold derivable; intros f1 f2 X X0 H x.
  apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)).
Qed.

Lemma derive_pt_div :
  forall (f1 f2:R -> R) (x:R) (pr1:derivable_pt f1 x)
    (pr2:derivable_pt f2 x) (na:f2 x <> R0),
    derive_pt (f1 / f2) x (derivable_pt_div _ _ _ pr1 pr2 na) =
    (derive_pt f1 x pr1 * f2 x - derive_pt f2 x pr2 * f1 x) / Rsqr (f2 x).
Proof.
  intros.
  assert (H := derivable_derive f1 x pr1).
  assert (H0 := derivable_derive f2 x pr2).
  assert
    (H1 := derivable_derive (f1 / f2)%F x (derivable_pt_div _ _ _ pr1 pr2 na)).
  elim H; clear H; intros l1 H.
  elim H0; clear H0; intros l2 H0.
  elim H1; clear H1; intros l H1.
  rewrite H; rewrite H0; apply derive_pt_eq_0.
  assert (H3 := proj2_sig pr1).
  unfold derive_pt in H; rewrite H in H3.
  assert (H4 := proj2_sig pr2).
  unfold derive_pt in H0; rewrite H0 in H4.
  apply derivable_pt_lim_div; assumption.
Qed.


Require Import stdpp.list.
Require Import ssreflect.
From Tweetnacl Require Import Libs.Export.
From Tweetnacl Require Import ListsOp.Export.
From Tweetnacl Require Import Mid.ZCarry.
From Tweetnacl Require Import Mid.Reduce.
From Tweetnacl Require Import Low.Carry.
From Tweetnacl Require Import Low.Car25519.
From Tweetnacl Require Import Mid.Car25519.

Open Scope Z.

(* Eval compute in (ZofList_Bound 16 16 (2 ^ 62) < 1 * 2^303).
 *)
Theorem Zcar25519_bounds_length:
  forall l1 l2 l3,
    length l1 = 16%nat ->
    length l2 = 16%nat -> (* not required but easier *)
    length l3 = 16%nat -> (* not required but easier *)
    Forall (fun x => -2^62 < x < 2^62) l1 ->
    l2 = car25519 l1 ->
    l3 = car25519 l2 ->
    Forall (fun x => 0 <= x < 2^16) (car25519 l3).
Proof.
  intros l1 l2 l3 Hl1 Hl2 Hl3 HForalll1 Hcarr1 Hcarr2.
  apply Forall_lookup.
  intros i x Hl.
  apply (nth_lookup_Some _ _ 0) in Hl ; subst x.
  assert(Hbounds:= Hl1).
  apply (ZofList_bounds 16 l1 16 (-2^62) (2^62)) in Hbounds ; auto.
  split; [apply bounds_car_inf_length| apply bounds_car_sup_length] ; auto;
  try assumption ; rewrite Hcarr2;
  rewrite <- ℤcar25519_eq_car25519_length by assumption;
  eapply (doubleCar_ext_str (ℤ16.lst l1) _ 303) ;
  try omega ;
  try (eapply bounds.le_lt_trans ; [eapply Hbounds | | ] ; compute ; reflexivity);
  try (rewrite ℤcar25519_eq_car25519_length ; auto ; try rewrite Hcarr1 ; reflexivity).
Qed.

Theorem Zcar25519_bounds_Zlength:
  forall l1 l2 l3,
    Zlength l1 = 16 ->
    Zlength l2 = 16 -> (* not required but easier *)
    Zlength l3 = 16 -> (* not required but easier *)
    Forall (fun x => -2^62 < x < 2^62) l1 ->
    l2 = car25519 l1 ->
    l3 = car25519 l2 ->
    Forall (fun x => 0 <= x < 2^16) (car25519 l3).
Proof.
  intros l1 l2 l3 Hl1 Hl2 Hl3 HForalll1 Hcarr1 Hcarr2.
  apply Forall_lookup.
  intros i x Hl.
  apply (nth_lookup_Some _ _ 0) in Hl ; subst x.
  assert(Hbounds:= Hl1).
  apply (ZofList_bounds_Zlength 16 l1 16 (-2^62) (2^62)) in Hbounds ; auto.
  split; [apply bounds_car_inf_Zlength| apply bounds_car_sup_Zlength] ; auto;
  try assumption ; rewrite Hcarr2;
  rewrite <- ℤcar25519_eq_car25519_Zlength by assumption;
  eapply (doubleCar_ext_str (ℤ16.lst l1) _ 303) ;
  try omega ;
  try (eapply bounds.le_lt_trans ; [eapply Hbounds | | ] ; compute ; reflexivity);
  try (rewrite ℤcar25519_eq_car25519_Zlength ; auto ; try rewrite Hcarr1 ; reflexivity).
Qed.

Ltac assert_base_lemmas:=
  assert(H216262: 2^16 < 2^63) by reflexivity;
  assert(H216247: 2^16 < 2^16 + 38 *2^47) by reflexivity;
  assert(H247262: 2^16 + 38 *2^47 < 2^63) by reflexivity;
  assert(H262263: 2^62 < 2^63) by reflexivity;
  assert(H263262: - 2^63 < - 2^62) by reflexivity;
  assert(H2630: - 2^63 < 0) by reflexivity;
  assert(H2460: 38 * - 2^47 < 0) by reflexivity;
  assert(H263246: - 2^63 < 38 * - 2^47) by reflexivity;
  assert(H160 : 16 > 0) by reflexivity;
  assert(HH : forall k, 0 ≤ getResidue 16 k ∧ getResidue 16 k < 2 ^ 16) by (clear ; intro; eapply getResidue_bounds ; omega).

Theorem Zcar25519_bounds_length_1:
  forall l1,
    length l1 = 16%nat ->
    Forall (fun x => -2^62 < x < 2^62) l1 ->
    Forall (fun x => 38 * -2^47 <= x < 2^16 + 38 *2^47) (car25519 l1).
Proof.
  intros l1 H HForalll1.
  apply Forall_lookup.
  intros i x Hl.
  apply (nth_lookup_Some _ _ 0) in Hl ; subst x.
  apply destruct_length_16 in H.
  do 16 destruct H.
  subst.
  move: HForalll1 ; rewrite ?Forall_cons => HForalll1.
  repeat match goal with
    | [H : (_ /\ _) /\ _ |-_] => destruct H
  end.
  clear H15.
  assert_base_lemmas.
  unfold car25519.
  repeat match goal with
    | _ => rewrite Carry_n.Carry_n_step
    | _ => rewrite Carry_n.Carry_n_step_0
  end ; simpl ; flatten ;
  repeat match goal with
    | _ => omega
    | [ HH : context[getResidue] |- _ ∧ getResidue 16 (?x) < _ ] => specialize HH with x
    | [ |- 38 * - 2 ^ 47 <= 0 ∧ 0 < 2^16 + 38 * 2 ^ 47 ] => compute ; split; [intro ; tryfalse | reflexivity]
    | _ => apply Add_interval_mono3
    | _ => apply Mult_interval_correct_pos_le
    | [ |- -2^47 <= getCarry _ _ ∧ _ <= _ ] => apply getCarry_bound_str47
    | [ |- context[2 ^ 63] ] => change (-2^63) with ((-2^62) + (-2^62)); change (2^63) with ((2^62) + (2^62))
    | [ |- _ < _ ∧ _ < _ ] => apply Add_interval_mono
    | [ |- -2^62 < getCarry _ _ ∧ _ < _ ] => apply getCarry_bound_str63
  end.
Qed.

Lemma Zcar25519_exact_bounds_0:
  forall l,
    length l = 16%nat ->
     Forall (fun x => -2^62 < x < 2^62) l ->
    38 * -2^47 <= nth 0 (car25519 l) 0  < 2^16 + 38 *2^47.
Proof.
  intros l H HForalll1.
  apply destruct_length_16 in H.
  do 16 destruct H.
  subst.
  assert_base_lemmas.
  move: HForalll1 ; rewrite ?Forall_cons => HForalll1.
  repeat match goal with
    | [H : (_ /\ _) /\ _ |-_] => destruct H
    | _ => progress unfold car25519
    | _ => rewrite Carry_n.Carry_n_step
    | _ => rewrite Carry_n.Carry_n_step_0; simpl
    | _ => omega
    | [ HH : context[getResidue] |- _ ∧ getResidue 16 (?x) < _ ] => specialize HH with x
    | [ |- 38 * - 2 ^ 47 <= 0 ∧ 0 < 2^16 + 38 * 2 ^ 47 ] => compute ; split; [intro ; tryfalse | reflexivity]
    | _ => apply Add_interval_mono3
    | _ => apply Mult_interval_correct_pos_le
    | [ |- -2^47 <= getCarry _ _ ∧ _ <= _ ] => apply getCarry_bound_str47
    | [ |- context[2 ^ 63] ] => change (-2^63) with ((-2^62) + (-2^62)); change (2^63) with ((2^62) + (2^62))
    | [ |- _ < _ ∧ _ < _ ] => apply Add_interval_mono
    | [ |- -2^62 < getCarry _ _ ∧ _ < _ ] => apply getCarry_bound_str63
  end.
Qed.

Theorem Zcar25519_bounds_length_2:
  forall l1 l2,
    length l1 = 16%nat ->
    length l2 = 16%nat ->
    Forall (fun x => -2^62 < x < 2^62) l1 ->
    l2 = car25519 l1 ->
    Forall (fun x => -38 <= x < 2^16 + 38) (car25519 l2).
Proof.
  intros l1 l2 Hl1 Hl2 HForalll1 Hcarr1.
  apply Forall_lookup.
  intros i x Hl.
  apply (nth_lookup_Some _ _ 0) in Hl ; subst x.
  assert(Hbounds:= Hl1).
  apply (ZofList_bounds 16 l1 16 (-2^62) (2^62)) in Hbounds ; auto.
  assert(38 * -2^47 <= ℤ16.lst (car25519 l1) < 2^257).
  rewrite <- ℤcar25519_eq_car25519_length by omega.
  remember( ℤ16.lst l1) as x.
  assert(x < 0 \/ 0 <= x) by omega.
  assert(256 ≤ 303 ∧ 303 < 512) by (compute ; split ; [intro ; tryfalse | reflexivity]).
  destruct H.
  - assert( - 2 ^ 303 < x).
    change (ZofList_Bound 16 16 (- 2 ^ 62)) with  (-8148268238044213330262537980352300734732221417397775119962774120020674928590150695349387264) in Hbounds.
    change (-2^303) with (-16296287810675888690147565507275025288411747149327490005089123594835050398106693649467179008).
    omega.
    apply (ZCarry25519_neg_str x 303 H0) in H1.
    2: omega.
    simpl in H1.
    assert(2^256 < 2^257) by (compute ; reflexivity).
    omega.
  - split.
    assert(0 ≤ ℤcar25519 x).
    apply ZCarry25519_pos.
    assumption.
    assert(38 * - 2 ^ 47 < 0) by (compute ; reflexivity).
    omega.
    assert( x < 2 ^ 303).
      change (ZofList_Bound 16 16 (2 ^ 62)) with  (8148268238044213330262537980352300734732221417397775119962774120020674928590150695349387264) in Hbounds.
      change (2^303) with (16296287810675888690147565507275025288411747149327490005089123594835050398106693649467179008).
      omega.
    apply (ZCarry25519_sup_bounds_str3 x 303) in H0.
    2: omega.
    assert(2 ^ 256 - 38 + 2 ^ 256 < 2^257) by ( compute; reflexivity).
    omega.
  - assert(Hi: i <> 0%nat \/ i = 0%nat ) by omega.
    destruct Hi.
    assert( 0 <= nth i (car25519 l2) 0 < 2 ^ 16).
    apply car25519_bound_sup ; go.
    assert(2^16 < 2^17) by (compute; reflexivity).
    omega.
    subst i.

    rewrite <- Hcarr1 in H.
    unfold car25519.
    unfold BackCarry.backCarry.
    rename H into Hbound_strict.
    rename Hl2 into H.
    apply destruct_length_16 in H.
    do 16 destruct H.
    subst.
  assert(HH : forall k, 0 ≤ getResidue 16 k ∧ getResidue 16 k < 2 ^ 16) by (clear ; intro; eapply getResidue_bounds ; omega).
  assert(H216217: 2^16 < 2^17) by reflexivity.
  assert(H0217: 0 < 2^17) by reflexivity.
  repeat match goal with
    | _ => rewrite Carry_n.Carry_n_step
    | _ => rewrite Carry_n.Carry_n_step_0
  end.
  erewrite getCarry_16_eq_256.

  2: {
    repeat match goal with
    | _ => rewrite Carry_n.Carry_n_step
    | _ => rewrite Carry_n.Carry_n_step_0
  end.
  f_equal.
  }

  unfold nth.
  change (2^17) with (2^16 + 2^16).
  apply Add_interval_mono3.
  apply HH.
  clear HH.
  remember (ℤ16.lst [x; x0; x1; x2; x3; x4; x5; x6; x7; x8; x9; x10; x11; x12; x13;
             x14]) as t.
  clear Hbounds Hcarr1 HForalll1 Hl1 l1 Heqt.
  assert(t < 0 \/ t = 0 \/ 0 < t) by omega.
  destruct H ; [|destruct H].
  assert(getCarry 256 t <= 0).
  apply getCarry_neg_sup ; omega.
  destruct Hbound_strict.
  apply Z.le_lteq in H1.
  destruct H1.
  + apply (getCarry_incr 256) in H1.
    2: omega.
    change (getCarry 256 (38 * - 2 ^ 47)) with (-1) in H1.
    omega.
  + change (38* - 2^47) with (-5348024557502464) in H1.
    subst t; compute ; split ; intro ; tryfalse.
  + subst t ; compute ; split ; intro ; tryfalse.
  + assert(t < 2^256 \/ 2^256 <= t ) by omega.
    destruct H0.
    * replace (getCarry 256 t) with 0.
      compute ; split ; intro ; tryfalse.
      rewrite getCarry_impl_0 ; omega.
    * replace (getCarry 256 t) with 1.
      compute ; split ; intro ; tryfalse.
      change 257 with (256 + 1) in Hbound_strict.
      rewrite getCarry_1; omega.
Qed.

Theorem Zcar25519_bounds_Zlength_2:
  forall l1 l2,
    Zlength l1 = 16 ->
    Zlength l2 = 16 ->
    Forall (fun x => -2^62 < x < 2^62) l1 ->
    l2 = car25519 l1 ->
    Forall (fun x => -38 <= x < 2^16 + 38) (car25519 l2).
Proof.
move=> l1 l2 ; rewrite ?Zlength_correct => Hll1 Hll2 Hl1 Hl2;
eapply Zcar25519_bounds_length_2 ; eauto; omega.
Qed.

Lemma car25519_bound : forall l,
  Zlength l = 16 ->
  Forall (fun x : ℤ => - 2 ^ 62 < x < 2 ^ 62) l ->
  Forall (fun x : ℤ => 0 <= x < 2 ^ 16) (car25519 (car25519 (car25519 l))).
Proof.
  intros l Hl Hb.
  eapply Zcar25519_bounds_Zlength.
  4: apply Hb.
  4: reflexivity.
  4: reflexivity.
  all: repeat apply car25519_Zlength ; assumption.
Qed.

Close Scope Z.