Require Import Coq.Program.Equality.
Require Import Coq.Program.Tactics.
Require Export DeclarationEvaluation.

(******************************************************************************)
(* Weakening lemmas                                                           *)
(******************************************************************************)

Lemma shift_value {t} :
  ∀ {c}, Value t → Value (shiftTm c t).
Proof.
  induction t; simpl; intros; try contradiction; destruct_conjs; auto.
Qed.

Lemma weaken_value u :
  ∀ {t}, Value t → Value (weakenTm t u).
Proof.
  induction u as [|[]]; simpl; auto using shift_value.
Qed.

(******************************************************************************)
(* Progress                                                                   *)
(******************************************************************************)

Lemma can_form_tarr {Γ t T1 T2} (v: Value t) (wt: Typing Γ t (tarr T1 T2)) :
  ∃ t2, t = abs T1 t2.
Proof.
  depind wt; try contradiction; exists t; reflexivity.
Qed.

Lemma can_form_tprod {Γ t T1 T2} (v: Value t) (wt: Typing Γ t (tprod T1 T2)) :
  ∃ t1 t2, t = prod t1 t2 ∧ Typing Γ t1 T1 ∧ Typing Γ t2 T2.
Proof.
  depind wt; try contradiction; exists t1, t2; split; auto.
Qed.

Lemma matching_defined {Γ p T1 Δ} (wp: PTyping Γ p T1 Δ) :
  ∀ {t1}, Value t1 → Typing Γ t1 T1 → ∀ t2, ∃ t2', Match p t1 t2 t2'.
Proof.
  induction wp; intros t1 v1 wt1 t2; isimpl.
  - exists (substTm X0 t1 t2).
    refine M_Var.
  - destruct (can_form_tprod v1 wt1) as (t11 & t12 & eq & wt11 & wt12); subst.
    destruct v1 as [v11 v12].
    apply (weaken_Typing G) in wt12.
    assert (val12' : Value (weakenTm t12 (domainEnv G)))
      by (apply weaken_value; auto).
    rewrite <- (domain_PTyping_bindPat _ _ _ _  wp1) in *.
    destruct (IHwp2 (weakenTm t12 (domainEnv G)) val12' wt12 t2) as [t2' m2].
    destruct (IHwp1 _ v11 wt11 t2') as [t2'' m1].
    rewrite (domain_PTyping_bindPat _ _ _ _ wp1) in m2.
    exists t2''.
    exact (M_Prod m2 m1).
Qed.

Lemma progress {t U} (wt: Typing empty t U) :
  Value t ∨ ∃ t', red t t'.
Proof with try (subst; eauto using red).
  depind wt; isimpl; auto.
  - destruct IHwt1 as [v1|[t1' r1]]...
    destruct IHwt2 as [v2|[t2' r2]]...
    destruct (can_form_tarr v1 wt1)...
  - destruct IHwt1 as [v1|[t1' r1]]...
    destruct IHwt2 as [v2|[t2' r2]]...
  - destruct IHwt1 as [v1|[t1' r1]]...
    destruct (matching_defined wtp v1 wt1 t2)...
Qed.

(******************************************************************************)
(* Preservation                                                               *)
(******************************************************************************)

Lemma local_preservation_lett {p t1 t2 t2'} (m: Match p t1 t2 t2') :
  ∀ {Γ T1 T2 Δ}, PTyping Γ p T1 Δ → Typing Γ t1 T1 →
    Typing (appendEnv Γ Δ) t2 (weakenTy T2 (domainEnv Δ)) → Typing Γ t2' T2.
Proof.
  induction m; intros Γ T1 T2 Δ wtp wt1 wt2; isimpl.
  - dependent destruction wtp.
    eauto using subst_evar_Typing with infra.
  - dependent destruction wtp. dependent destruction wt1. isimpl.
    eapply IHm2; eauto.
    eapply IHm1; eauto.
    rewrite <- (domain_PTyping_bindPat _ _ _ _ wtp1) in *.
    eauto using weaken_Typing with infra.
Qed.

Lemma preservation {Γ t U} (wt: Typing Γ t U) :
  ∀ {t'}, red t t' → Typing Γ t' U.
Proof.
  induction wt; intros t' r; inversion r; subst;
    eauto using Typing, local_preservation_lett.
  - inversion wt1; eauto using subst_evar_Typing with infra.
  - eapply local_preservation_lett; eauto; isimpl.
    rewrite <- (domain_PTyping_bindPat _ _ _ _ wtp) in *; eauto.
Qed.


(*

  Copyright 2016 Luxembourg University
  Copyright 2017 Luxembourg University
  Copyright 2018 Luxembourg University
  Copyright 2019 Luxembourg University

  This file is part of Velisarios.

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

  Velisarios is distributed in the hope that it will be useful,
  but WITHOUT ANY WARRANTY; without even the implied warranty of
  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  GNU General Public License for more details.

  You should have received a copy of the GNU General Public License
  along with Velisarios.  If not, see <http://www.gnu.org/licenses/>.

  Authors: Vincent Rahli
           Ivana Vukotic

*)

Require Import QArith.
Require Export DTime.

Section DTimeQ.

  Definition Q_dt_T : Type := Q.

  Definition Q_dt_0 : Q_dt_T := 0%Q.

  Definition Q_dt_1 : Q_dt_T := 1%Q.

  Definition Q_dt_add : Q_dt_T -> Q_dt_T -> Q_dt_T := Qplus.

  Definition Q_dt_mul : Q_dt_T -> Q_dt_T -> Q_dt_T := Qmult.

  Definition Q_dt_sub : Q_dt_T -> Q_dt_T -> Q_dt_T := Qminus.

  Definition Q_dt_opp : Q_dt_T -> Q_dt_T := Qopp.

  Definition Q_dt_eq : relation Q_dt_T := Qeq.

  Definition Q_dt_lt : relation Q_dt_T := Qlt.

  Definition Q_dt_le : relation Q_dt_T := Qle.

  Definition Q_dt_eqv : Equivalence Q_dt_eq := Q_Setoid.

  Definition Q_dt_ring : ring_theory Q_dt_0 Q_dt_1 Q_dt_add Q_dt_mul Q_dt_sub Q_dt_opp Q_dt_eq.
  Proof.
    exact Qsrt.
  Qed.

  Definition Q_dt_nat_inj : nat -> Q_dt_T := fun n => inject_Z (Z.of_nat n).

  Definition Q_dt_add_morph : forall x y, Q_dt_eq x y -> forall u v, Q_dt_eq u v -> Q_dt_eq (Q_dt_add x u) (Q_dt_add y v).
  Proof.
    introv a b; rewrite a, b; reflexivity.
  Qed.

  Definition Q_dt_mul_morph : forall x y, Q_dt_eq x y -> forall u v, Q_dt_eq u v -> Q_dt_eq (Q_dt_mul x u) (Q_dt_mul y v).
  Proof.
    introv a b; rewrite a, b; reflexivity.
  Qed.

  Definition Q_dt_opp_morph : forall x y, Q_dt_eq x y -> Q_dt_eq (Q_dt_opp x) (Q_dt_opp y).
  Proof.
    introv a; rewrite a; reflexivity.
  Qed.

  Definition Q_dt_le_morph : forall x y, Q_dt_eq x y -> forall u v, Q_dt_eq u v -> Q_dt_le x u -> Q_dt_le y v.
  Proof.
    introv a b h; rewrite a, b in h; auto.
  Qed.

  Definition Q_dt_lt_morph : forall x y, Q_dt_eq x y -> forall u v, Q_dt_eq u v -> Q_dt_lt x u -> Q_dt_lt y v.
  Proof.
    introv a b h; rewrite a, b in h; auto.
  Qed.

  Definition Q_dt_nat_inj_cond : forall (n : nat), Q_dt_eq (Q_dt_nat_inj n) (ntimes n Q_dt_0 Q_dt_1 Q_dt_add).
  Proof.
    unfold Q_dt_eq, Q_dt_nat_inj, Q_dt_0; induction n; simpl; auto; try reflexivity.
    rewrite <- IHn; clear IHn.
    unfold Q_dt_nat_inj, Q_dt_add, Q_dt_1; simpl.
    assert (1%Q = inject_Z (Z.of_nat 1)) as xx by auto; rewrite xx; clear xx.
    rewrite <- inject_Z_plus.
    rewrite <- Nat2Z.inj_add; simpl; auto; try reflexivity.
  Qed.

  Definition Q_dt_le_refl : forall t , Q_dt_le t t.
  Proof.
    apply Qle_refl.
  Qed.

  Definition Q_dt_lt_irrefl : forall t , ~ (Q_dt_lt t t).
  Proof.
    apply Qlt_irrefl.
  Qed.

  Definition Q_dt_add_le_compat : forall a b c d, Q_dt_le a c -> Q_dt_le b d -> Q_dt_le (Q_dt_add a b) (Q_dt_add c d).
  Proof.
    introv; apply Qplus_le_compat.
  Qed.

  Definition Q_dt_add_lt_le_compat : forall a b c d, Q_dt_lt a c -> Q_dt_le b d -> Q_dt_lt (Q_dt_add a b) (Q_dt_add c d).
  Proof.
    introv; apply Qplus_lt_le_compat.
  Qed.

  Definition Q_dt_mul_le_compat_r : forall a b c, Q_dt_le a b -> Q_dt_le Q_dt_0 c -> Q_dt_le (Q_dt_mul a c) (Q_dt_mul b c).
  Proof.
    introv; apply Qmult_le_compat_r.
  Qed.

  Definition Q_dt_le_trans : forall a b c, Q_dt_le a b -> Q_dt_le b c -> Q_dt_le a c.
  Proof.
    introv; apply Qle_trans.
  Qed.

  Definition Q_dt_lt_trans : forall a b c, Q_dt_lt a b -> Q_dt_lt b c -> Q_dt_lt a c.
  Proof.
    introv; apply Qlt_trans.
  Qed.

  Definition Q_dt_le_lt_trans : forall a b c, Q_dt_le a b -> Q_dt_lt b c -> Q_dt_lt a c.
  Proof.
    introv; apply Qle_lt_trans.
  Qed.

  Definition Q_dt_lt_le_trans : forall a b c, Q_dt_lt a b -> Q_dt_le b c -> Q_dt_lt a c.
  Proof.
    introv; apply Qlt_le_trans.
  Qed.

  Definition Q_dt_mul_0_l : forall x, Q_dt_eq (Q_dt_mul Q_dt_0 x) Q_dt_0.
  Proof.
    introv; apply Qmult_0_l.
  Qed.

  Definition Q_dt_lt_0_1 : Q_dt_lt Q_dt_0 Q_dt_1.
  Proof.
    unfold Q_dt_lt, Q_dt_0, Q_dt_1; simpl.
    assert (1%Q = inject_Z (Z.of_nat 1)) as xx by auto; rewrite xx; clear xx.
    assert (0%Q = inject_Z (Z.of_nat 0)) as xx by auto; rewrite xx; clear xx.
    rewrite <- Zlt_Qlt.
    apply inj_lt; omega.
  Qed.

  Definition Q_dt_lt_le_weak : forall a b, Q_dt_lt a b -> Q_dt_le a b.
  Proof.
    introv; apply Qlt_le_weak.
  Qed.

  Definition Q_dt_lt_le_dec : forall x y, {Q_dt_lt x y} + {Q_dt_le y x}.
  Proof.
    introv; apply Qlt_le_dec.
  Qed.

  Definition Q_dt_eq_dec : forall x y, {Q_dt_eq x y} + {~ Q_dt_eq x y}.
  Proof.
    introv; apply Qeq_dec.
  Qed.

  Definition Q_dt_nat_inj_add_dist : forall n m, Q_dt_eq (Q_dt_add (Q_dt_nat_inj n) (Q_dt_nat_inj m)) (Q_dt_nat_inj (n + m)).
  Proof.
    introv; unfold Q_dt_eq, Q_dt_add, Q_dt_nat_inj; simpl.
    rewrite <- inject_Z_plus.
    rewrite <- Nat2Z.inj_add; simpl; auto; try reflexivity.
  Qed.

  Definition Q_dt_nat_nat_inj_le : forall n m, n <= m -> Q_dt_le (Q_dt_nat_inj n) (Q_dt_nat_inj m).
  Proof.
    introv h; unfold Q_dt_eq, Q_dt_add, Q_dt_nat_inj, Q_dt_le; simpl.
    rewrite <- Zle_Qle; apply inj_le; auto.
  Qed.

  Definition Q_dt_nat_nat_inj_lt : forall n m, n < m -> Q_dt_lt (Q_dt_nat_inj n) (Q_dt_nat_inj m).
  Proof.
    introv h; unfold Q_dt_eq, Q_dt_add, Q_dt_nat_inj, Q_dt_lt; simpl.
    rewrite <- Zlt_Qlt; apply inj_lt; auto.
  Qed.

  Definition Q_dt_mul_le_r_le : forall x y z, Q_dt_lt Q_dt_0 z -> Q_dt_le (Q_dt_mul x z) (Q_dt_mul y z) -> Q_dt_le x y.
  Proof.
    introv h q.
    apply (Qmult_le_r x y z h); auto.
  Qed.

  Definition Q_dt_mul_lt_compat_r : forall a b c, Q_dt_lt a b -> Q_dt_lt Q_dt_0 c -> Q_dt_lt (Q_dt_mul a c) (Q_dt_mul b c).
  Proof.
    introv h q; apply Qmult_lt_r; auto.
  Qed.

  Definition Q_dt_mul_lt_r_lt : forall x y z, Q_dt_lt Q_dt_0 z -> Q_dt_lt (Q_dt_mul x z) (Q_dt_mul y z) -> Q_dt_lt x y.
  Proof.
    introv h q; eapply Qmult_lt_r; eauto.
  Qed.

  Definition Q_dt_nat_inj_lt_nat : forall n m, Q_dt_lt (Q_dt_nat_inj n) (Q_dt_nat_inj m) -> n < m.
  Proof.
    introv h; unfold Q_dt_lt, Q_dt_nat_inj in *.
    rewrite <- Zlt_Qlt in h.
    apply Nat2Z.inj_lt in h; auto.
  Qed.

  Definition Q_dt_approx (x : Q) : nat :=
    Z.abs_nat (Qnum x).

  Global Instance DTimeContextQ : DTimeContext :=
    MkDTimeContext
      Q_dt_T
      Q_dt_0
      Q_dt_1
      Q_dt_add
      Q_dt_mul
      Q_dt_sub
      Q_dt_opp
      Q_dt_eq
      Q_dt_lt
      Q_dt_le
      Q_dt_eqv
      Q_dt_ring
      Q_dt_nat_inj
      Q_dt_approx
      Q_dt_add_morph
      Q_dt_mul_morph
      Q_dt_opp_morph
      Q_dt_le_morph
      Q_dt_lt_morph
      Q_dt_nat_inj_cond
      Q_dt_le_refl
      Q_dt_lt_irrefl
      Q_dt_add_le_compat
      Q_dt_add_lt_le_compat
      Q_dt_mul_le_compat_r
      Q_dt_mul_lt_compat_r
      Q_dt_le_trans
      Q_dt_lt_trans
      Q_dt_le_lt_trans
      Q_dt_lt_le_trans
      Q_dt_mul_0_l
      Q_dt_mul_le_r_le
      Q_dt_mul_lt_r_lt
      Q_dt_lt_0_1
      Q_dt_lt_le_weak
      Q_dt_lt_le_dec
      Q_dt_eq_dec
      Q_dt_nat_inj_add_dist
      Q_dt_nat_nat_inj_le
      Q_dt_nat_nat_inj_lt
      Q_dt_nat_inj_lt_nat.

End DTimeQ.


Load LFindLoad.
From lfind Require Import LFind.
From adtind Require Import goal15.

Set Printing Depth 1000.
Definition lfind_eval  x:=
plus x (Succ x).

Compute lfind_eval  (Succ (Succ Zero)).

Compute lfind_eval  (Succ (Succ (Succ Zero))).

Compute lfind_eval  (Succ Zero).

Compute lfind_eval  (Zero).


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

Require Export CoRN.ftc.PartInterval.
Require Export CoRN.ftc.DerivativeOps.

Section Definitions.

(**
* Differentiability

We will now use our work on derivatives to define a notion of
differentiable function and prove its main properties.

%\begin{convention}% Throughout this section, [a,b] will be real
numbers with [a [<] b], [I] will denote the interval [[a,b]]
and [F,G,H] will be differentiable functions.
%\end{convention}%

Usually a function [F] is said to be differentiable in a proper
compact interval [[a,b]] if there exists another function [F']
such that [F'] is a derivative of [F] in that interval.  There is a
problem in formalizing this definition, as we pointed out earlier on,
which is that if we simply write it down as is we are not able to get
such a function [F'] from a hypothesis that [F] is differentiable.

However, it turns out that this is not altogether the best definition
for the following reason: if we say that [F] is differentiable in
[[a,b]], we mean that there is a partial function [F'] which is
defined in [[a,b]] and satisfies a certain condition in that
interval but nothing is required of the behaviour of the function
outside [[a,b]].  Thus we can argue that, from a mathematical
point of view, the [F'] that we get eliminating a hypothesis of
differentiability should be defined exactly on that interval.  If we
do this, we can quantify over the set of setoid functions in that
interval and eliminate the existencial quantifier without any
problems.
*)

Definition Diffble_I (a b : IR) (Hab : a [<] b) (F : PartIR) :=
 {f' : CSetoid_fun (subset (Compact (less_leEq _ _ _ Hab))) IR |
  Derivative_I Hab F (PartInt f')}.

End Definitions.

Arguments Diffble_I [a b].

Section Local_Properties.

(**
From this point on, we just prove results analogous to the ones for derivability.

A function differentiable in [[a,b]] is differentiable in every proper compact subinterval of [[a,b]].
*)

Lemma included_imp_diffble : forall a b Hab c d Hcd F,
 included (compact c d (less_leEq _ _ _ Hcd)) (compact a b (less_leEq _ _ _ Hab)) ->
 Diffble_I Hab F -> Diffble_I Hcd F.
Proof.
 intros a b Hab c d Hcd F H H0.
 elim H0; clear H0; intros f' derF.
 exists (IntPartIR (F:=(Frestr (F:=PartInt f') (compact_wd _ _ _) H)) (included_refl _ _)).
 apply Derivative_I_wdr with (PartInt f').
  FEQ.
  simpl in |- *; apply csf_wd_unfolded; simpl in |- *; algebra.
 exact (included_imp_deriv _ _ _ _ _ _ _ _ H derF).
Qed.

(**
A function differentiable in an interval is everywhere defined in that interval.
*)

Variables a b : IR.
Hypothesis Hab' : a [<] b.

(* begin hide *)
Let Hab := less_leEq _ _ _ Hab'.
Let I := Compact Hab.
(* end hide *)

Lemma diffble_imp_inc : forall F, Diffble_I Hab' F -> included I (Dom F).
Proof.
 intros F H.
 inversion_clear H.
 unfold I, Hab in |- *; Included.
Qed.

(**
If a function has a derivative in an interval then it is differentiable in that interval.
*)

Lemma deriv_imp_Diffble_I : forall F F', Derivative_I Hab' F F' -> Diffble_I Hab' F.
Proof.
 intros F F' H.
 exists (IntPartIR (derivative_imp_inc' _ _ _ _ _ H)).
 apply Derivative_I_wdr with F'.
  apply int_part_int.
 assumption.
Qed.

End Local_Properties.

#[global]
Hint Resolve diffble_imp_inc: included.

Section Operations.

(**
All the algebraic results carry on.
*)

Variables a b : IR.
Hypothesis Hab' : a [<] b.

(* begin hide *)
Let Hab := less_leEq _ _ _ Hab'.
Let I := Compact Hab.
(* end hide *)

Section Constants.

Lemma Diffble_I_const : forall c : IR, Diffble_I Hab' [-C-]c.
Proof.
 intros.
 exists (IConst (Hab:=Hab) [0]).
 apply Derivative_I_wdr with ( [-C-][0]:PartIR).
  apply part_int_const.
 Deriv.
Qed.

Lemma Diffble_I_id : Diffble_I Hab' FId.
Proof.
 exists (IConst (Hab:=Hab) [1]).
 apply Derivative_I_wdr with ( [-C-][1]:PartIR).
  apply part_int_const.
 Deriv.
Qed.

Lemma Diffble_I_poly : forall p, Diffble_I Hab' (FPoly _ p).
Proof.
 intros p.
 exists (@IntPartIR (FPoly _ (_D_ p)) _ _ Hab (included_IR _)).
 apply Derivative_I_wdr with (FPoly _ (_D_ p)).
  apply int_part_int.
 Deriv.
Qed.

End Constants.

Section Well_Definedness.

Variables F H : PartIR.

Hypothesis diffF : Diffble_I Hab' F.

Lemma Diffble_I_wd : Feq (Compact Hab) F H -> Diffble_I Hab' H.
Proof.
 intro H0.
 exists (ProjT1 diffF).
 eapply Derivative_I_wdl.
  apply H0.
 apply projT2.
Qed.

End Well_Definedness.

Variables F G : PartIR.

Hypothesis diffF : Diffble_I Hab' F.
Hypothesis diffG : Diffble_I Hab' G.

Lemma Diffble_I_plus : Diffble_I Hab' (F{+}G).
Proof.
 elim diffF; intros F' derF.
 elim diffG; intros G' derG.
 exists (IPlus F' G').
 eapply Derivative_I_wdr.
  apply part_int_plus with (F := PartInt F') (G := PartInt G').
   apply Feq_reflexive; Included.
  apply Feq_reflexive; Included.
 Deriv.
Qed.

Lemma Diffble_I_inv : Diffble_I Hab' {--}F.
Proof.
 elim diffF; intros F' derF.
 exists (IInv F').
 eapply Derivative_I_wdr.
  apply part_int_inv with (F := PartInt F').
  apply Feq_reflexive; Included.
 Deriv.
Qed.

Lemma Diffble_I_mult : Diffble_I Hab' (F{*}G).
Proof.
 elim diffF; intros F' derF.
 elim diffG; intros G' derG.
 exists (IPlus (IMult (IntPartIR (diffble_imp_inc _ _ _ _ diffF)) G')
   (IMult F' (IntPartIR (diffble_imp_inc _ _ _ _ diffG)))).
 eapply Derivative_I_wdr.
  apply part_int_plus with (F := PartInt (IMult (IntPartIR (diffble_imp_inc _ _ _ _ diffF)) G'))
    (G := PartInt (IMult F' (IntPartIR (diffble_imp_inc _ _ _ _ diffG)))).
   apply Feq_reflexive; Included.
  apply Feq_reflexive; Included.
 eapply Derivative_I_wdr.
  apply Feq_plus with (F := F{*}PartInt G') (G := PartInt F'{*}G).
   apply part_int_mult.
    FEQ.
   apply Feq_reflexive; Included.
  apply part_int_mult.
   apply Feq_reflexive; Included.
  FEQ.
 Deriv.
Qed.

(* begin show *)
Hypothesis Gbnd : bnd_away_zero I G.
(* end show *)

Lemma Diffble_I_recip : Diffble_I Hab' {1/}G.
Proof.
 elim diffG; intros G' derG.
 cut (included I (Dom G)); [ intro Hg' | unfold I, Hab in |- *; Included ].
 unfold I in Hg';
   cut (forall x : subset I, IMult (IntPartIR Hg') (IntPartIR Hg') x [#] [0]). intro H.
  exists (IInv (IDiv G' _ H)).
  eapply Derivative_I_wdr.
   apply part_int_inv with (F := PartInt (IDiv G' _ H)).
   apply Feq_reflexive; Included.
  eapply Derivative_I_wdr.
   apply Feq_inv with (F := PartInt G'{/}PartInt (IMult (IntPartIR Hg') (IntPartIR Hg'))).
   apply part_int_div.
     apply Feq_reflexive; Included.
    apply Feq_reflexive; simpl in |- *; Included.
   red in |- *; intros.
   split.
    simpl in |- *; Included.
   elim Gbnd; intros Hinc c.
   elim c; clear c; intros c H0 H1.
   exists (c[*]c).
    apply mult_resp_pos; assumption.
   intros.
   simpl in |- *.
   eapply leEq_wdr.
    2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult.
   apply mult_resp_leEq_both; auto; apply less_leEq; assumption.
  eapply Derivative_I_wdr.
   apply Feq_inv with (F := PartInt G'{/}G{*}G).
   apply Feq_div.
     Included.
    apply Feq_reflexive; Included.
   apply part_int_mult.
    FEQ.
   FEQ.
  Deriv.
 intro x.
 simpl in |- *.
 apply mult_resp_ap_zero; apply bnd_imp_ap_zero with I; auto; apply scs_prf.
Qed.

End Operations.

Section Corollaries.

Variables a b : IR.
Hypothesis Hab' : a [<] b.

(* begin hide *)
Let Hab := less_leEq _ _ _ Hab'.
Let I := Compact Hab.
(* end hide *)

Variables F G : PartIR.

Hypothesis diffF : Diffble_I Hab' F.
Hypothesis diffG : Diffble_I Hab' G.

Lemma Diffble_I_minus : Diffble_I Hab' (F{-}G).
Proof.
 apply Diffble_I_wd with (F{+}{--}G).
  apply Diffble_I_plus.
   assumption.
  apply Diffble_I_inv; assumption.
 FEQ.
Qed.

Lemma Diffble_I_scal : forall c : IR, Diffble_I Hab' (c{**}F).
Proof.
 intro.
 unfold Fscalmult in |- *.
 apply Diffble_I_mult.
  apply Diffble_I_const.
 assumption.
Qed.

Lemma Diffble_I_nth : forall n : nat, Diffble_I Hab' (F{^}n).
Proof.
 intro.
 induction  n as [| n Hrecn].
  eapply Diffble_I_wd.
   2: apply FNth_zero'; Included.
  apply Diffble_I_const.
 eapply Diffble_I_wd.
  2: apply FNth_mult'; Included.
 apply Diffble_I_mult; assumption.
Qed.

Hypothesis Gbnd : bnd_away_zero I G.

Lemma Diffble_I_div : Diffble_I Hab' (F{/}G).
Proof.
 apply Diffble_I_wd with (F{*}{1/}G).
  apply Diffble_I_mult.
   assumption.
  apply Diffble_I_recip; assumption.
 FEQ.
Qed.

End Corollaries.

Section Other_Properties.

(**
Differentiability of families of functions is proved by
induction using the constant and addition rules.
*)

Variables a b : IR.
Hypothesis Hab' : a [<] b.

Lemma Diffble_I_Sum0 : forall (f : nat -> PartIR),
 (forall n, Diffble_I Hab' (f n)) -> forall n, Diffble_I Hab' (FSum0 n f).
Proof.
 intros f diffF.
 induction  n as [| n Hrecn].
  apply Diffble_I_wd with (Fconst (S:=IR) [0]).
   apply Diffble_I_const.
  FEQ.
  red in |- *; simpl in |- *; intros.
  apply (diffble_imp_inc _ _ _ _ (diffF n)); assumption.
 apply Diffble_I_wd with (FSum0 n f{+}f n).
  apply Diffble_I_plus.
   auto.
  auto.
 FEQ.
  simpl in |- *; red in |- *; intros.
  apply (diffble_imp_inc _ _ _ _ (diffF n0)); assumption.
 simpl in |- *.
 apply bin_op_wd_unfolded; try apply Sum0_wd; intros; rational.
Qed.

Lemma Diffble_I_Sumx : forall n (f : forall i, i < n -> PartIR),
 (forall i Hi, Diffble_I Hab' (f i Hi)) -> Diffble_I Hab' (FSumx n f).
Proof.
 intro; induction  n as [| n Hrecn]; intros.
  simpl in |- *; apply Diffble_I_const.
 simpl in |- *.
 apply Diffble_I_plus; auto.
Qed.

Lemma Diffble_I_Sum : forall (f : nat -> PartIR),
 (forall n, Diffble_I Hab' (f n)) -> forall m n, Diffble_I Hab' (FSum m n f).
Proof.
 intros.
 eapply Diffble_I_wd.
  2: apply Feq_symmetric; apply FSum_FSum0'; Included.
 apply Diffble_I_minus; apply Diffble_I_Sum0; auto.
Qed.

End Other_Properties.

(**
Finally, a differentiable function is continuous.

%\begin{convention}% Let [F] be a partial function with derivative [F'] on [I].
%\end{convention}%
*)

Lemma diffble_imp_contin_I : forall a b (Hab' : a [<] b) (Hab : a [<=] b) F,
 Diffble_I Hab' F -> Continuous_I Hab F.
Proof.
 intros a b Hab' Hab F H.
 apply deriv_imp_contin_I with Hab' (PartInt (ProjT1 H)).
 apply projT2.
Qed.

#[global]
Hint Immediate included_imp_contin deriv_imp_contin_I deriv_imp_contin'_I
  diffble_imp_contin_I: continuous.

#[global]
Hint Immediate included_imp_deriv: derivate.