Require Import FOL Peano Tarski Deduction NumberTheory Synthetic Enumerability DecidabilityFacts Formulas Tennenbaum_diagonal Tennenbaum_insep Makholm McCarty Church Coding.

Notation "⊨ phi" := (forall rho, rho ⊨ phi) (at level 21).

(** * Verification that all variants can be derived from WCT_Q. *)

(*  Statements are formatted rougly as follows:

    Lemma Name (Parameters) :
      Logical Assumptions ->
      Assumptions about the Model ->
      other Assumptions ->
      Conclusion.
    Proof. [...] Qed.
 *)

Module T.
Section Variants.

Instance ff : falsity_flag := falsity_on.
Context {Δ1 : Delta1}.

Variable D : Type.
Variable I : interp D.
Variable axioms : forall ax, PA ax -> ⊨ ax.

Hypothesis wct : WCT_Q.
Hypothesis delta1_definite : forall phi, delta1 phi -> Q ⊢I phi ∨ ¬ phi.
Definition obj_Insep := exists α β, def_obj_Insep α β.

Definition div e d := exists k : D, e i⊗ k = d.
Definition div_num n (d : D) := exists e, inu n i⊗ e = d.
Definition Div_nat (d : D) := fun n => div_num n d.
Definition div_pi ψ n a :=  (inu n .: (fun _ => a)) ⊨ (∃ (ψ ∧ ∃ $1 ⊗ $0 == $3)).
Definition prime_form ψ := bounded 2 ψ /\ (forall x, Q ⊢I ∀ ψ[up (num x)..] <--> $0 == num (Irred x) ).

Lemma Irred_repr :
  ~~ exists ψ, prime_form ψ.
Proof.
  apply (DN_chaining (wct Irred)), DN.
  intros [phi Hphi].
  exists (∃ phi). split.
  - now constructor.
  - apply Hphi.
Qed.

Fact ψ_equiv n a ψ :
  prime_form ψ -> div_pi ψ n a <-> div_num (Irred n) a.
Proof.
  intros Hψ. unfold div_pi. cbn. split.
  - intros [d [->%ψ_repr H]]; auto.
  - intros. exists (inu (Irred n)). rewrite ψ_repr; auto.
Qed.

Fact MP_Discrete_stable_std :
  MP -> Discrete D -> Stable std.
Proof.
  intros mp [eq]%Discrete_sum e. unfold Stable.
  refine (MP_Dec_stable mp _ _).
  constructor. intros ?; apply eq.
Qed.

Fact stable_Std :
  Stable std -> stable (forall e, std e).
Proof.
  intros H h ?. apply H.
  now apply (DN_chaining h), DN.
Qed.

Lemma Dec_Div_nat_std :
  forall e, std e -> ~~ Dec (Div_nat e).
Proof.
  intros e [n <-].
  apply (DN_chaining (Irred_repr)), DN.
  intros [ψ ].
  constructor; intros x.
  destruct n.
  - left. exists (inu 0).
    now rewrite mult_zero_r.
  - destruct (dec_eq_nat (Mod x (S n)) 0) as [h|nh].
    + left. apply Mod_divides in h.
      destruct h as [k ->].
      exists (inu k). now rewrite inu_mult_hom, mult_comm.
    + right. intros [K HK]. apply nh.
      enough (exists k, inu k = K) as [k <-].
      * apply Mod_divides. exists k.
        rewrite mult_comm, <-inu_mult_hom in HK; auto.
        now apply inu_inj in HK; auto.
      * eapply std_mult'; eauto.
Qed.

Lemma Dec_div_reduction d ψ :
  prime_form ψ -> Dec (Div_nat d) -> Dec (fun n => div_pi ψ n d).
Proof.
  intros Hψ [H].
  constructor. intros n.
  destruct (H (Irred n)) as [h|nh].
  + left. apply ψ_equiv; auto.
  + right. intros [k ]%ψ_equiv; auto. apply nh.
    now exists k.
Qed.

Fact Std_is_Enumerable :
  (forall e, std e) -> Enumerable D.
Proof.
  intros H.
  exists (fun n => Some (inu n)).
  intros d. destruct (H d) as [n <-]; eauto.
Qed.

(* ** Variants of Tennenbaum's Theorem *)

Theorem Tennenbaum1 :
  MP ->
  Discrete D ->
  Enumerable D <-> forall e, std e.
Proof.
  intros mp eq.
  split.
  - intros ?.
    assert (~ exists e, ~ std e) as He.
    apply (DN_remove (Irred_repr)).
    intros [ψ ].
    { eapply Tennenbaum_diagonal' with (ψ0:=ψ); eauto. }
    intros e. apply MP_Discrete_stable_std; auto.
    intros nH. apply He. now exists e.
  - intros ?. now apply Std_is_Enumerable.
Qed.

Corollary Tennenbaum_insep :
  MP ->
  Discrete D ->
  (forall d, ~~Dec (Div_nat d)) -> (forall e, ~~std e).
Proof.
  intros mp eq DecDiv e.
  apply (DN_remove (Irred_repr)).
  intros [ψ ].
  refine (DN_remove (WCT_Inseparable _ _ wct) _); auto.
  - apply surj_form_.
  - apply enumerable_Q_prv.
  - intros ? He.
    eapply nonDecDiv; eauto.
    + now apply MP_Discrete_stable_std.
    + now exists e.
    + intros [d Hd]. apply (DecDiv d).
      intros h. apply Hd.
      now apply Dec_div_reduction.
Qed.

Theorem Tennenbaum2 :
  MP ->
  Discrete D ->
  (forall d, ~~Dec (Div_nat d)) <-> (forall e, std e).
Proof.
  intros mp eq. split.
  - intros ??. apply MP_Discrete_stable_std; auto.
    eapply Tennenbaum_insep; eauto.
  - intros ??. now apply Dec_Div_nat_std.
Qed.

Theorem Makholm :
  (exists ψ, prime_form ψ /\ (obj_Coding ψ)) -> obj_Insep ->
  nonStd D <-> exists d, ~ Dec (Div_nat d).
Proof.
  intros [ψ [H1 H2]] ?. split.
  - eapply Makholm; eauto.
  - intros [d Hd]. exists d.
  now intros ?%Dec_Div_nat_std.
Qed.

Lemma Tennenbaum3 :
  (UC nat bool) ->
  (exists ψ, prime_form ψ /\ (obj_Coding ψ)) -> obj_Insep ->
  ~ nonStd D.
Proof.
  intros ??? H.
  assert (nonStd D) as [e He]%Makholm by assumption; auto.
  refine (DN_Div_nat _ _ _ _ _ e _); auto.
Qed.

Lemma UC_Discrete :
  (forall X, UC X bool) -> Discrete D.
Proof.
  intros uc. unfold Discrete.
  apply UC_Def_Dec. apply uc.
  intros [x y]. destruct (@Peano.eq_dec D I axioms x y); now (left + right).
Qed.

Theorem McCarty :
  MP -> (forall X, UC X bool) ->
  (exists ψ, prime_form ψ /\ (obj_Coding ψ)) -> obj_Insep ->
  (forall e, std e).
Proof.
  intros ???? e.
  apply MP_Discrete_stable_std; auto.
  { now apply UC_Discrete. }
  intros He. apply Tennenbaum3; auto.
  now exists e.
Qed.

End Variants.
End T.

(*  Below, we list all major results again in a way that makes
    all their assumptions explicit.
 *)

Definition PA_model D I := forall ax, PA ax -> forall rho, @sat _ _ D I _ rho ax.

Theorem Tennenbaum2 {Δ1 : Delta1} D (I : interp D) :
 WCT_Q -> MP ->
 PA_model D I -> Discrete D ->
 (forall d, ~~Dec(T.Div_nat D I d)) <-> (forall e, std e).
Proof.
  intros; now apply T.Tennenbaum2.
Qed.

Theorem Makholm  {Δ1 : Delta1} D (I : interp D) ψ :
  WCT_Q -> T.obj_Insep ->
  PA_model D I ->
  T.prime_form ψ /\ obj_Coding ψ ->
  nonStd D -> exists d, ~ Dec (T.Div_nat D I d).
Proof.
  intros; eapply T.Makholm; eauto.
Qed.

Lemma Tennenbaum3 {Δ1 : Delta1} D (I : interp D) :
  WCT_Q -> (UC nat bool) -> T.obj_Insep ->
  PA_model D I ->
  (exists ψ, T.prime_form ψ /\ (obj_Coding ψ)) ->
  ~ nonStd D.
Proof.
  intros; apply T.Tennenbaum3; auto.
Qed.

Theorem McCarty {Δ1 : Delta1} D (I : interp D) :
  WCT_Q -> MP -> (forall X, UC X bool) ->
  PA_model D I ->
  (exists ψ, T.prime_form ψ /\ obj_Coding ψ) -> T.obj_Insep ->
  forall e, std e.
Proof.
  intros; apply T.McCarty; auto.
Qed.


From cgraphs.multiparty Require Import invariant langdef progress.
Require Import Coq.Logic.Classical.

(* This file contains the main theorems about MPGV. *)
(* This is the theorems part of section 5 in the paper. *)

(* The definitions used in this file can be found in definitions.v *)
(* The language definition can be found in langdef.v *)

(* Theorem 5.1 *)
Theorem global_progress e es h :
  typed ∅ e UnitT -> steps [e] ∅ es h ->
  (∃ es' h', step es h es' h') ∨ (h = ∅ ∧ ∀ e, e ∈ es -> e = Val UnitV).
Proof.
  intros. edestruct inv_global_progress; eauto using invariant_holds.
Qed.

(* Theorem 5.2 *)
Theorem reachability_deadlock_freedom es h :
  deadlock_free es h <-> fully_reachable es h.
Proof.
  unfold deadlock_free, fully_reachable.
  split.
  - intros. destruct (classic (reachable es h x)); eauto.
    assert (∃ s : gset object, ∀ x, x ∈ s <-> active es h x ∧ ¬ reachable es h x) as [s Hs].
    { edestruct activeset_exists. eapply subset_exists. naive_solver. }
    exfalso. eapply (H s).
    split; eauto.
    + set_solver.
    + naive_solver.
    + intros ???. assert (¬ reachable es h (Thread i)) by naive_solver.
      eauto using reachable.
    + intros ????.
      destruct (classic (Chan c ∈ s)); eauto. exfalso.
      eapply Hs in H2 as [].
      destruct (classic (reachable es h (Chan c))); eauto using reachable.
      assert (active es h (Chan c)).
      { destruct H3 as (?&?&?&?&?&?&?&?). eexists. eauto. }
      naive_solver.
    + intros. apply Hs in H2 as [].
      rewrite Hs.
      split. { by eapply obj_refs_active. }
      intro. eapply H4.
      eauto using reachable.
  - intros. intros [].
    eapply set_choose_L in dl_nonempty as [x Hx].
    assert (reachable es h x) as Q by eauto.
    induction Q; naive_solver.
Qed.

(* Theorem 5.3 *)
Theorem deadlock_freedom_and_full_reachability e es h :
  typed ∅ e UnitT -> steps [e] ∅ es h ->
  deadlock_free es h ∧ fully_reachable es h.
Proof.
  intros Htyped Hinv%invariant_holds; last done.
  split; [eapply reachability_deadlock_freedom|];
  unfold fully_reachable; eauto using strong_progress.
Qed.


From Test Require Import tactic.

Section FOFProblem.

Variable Universe : Set.
Variable UniverseElement : Universe.

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

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

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

End FOFProblem.


(* $Id: MoreFunctions.v,v 1.12 2003/03/13 12:06:20 lcf Exp $ *)

Require Export MoreIntervals.

Opaque Min Max.

Section Basic_Results.

(* Tex_Prose
\chapter{More about Functions}

Here we state all the main results about properties of functions that we already proved for compact intervals in the more general setting of arbitrary intervals.

\begin{convention} Let \verb!I:interval! and \verb!F,F',G,G'! be partial functions.
\end{convention}

\section{Continuity}
*)

Variable I:interval.

(* Tex_Prose
Trivial stuff.
*)

(* Begin_Tex_Verb *)
Lemma Continuous_imp_inc : (F:PartIR)
  (Continuous I F)->(included (iprop I) (Pred F)).
(* End_Tex_Verb *)
Intros; Elim H; Intros; Auto.
Qed.

(* Tex_Prose
\begin{convention} Assume that \verb!I! is compact and \verb!F! is continuous in \verb!I!.
\end{convention}
*)

Hypothesis cI:(compact_ I).
Variable F:PartIR.
Hypothesis contF:(Continuous I F).

(* Begin_Tex_Verb *)
Lemma continuous_compact :
  (H:?)(!Continuous_I (Lend cI) (Rend cI) H F).
(* End_Tex_Verb *)
Intros.
Elim contF; Intros incF contF'.
Contin.
Qed.

(* Begin_Tex_Verb *)
Hypothesis Hinc:(included (iprop I) (Pred F)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma Continuous_I_imp_tb_image :
  (totally_bounded [x:IR]
    {y:IR & {Hy:(iprop I y) | x[=](F y (Hinc y Hy))}}).
(* End_Tex_Verb *)
Cut (Continuous_I (Lend_leEq_Rend ? cI) F); Intros.
Elim (Continuous_I_imp_tb_image ???? H); Intros.
Split; [Clear b | Clear a].
Elim a; Intros x Hx.
Elim Hx; Intros y Hy.
Elim Hy; Clear a Hx Hy; Intros Hy Hx.
Exists x; Exists y; Exists (compact_interval_inc ???? Hy).
EApply eq_transitive_unfolded.
Apply Hx.
Algebra.
Intros e He.
Elim (b e He); Intros l H0 H1.
Exists l; Clear b; [Clear H1 | Clear H0].
Intros x Hx.
Elim (H0 x Hx); Intros y Hy.
Elim Hy; Clear H0 Hy Hx; Intros Hy Hx.
Exists y; Exists (compact_interval_inc ???? Hy).
EApply eq_transitive_unfolded.
Apply Hx.
Algebra.
Intros.
Apply H1.
Clear H1.
Elim H0; Intros y Hy.
Elim Hy; Clear H0 Hy; Intros Hy Hx.
Exists y; Exists (interval_compact_inc ?? (Lend_leEq_Rend ? cI) ? Hy).
EApply eq_transitive_unfolded.
Apply Hx.
Algebra.
Apply continuous_compact.
Qed.

(* Begin_Tex_Verb *)
Definition FNorm :=
  (Norm_Funct (continuous_compact (Lend_leEq_Rend ? cI))).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma FNorm_bnd_AbsIR :
  (x:IR)(iprop I x)->(Hx:?)(AbsIR (F x Hx))[<=]FNorm.
(* End_Tex_Verb *)
Intros; Unfold FNorm.
Apply norm_bnd_AbsIR.
Apply interval_compact_inc; Auto.
Qed.

End Basic_Results.

Hints Resolve Continuous_imp_inc : included.

Section Other_Results.

(* Tex_Prose
The usual stuff.
*)

Variable I:interval.

Variables F,G:PartIR.

(* Begin_Tex_Verb *)
Lemma Continuous_wd :
  (Feq (iprop I) F G)->(Continuous I F)->(Continuous I G).
(* End_Tex_Verb *)
Intros.
Elim H; Intros H' eqFG.
Elim H'; Clear H H'; Intros incF incG.
Elim H0; Clear H0; Intros incF' contF.
Split.
Auto.
Intros.
Apply Continuous_I_wd with F.
FEQ.
Simpl; Algebra.
Auto.
Qed.

(* Begin_Tex_Verb *)
Hypothesis contF : (Continuous I F).
Hypothesis contG : (Continuous I G).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma included_imp_Continuous : (a,b,Hab:?)
  (included (compact a b Hab) (iprop I))->(Continuous_I Hab F).
(* End_Tex_Verb *)
Intros.
Elim contF; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Included_imp_Continuous : (J:interval)
  (included (iprop J) (iprop I))->(Continuous J F).
(* End_Tex_Verb *)
Intros.
Split.
Exact (included_trans ??? H (Continuous_imp_inc ?? contF)).
Intros.
Apply included_imp_Continuous; Included.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_const : (c:IR)(Continuous I {-C-}c).
(* End_Tex_Verb *)
Split; Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_id : (Continuous I FId).
(* End_Tex_Verb *)
Split; Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_plus : (Continuous I F{+}G).
(* End_Tex_Verb *)
Elim contF; Intros incF' contF'.
Elim contG; Intros incG' contG'.
Split; Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_inv : (Continuous I {--}F).
(* End_Tex_Verb *)
Elim contF; Intros incF' contF'.
Split; Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_minus : (Continuous I F{-}G).
(* End_Tex_Verb *)
Elim contF; Intros incF' contF'.
Elim contG; Intros incG' contG'.
Split; Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_mult : (Continuous I F{*}G).
(* End_Tex_Verb *)
Elim contF; Intros incF' contF'.
Elim contG; Intros incG' contG'.
Split; Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_nth : (n:nat)(Continuous I F{^}n).
(* End_Tex_Verb *)
Elim contF; Intros incF' contF'.
Split; Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_scal : (c:IR)(Continuous I c{**}F).
(* End_Tex_Verb *)
Elim contF; Intros incF' contF'.
Split; Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_abs : (Continuous I (FAbs F)).
(* End_Tex_Verb *)
Elim contF; Intros incF' contF'.
Split; Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_recip :
  (bnd_away_zero_in_P G (iprop I))->(Continuous I {1/}G).
(* End_Tex_Verb *)
Intro.
Elim contG; Intros incG' contG'.
Cut (x:IR)(iprop I x)->(Hx:?)(G x Hx)[#]Zero; Intros.
Split; Contin.
Apply bnd_imp_ap_zero with (Compact (leEq_reflexive ? x)); Auto.
Apply H; Auto.
Exact (compact_single_iprop I x H0).
Exact (compact_single_prop x).
Qed.

End Other_Results.

Hints Resolve continuous_compact Continuous_const Continuous_id Continuous_plus Continuous_inv
  Continuous_minus Continuous_mult Continuous_scal Continuous_nth Continuous_recip Continuous_abs : continuous.

Hints Immediate included_imp_Continuous Included_imp_Continuous : continuous.

Section Corollaries.

Variable I:interval.

Hypothesis cI:(compact_ I).
Variables F,G:PartIR.

Hypothesis contF : (Continuous I F).
Hypothesis contG : (Continuous I G).

(* Begin_Tex_Verb *)
Lemma Continuous_div :
  (bnd_away_zero_in_P G (iprop I))->(Continuous I F{/}G).
(* End_Tex_Verb *)
Intros.
Apply Continuous_wd with F{*}{1/}G.
FEQ.
Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma FNorm_wd :
  (Feq (iprop I) F G)->(FNorm I cI F contF)[=](FNorm I cI G contG).
(* End_Tex_Verb *)
Intros; Unfold FNorm; Apply Norm_Funct_wd.
EApply included_Feq.
2: Apply H.
Included.
Qed.

End Corollaries.

Hints Resolve Continuous_div : continuous.

Section Sums.

Variable I:interval.

(* Begin_Tex_Verb *)
Lemma Continuous_Sumx : (n:nat)(f:(i:nat)(lt i n)->PartIR)
  ((i:nat)(Hi:?)(Continuous I (f i Hi)))->
  (Continuous I (FSumx n f)).
(* End_Tex_Verb *)
Intro; Induction n; Intros f contF.
Simpl; Contin.
Simpl; Contin.
Qed.

(* Tex_Prose
\begin{convention} Assume \verb!f! is a sequence of continuous functions.
\end{convention}
*)

Variable f:nat->PartIR.
Hypothesis contF : (n:nat)(Continuous I (f n)).

(* Begin_Tex_Verb *)
Lemma Continuous_Sum0 : (n:nat)(Continuous I (FSum0 n f)).
(* End_Tex_Verb *)
Intros.
Induction n.
EApply Continuous_wd.
Apply FSum0_0; Included.
Contin.
EApply Continuous_wd.
Apply FSum0_S; Included.
Contin.
Qed.

(* Begin_Tex_Verb *)
Lemma Continuous_Sum : (m,n:nat)(Continuous I (FSum m n f)).
(* End_Tex_Verb *)
Intros.
EApply Continuous_wd.
Apply Feq_symmetric; Apply FSum_FSum0'; Included.
Apply Continuous_minus; Apply Continuous_Sum0.
Qed.

End Sums.

Hints Resolve Continuous_Sum0 Continuous_Sumx Continuous_Sum : continuous.

Section Basic_Properties.

(* Tex_Prose
\section{Derivative}

Derivative is not that much different.

\begin{convention} From this point on we assume \verb!I! to be proper.
\end{convention}
*)

Variable I:interval.
Hypothesis pI:(proper I).

Variables F,G,H:PartIR.

(* Begin_Tex_Verb *)
Lemma Derivative_wdl : (Feq (iprop I) F G)->
  (Derivative I pI F H)->(Derivative I pI G H).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros H0' Heq.
Elim H0'; Intros incF incG.
Elim H1; Intros incF' H1'.
Elim H1'; Intros incH' derF.
Split.
Auto.
Split.
Auto.
Intros; Apply Derivative_I_wdl with F; Auto.
Apply included_Feq with (iprop I); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_wdr : (Feq (iprop I) F G)->
  (Derivative I pI H F)->(Derivative I pI H G).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros H0' Heq.
Elim H0'; Intros incF incG.
Elim H1; Intros incF' H1'.
Elim H1'; Intros incH' derF.
Split.
Auto.
Split.
Auto.
Intros; Apply Derivative_I_wdr with F; Auto.
Apply included_Feq with (iprop I); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_unique : (Derivative I pI F G)->
  (Derivative I pI F H)->(Feq (iprop I) G H).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros incF H0'.
Elim H0'; Intros incG derFG.
Elim H1; Intros incF' H1'.
Elim H1'; Intros incH derFH.
Apply included_Feq''; Intros.
Auto.
Apply Derivative_I_unique with F; Deriv.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_imp_inc :
  (Derivative I pI F G)->(included (iprop I) (Pred F)).
(* End_Tex_Verb *)
Intro.
Inversion_clear H0; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_imp_inc' :
  (Derivative I pI F G)->(included (iprop I) (Pred G)).
(* End_Tex_Verb *)
Intro.
Inversion_clear H0.
Inversion_clear H2; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_imp_Continuous :
  (Derivative I pI F G)->(Continuous I F).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros incF H'.
Elim H'; Intros incG derF.
Clear H0 H'.
Split; Intros.
Included.
Elim (compact_proper_in_interval ??? Hab H0 pI); Intros a' Ha.
Elim Ha; Clear Ha; Intros b' Hb.
Elim Hb; Clear Hb; Intros Hab' H2 H3.
Apply included_imp_contin with Hab:=(less_leEq ??? Hab').
Auto.
Apply deriv_imp_contin_I with Hab' G; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_imp_Continuous' :
  (Derivative I pI F G)->(Continuous I G).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros incF H'.
Elim H'; Intros incG derF.
Clear H0 H'.
Split; Intros.
Included.
Elim (compact_proper_in_interval ??? Hab H0 pI); Intros a' Ha.
Elim Ha; Clear Ha; Intros b' Hb.
Elim Hb; Clear Hb; Intros Hab' H2 H3.
Apply included_imp_contin with Hab:=(less_leEq ??? Hab').
Auto.
Apply deriv_imp_contin'_I with Hab' F; Auto.
Qed.

End Basic_Properties.

Hints Immediate Derivative_imp_inc Derivative_imp_inc' : included.
Hints Immediate Derivative_imp_Continuous Derivative_imp_Continuous' : continuous.

Section More_Results.

Variable I:interval.
Hypothesis pI:(proper I).

(* Tex_Prose
\begin{convention} Assume that \verb!F'! and \verb!G'! are derivatives of \verb!F! and \verb!G!, respectively, in \verb!I!.
\end{convention}
*)

Variables F,F',G,G':PartIR.

Hypothesis derF : (Derivative I pI F F').
Hypothesis derG : (Derivative I pI G G').

(* Begin_Tex_Verb *)
Lemma included_imp_Derivative : (a,b,Hab:?)
  (included (compact a b (less_leEq ??? Hab)) (iprop I))->
    (Derivative_I Hab F F').
(* End_Tex_Verb *)
Intros.
Elim derF; Intros incF H'.
Elim H'; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Included_imp_Derivative : (J,pJ:?)
  (included (iprop J) (iprop I))->(Derivative J pJ F F').
(* End_Tex_Verb *)
Intros.
Split.
Exact (included_trans ??? H (Derivative_imp_inc ???? derF)).
Split.
Exact (included_trans ??? H (Derivative_imp_inc' ???? derF)).
Intros.
Apply included_imp_Derivative; Included.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_const :
  (c:IR)(Derivative I pI {-C-}c {-C-}Zero).
(* End_Tex_Verb *)
Intros; Split.
Included.
Split; Deriv.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_id : (Derivative I pI FId {-C-}One).
(* End_Tex_Verb *)
Split.
Included.
Split; Deriv.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_plus : (Derivative I pI F{+}G F'{+}G').
(* End_Tex_Verb *)
Elim derF; Intros incF H.
Elim H; Intros incF' derivF.
Elim derG; Intros incG H'.
Elim H'; Intros incG' derivG.
Split.
Included.
Split; Deriv.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_inv : (Derivative I pI {--}F {--}F').
(* End_Tex_Verb *)
Elim derF; Intros incF H.
Elim H; Intros incF' derivF.
Split.
Included.
Split; Deriv.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_minus : (Derivative I pI F{-}G F'{-}G').
(* End_Tex_Verb *)
Elim derF; Intros incF H.
Elim H; Intros incF' derivF.
Elim derG; Intros incG H'.
Elim H'; Intros incG' derivG.
Split.
Included.
Split; Deriv.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_mult : (Derivative I pI F{*}G F{*}G'{+}F'{*}G).
(* End_Tex_Verb *)
Elim derF; Intros incF H.
Elim H; Intros incF' derivF.
Elim derG; Intros incG H'.
Elim H'; Intros incG' derivG.
Split.
Included.
Split.
Apply included_FPlus; Included.
Deriv.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_scal : (c:IR)(Derivative I pI c{**}F c{**}F').
(* End_Tex_Verb *)
Intro.
Elim derF; Intros incF H.
Elim H; Intros incF' derivF.
Split.
Included.
Split; Deriv.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_nth : (n:nat)
  (Derivative I pI F{^}(S n) (nring (S n)){**}(F'{*}F{^}n)).
(* End_Tex_Verb *)
Elim derF; Intros incF H.
Elim H; Intros incF' derivF.
Split.
Included.
Split; Deriv.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_recip : (bnd_away_zero_in_P G (iprop I))->
  (Derivative I pI {1/}G {--}(G'{/}(G{*}G))).
(* End_Tex_Verb *)
Elim derG; Intros incG H'.
Elim H'; Intros incG' derivG.
Clear derF derG H'.
Intro.
Cut (x:IR)(iprop I x)->(Hx:?)(Part G x Hx)[#]Zero; Intros.
Cut (x:IR)(iprop I x)->(Hx:?)(G{*}G x Hx)[#]Zero; Intros.
Split.
Included.
Split; Deriv.
Simpl; Apply mult_resp_ap_zero; Auto.
Included.
Qed.

End More_Results.

Section More_Corollaries.

Variable I:interval.
Hypothesis pI:(proper I).

Variables F,F',G,G':PartIR.

Hypothesis derF : (Derivative I pI F F').
Hypothesis derG : (Derivative I pI G G').

(* Begin_Tex_Verb *)
Hypothesis Gbnd:(bnd_away_zero_in_P G (iprop I)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma Derivative_div :
  (Derivative I pI F{/}G (F'{*}G{-}F{*}G'){/}(G{*}G)).
(* End_Tex_Verb *)
Elim derF; Intros incF Hf.
Elim Hf; Intros incF' Hf'.
Elim derG; Intros incG derivG.
Elim derivG; Intros incG' Hg'.
Clear Hf derivG.
Cut (x:IR)(iprop I x)->(Hx:?)(Part G x Hx)[#]Zero; Intros.
Split.
Included.
Split.
Apply included_FDiv.
Apply included_FMinus; Included.
Included.
Intros; Simpl; Apply mult_resp_ap_zero; Auto.
Deriv.
Included.
Qed.

End More_Corollaries.

Section More_Sums.

Variable I:interval.
Hypothesis pI:(proper I).

(* Begin_Tex_Verb *)
Lemma Derivative_Sumx : (n:nat)(f,f':(i:nat)(lt i n)->PartIR)
  ((i:nat)(Hi,Hi':?)(Derivative I pI (f i Hi) (f' i Hi')))->
  (Derivative I pI (FSumx n f) (FSumx n f')).
(* End_Tex_Verb *)
Intro; Induction n; Intros f f' derF.
Simpl; Apply Derivative_const; Auto.
Simpl; Apply Derivative_plus; Auto.
Qed.

(* Begin_Tex_Verb *)
Variables f,f':nat->PartIR.
Hypothesis derF : (n:nat)(Derivative I pI (f n) (f' n)).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma Derivative_Sum0 : (n:nat)
  (Derivative I pI (FSum0 n f) (FSum0 n f')).
(* End_Tex_Verb *)
Intros.
Induction n.
EApply Derivative_wdl.
Apply FSum0_0; Included.
EApply Derivative_wdr.
Apply FSum0_0; Included.
Apply Derivative_const.
EApply Derivative_wdl.
Apply FSum0_S; Included.
EApply Derivative_wdr.
Apply FSum0_S; Included.
Apply Derivative_plus; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_Sum : (m,n:nat)
  (Derivative I pI (FSum m n f) (FSum m n f')).
(* End_Tex_Verb *)
Intros.
EApply Derivative_wdl.
Apply Feq_symmetric; Apply FSum_FSum0'; Included.
EApply Derivative_wdr.
Apply Feq_symmetric; Apply FSum_FSum0'; Included.
Apply Derivative_minus; Apply Derivative_Sum0.
Qed.

End More_Sums.

Section Diffble_Basic_Properties.

(* Tex_Prose
\section{Differentiability}

\emph{Mutatis mutandis} for differentiability.
*)

Variable I:interval.
Hypothesis pI:(proper I).

(* Begin_Tex_Verb *)
Lemma Diffble_imp_inc : (F:PartIR)
  (Diffble I pI F)->(included (iprop I) (Pred F)).
(* End_Tex_Verb *)
Intros.
Inversion_clear H.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_imp_Diffble : (F,F':PartIR)
  (Derivative I pI F F')->(Diffble I pI F).
(* End_Tex_Verb *)
Intros.
Elim H; Intros incF H'.
Elim H'; Intros incF' derivF.
Split; Auto.
Intros; Apply deriv_imp_Diffble_I with F'; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_wd : (F,H:PartIR)(Feq (iprop I) F H)->
  (Diffble I pI F)->(Diffble I pI H).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros H2 eqFH.
Elim H2; Intros incF incH.
Inversion_clear H1.
Split; Auto.
Intros; Apply Diffble_I_wd with F; Auto.
Apply included_Feq with (iprop I); Auto.
Qed.

Variables F,G:PartIR.

Hypothesis diffF:(Diffble I pI F).
Hypothesis diffG:(Diffble I pI G).

(* Tex_Prose
\begin{convention} Assume \verb!F! and \verb!G! are differentiable in \verb!I!.
\end{convention}
*)

(* Begin_Tex_Verb *)
Lemma included_imp_Diffble : (a,b,Hab:?)
  (included (compact a b (less_leEq ??? Hab)) (iprop I))->
    (Diffble_I Hab F).
(* End_Tex_Verb *)
Intros.
Elim diffF; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Included_imp_Diffble : (J,pJ:?)
  (included (iprop J) (iprop I))->(Diffble J pJ F).
(* End_Tex_Verb *)
Intros.
Split.
Exact (included_trans ??? H (Diffble_imp_inc ? diffF)).
Intros; Apply included_imp_Diffble; Included.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_const : (c:IR)(Diffble I pI {-C-}c).
(* End_Tex_Verb *)
Intro.
Split.
Included.
Intros; Apply Diffble_I_const.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_id : (Diffble I pI FId).
(* End_Tex_Verb *)
Split.
Included.
Intros; Apply Diffble_I_id.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_plus : (Diffble I pI F{+}G).
(* End_Tex_Verb *)
Elim diffF; Intros incF diffbleF.
Elim diffG; Intros incG diffbleG.
Split.
Included.
Intros; Apply Diffble_I_plus; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_inv : (Diffble I pI {--}F).
(* End_Tex_Verb *)
Elim diffF; Intros incF diffbleF.
Split.
Included.
Intros; Apply Diffble_I_inv; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_minus : (Diffble I pI F{-}G).
(* End_Tex_Verb *)
Elim diffF; Intros incF diffbleF.
Elim diffG; Intros incG diffbleG.
Split.
Included.
Intros; Apply Diffble_I_minus; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_mult : (Diffble I pI F{*}G).
(* End_Tex_Verb *)
Elim diffF; Intros incF diffbleF.
Elim diffG; Intros incG diffbleG.
Split.
Included.
Intros; Apply Diffble_I_mult; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_nth : (n:nat)(Diffble I pI F{^}n).
(* End_Tex_Verb *)
Elim diffF; Intros incF diffbleF.
Split.
Included.
Intros; Apply Diffble_I_nth; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_scal : (c:IR)(Diffble I pI c{**}F).
(* End_Tex_Verb *)
Elim diffF; Intros incF diffbleF.
Split.
Included.
Intros; Apply Diffble_I_scal; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_recip :
  (bnd_away_zero_in_P G (iprop I))->(Diffble I pI {1/}G).
(* End_Tex_Verb *)
Elim diffG; Intros incG diffbleG Gbnd.
Cut (x:IR)(iprop I x)->(Hx:?)(Part G x Hx)[#]Zero; Intros.
Split.
Included.
Intros; Apply Diffble_I_recip; Auto.
Included.
Qed.

End Diffble_Basic_Properties.

Hints Immediate Diffble_imp_inc : included.

Section Diffble_Corollaries.

Variable I:interval.
Hypothesis pI:(proper I).

Variables F,G:PartIR.

Hypothesis diffF:(Diffble I pI F).
Hypothesis diffG:(Diffble I pI G).

(* Begin_Tex_Verb *)
Lemma Diffble_div :
  (bnd_away_zero_in_P G (iprop I))->(Diffble I pI F{/}G).
(* End_Tex_Verb *)
Intro.
Apply Diffble_wd with F{*}{1/}G.
Apply eq_imp_Feq.
Apply included_FMult.
Apply Diffble_imp_inc with pI; Apply diffF.
Apply included_FRecip.
Apply Diffble_imp_inc with pI; Apply diffG.
Included.
Apply included_FDiv.
Apply Diffble_imp_inc with pI; Apply diffF.
Apply Diffble_imp_inc with pI; Apply diffG.
Included.
Intros; Simpl; Rational.
Apply Diffble_mult; Auto.
Apply Diffble_recip; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_Sum0 : (f:?)((n:nat)(Diffble I pI (f n)))->
  (n:nat)(Diffble I pI (FSum0 n f)).
(* End_Tex_Verb *)
Intros f hypF n.
Split.
Red; Simpl; Intros.
Elim (hypF n0); Intros.
Exact (a x H).
Intros; Apply Diffble_I_Sum0; Auto.
Intro; Elim (hypF n0); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_Sumx : (n:nat)(f:?)(good_fun_seq' n f)->
  ((i:nat)(Hi:?)(Diffble I pI (f i Hi)))->(Diffble I pI (FSumx n f)).
(* End_Tex_Verb *)
Intros n f Hgood hypF.
Split.
Red; Intros.
Apply FSumx_pred'; Auto.
Intros.
Elim (hypF i Hi); Auto.
Intros; Apply Diffble_I_Sumx.
Intros i Hi; Elim (hypF i Hi); Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_Sum : (f:?)((n:nat)(Diffble I pI (f n)))->
  (m,n:nat)(Diffble I pI (FSum m n f)).
(* End_Tex_Verb *)
Intros f hypF m n.
EApply Diffble_wd.
Apply Feq_symmetric; Apply FSum_FSum0'.
Intro; Apply Diffble_imp_inc with pI; Auto.
Apply Diffble_minus; Apply Diffble_Sum0; Auto.
Qed.

End Diffble_Corollaries.

Section Nth_Derivative.

(* Tex_Prose
\section{N$^{\mathrm{th}}$ Derivative}

Higher order derivatives pose more interesting problems.  It turns out that it really becomes necessary to generalize our \verb!n_deriv! operator to any interval.
*)

Variable I:interval.
Hypothesis pI : (proper I).

Section Definitions.

(* Tex_Prose
\begin{convention} Let \verb!n:nat!, \verb!F:PartIR! and assume that \verb!F! is $n$-times differentiable in \verb!I!.
\end{convention}
*)

Variable n:nat.
Variable F:PartIR.
Hypothesis diffF:(Diffble_n n I pI F).

(* Begin_Tex_Verb *)
Definition N_Deriv_fun : (x:IR)(iprop I x)->IR.
(* End_Tex_Verb *)
Intros.
LetTac J:=(compact_in_interval I pI x H).
Elim diffF; Intros incF diffbleF.
LetTac a:=(Lend (compact_compact_in_interval I pI x H)).
LetTac b:=(Rend (compact_compact_in_interval I pI x H)).
Fold J in a b.
Cut a[<]b; Intros.
Cut (Diffble_I_n H0 n F); Intros.
Apply (Part (n_deriv_I ????? H1) x).
Apply n_deriv_inc.
Unfold a b J; Apply iprop_compact_in_interval_inc2.
Apply iprop_compact_in_interval.
Apply diffbleF.
Apply included_trans with (iprop J); Unfold a b J; Included.
Unfold a b J; Apply proper_compact_in_interval'.
Defined.

(* Begin_Tex_Verb *)
Lemma N_Deriv_char
(* End_Tex_Verb *)
 : (x,Hx,H:?)(N_Deriv_fun x Hx)[=]
  (Part (n_deriv_I ?? (proper_compact_in_interval' ???? (compact_compact_in_interval I pI x Hx)) n F H) x
    (n_deriv_inc ??????? (iprop_compact_in_interval_inc2 ???? (compact_compact_in_interval ????)
      (less_leEq ??? (proper_compact_in_interval' ???? (compact_compact_in_interval ????))) ? (iprop_compact_in_interval ????)))).
Intros.
Unfold N_Deriv_fun.
Elim diffF; Intros; Simpl.
Apply n_deriv_I_wd'.
Algebra.
Apply iprop_compact_in_interval'.
Apply iprop_compact_in_interval'.
Apply b.
Apply included_trans with (Compact (less_leEq ??? (proper_compact_in_interval' ???? (compact_compact_in_interval I pI x Hx)))).
2: Included.
Red; Intros.
Inversion_clear H0.
Split.
EApply leEq_wdl.
Apply H1.
EApply eq_transitive_unfolded.
Apply Min_comm.
Apply leEq_imp_Min_is_lft; Apply eq_imp_leEq.
Apply compact_in_interval_wd1; Algebra.
EApply leEq_wdr.
Apply H2.
Apply leEq_imp_Max_is_rht; Apply eq_imp_leEq.
Apply compact_in_interval_wd2; Algebra.
Qed.

(* Begin_Tex_Verb *)
Lemma N_Deriv_strext : (x,y:IR)(Hx,Hy:?)
  (((N_Deriv_fun x Hx)[#](N_Deriv_fun y Hy))->(x[#]y)).
(* End_Tex_Verb *)
Intros.
Elim diffF; Intros incF diffbleF.
Cut (Diffble_I_n (proper_compact_in_interval2' ?????? (compact_compact_in_interval2 I pI x y Hx Hy)) n F); Intros.
Cut (Diffble_I_n (proper_compact_in_interval' ???? (compact_compact_in_interval I pI x Hx)) n F); Intros.
Cut (Diffble_I_n (proper_compact_in_interval' ???? (compact_compact_in_interval I pI y Hy)) n F); Intros.
Cut (Pred (n_deriv_I ????? H0) x); Intros.
Cut (Pred (n_deriv_I ????? H0) y); Intros.
Apply pfstrx with Hx:=H3 Hy:=H4.
EApply ap_well_def_lft_unfolded.
EApply ap_well_def_rht_unfolded.
Apply H.
EApply eq_transitive_unfolded.
Apply (N_Deriv_char y Hy H2).
Apply n_deriv_I_wd'.
Algebra.
Apply iprop_compact_in_interval_inc2; Apply iprop_compact_in_interval.
Apply iprop_compact_in_interval2_inc2; Apply iprop_compact_in_interval2y.
Apply included_imp_diffble_n with Hab':=(proper_compact_in_interval2' ?????? (compact_compact_in_interval2 I pI x y Hx Hy)).
2: Apply H0.
Red; Intros z Hz.
Inversion_clear Hz; Split.
EApply leEq_wdl.
Apply H5.
EApply eq_transitive_unfolded.
Apply Min_comm.
Apply leEq_imp_Min_is_lft.
Apply compact_in_interval_y_lft.
EApply leEq_wdr.
Apply H6.
Apply leEq_imp_Max_is_rht.
Apply compact_in_interval_y_rht.
EApply eq_transitive_unfolded.
Apply (N_Deriv_char x Hx H1).
Apply n_deriv_I_wd'.
Algebra.
Apply iprop_compact_in_interval_inc2; Apply iprop_compact_in_interval.
Apply iprop_compact_in_interval2_inc2; Apply iprop_compact_in_interval2x.
Apply included_imp_diffble_n with Hab':=(proper_compact_in_interval2' ?????? (compact_compact_in_interval2 I pI x y Hx Hy)).
2: Apply H0.
Red; Intros z Hz.
Inversion_clear Hz; Split.
EApply leEq_wdl.
Apply H5.
EApply eq_transitive_unfolded.
Apply Min_comm.
Apply leEq_imp_Min_is_lft.
Apply compact_in_interval_x_lft.
EApply leEq_wdr.
Apply H6.
Apply leEq_imp_Max_is_rht.
Apply compact_in_interval_x_rht.
Apply n_deriv_inc.
Apply iprop_compact_in_interval2_inc2; Apply iprop_compact_in_interval2y.
Apply n_deriv_inc.
Apply iprop_compact_in_interval2_inc2; Apply iprop_compact_in_interval2x.
Apply diffbleF.
Simpl; Included.
Apply diffbleF.
Simpl; Included.
Apply diffbleF.
Simpl; Included.
Qed.

(* Begin_Tex_Verb *)
Lemma N_Deriv_wd : (x,y:IR)(Hx,Hy:?)(x[=]y)->
  (N_Deriv_fun x Hx)[=](N_Deriv_fun y Hy).
(* End_Tex_Verb *)
Intros.
Apply not_ap_imp_eq; Intro.
Cut x[#]y.
Apply eq_imp_not_ap; Auto.
Exact (N_Deriv_strext ???? H0).
Qed.

(* Begin_Tex_Verb *)
Definition N_Deriv : PartIR.
(* End_Tex_Verb *)
Apply Build_PartFunct with pfpfun:=N_Deriv_fun.
Apply iprop_wd.
Exact N_Deriv_strext.
Defined.

End Definitions.

Section Basic_Results.

(* Tex_Prose
All the usual results hold.
*)

(* Begin_Tex_Verb *)
Lemma Diffble_n_wd : (n:nat)(F,G:PartIR)(Feq (iprop I) F G)->
  (Diffble_n n I pI F)->(Diffble_n n I pI G).
(* End_Tex_Verb *)
Intros.
Elim H; Intros H1.
Elim H1; Intros incG incF.
Split.
Auto.
Intros; Apply Diffble_I_n_wd with F.
Apply included_Feq with (iprop I); Auto.
Elim H0; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_wdr : (n,F,G,H:?)(Feq (iprop I) G H)->
  (Derivative_n n I pI F G)->(Derivative_n n I pI F H).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros H2 Heq.
Elim H2; Intros incG incH.
Elim H1; Intros incF H0'.
Elim H0'; Intros incG' derivF.
Clear H2 H0'.
Split; Auto.
Split; Auto.
Intros; Apply Derivative_I_n_wdr with G.
Apply included_Feq with (iprop I); Auto.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_wdl : (n,F,G,H:?)(Feq (iprop I) F G)->
  (Derivative_n n I pI F H)->(Derivative_n n I pI G H).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros H2 Heq.
Elim H2; Intros incG incH.
Elim H1; Intros incF H0'.
Elim H0'; Intros incG' derivF.
Clear H2 H0'.
Split; Auto.
Split; Auto.
Intros; Apply Derivative_I_n_wdl with F.
Apply included_Feq with (iprop I); Auto.
Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_unique : (n:nat)(F,G,H:PartIR)
  (Derivative_n n I pI F G)->(Derivative_n n I pI F H)->
  (Feq (iprop I) G H).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros incF H2.
Elim H2; Intros incG derivFG.
Elim H1; Intros incF' H3.
Elim H3; Intros incH derivFH.
FEQ.
Apply Feq_imp_eq with (Compact (less_leEq ??? (proper_compact_in_interval' ???? (compact_compact_in_interval I pI x H4)))).
Apply Derivative_I_n_unique with n F.
Apply derivFG.
Simpl; Included.
Apply derivFH.
Simpl; Included.
Apply interval_compact_inc.
Apply iprop_compact_in_interval.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_n_imp_Diffble : (n:nat)(lt O n)->(F:PartIR)
  (Diffble_n n I pI F)->(Diffble I pI F).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros incF diffF.
Split; Auto.
Intros; Apply Diffble_I_n_imp_diffble with n; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_imp_Diffble : (n:nat)(lt O n)->(F,F':PartIR)
  (Derivative_n n I pI F F')->(Diffble I pI F).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros incF H1.
Elim H1; Intros incF' derivF.
Split; Auto.
Intros; Apply deriv_n_imp_diffble with n F'; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma le_imp_Diffble_n : (m,n:nat)(le m n)->(F:PartIR)
  (Diffble_n n I pI F)->(Diffble_n m I pI F).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros incF diffF.
Split; Auto.
Intros; Apply le_imp_Diffble_I with n; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_n_imp_le : (n:nat)(lt O n)->(F,F':PartIR)
  (Diffble_n n I pI F)->(Derivative I pI F F')->
    (Diffble_n (pred n) I pI F').
(* End_Tex_Verb *)
Intros.
Elim H0; Intros incF diffF.
Elim H1; Intros incFa H2.
Elim H2; Intros incF' derivF.
Split; Auto.
Intros; Apply Diffble_I_imp_le with F; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Diffble_n_imp_inc : (n:nat)(F:PartIR)
  (Diffble_n n I pI F)->(included (iprop I) (Pred F)).
(* End_Tex_Verb *)
Intros.
Inversion_clear H; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_imp_Diffble_n : (n:nat)(F,F':PartIR)
  (Derivative_n n I pI F F')->(Diffble_n n I pI F).
(* End_Tex_Verb *)
Intros.
Elim H; Intros incF H1.
Elim H1; Intros incF' derivF.
Split; Auto.
Intros; Apply deriv_n_imp_Diffble_I_n with F'; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_imp_inc : (n:nat)(F,F':PartIR)
  (Derivative_n n I pI F F')->(included (iprop I) (Pred F)).
(* End_Tex_Verb *)
Intros.
Inversion_clear H; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_imp_inc' : (n:nat)(F,F':PartIR)
  (Derivative_n n I pI F F')->(included (iprop I) (Pred F')).
(* End_Tex_Verb *)
Intros.
Inversion_clear H; Inversion_clear H1; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma included_imp_Derivative_n : (n,F,F',a,b,Hab:?)
  (Derivative_n n I pI F F')->
  (included (Compact (less_leEq ??? Hab)) (iprop I))->
  (!Derivative_I_n a b Hab n F F').
(* End_Tex_Verb *)
Intros.
Elim H; Intros incF H1.
Elim H1; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma included_imp_Diffble_n : (n,F,a,b,Hab:?)
  (Diffble_n n I pI F)->
  (included (Compact (less_leEq ??? Hab)) (iprop I))->
  (!Diffble_I_n a b Hab n F).
(* End_Tex_Verb *)
Intros.
Elim H; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Included_imp_Derivative_n : (n:nat)(J,pJ:?)(F,F':PartIR)
  (included (iprop J) (iprop I))->(Derivative_n n I pI F F')->
  (Derivative_n n J pJ F F').
(* End_Tex_Verb *)
Intros.
Inversion_clear H0.
Inversion_clear H2.
Split.
Included.
Split.
Included.
Intros; Apply H3.
Included.
Qed.

(* Begin_Tex_Verb *)
Lemma Included_imp_Diffble_n : (n:nat)(J,pJ:?)(F:PartIR)
  (included (iprop J) (iprop I))->
  (Diffble_n n I pI F)->(Diffble_n n J pJ F).
(* End_Tex_Verb *)
Intros.
Inversion_clear H0.
Split.
Included.
Intros; Apply H2.
Included.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_plus : (J,pJ,n,m,k,F,G,H:?)
  (Derivative_n m J pJ F G)->(Derivative_n n J pJ G H)->
  k=(plus m n)->(Derivative_n k J pJ F H).
(* End_Tex_Verb *)
Intros.
Elim H0; Intros incF Hf.
Elim Hf; Intros incG derFG.
Elim H1; Intros incG' Hg.
Elim Hg; Intros incH derGH.
Clear Hf Hg.
Split; Auto.
Split; Auto.
Intros; Apply Derivative_I_n_plus with n m G; Auto.
Qed.

End Basic_Results.

Section More_Results.

(* Tex_Prose
Some new results hold, too:
*)

(* Begin_Tex_Verb *)
Lemma N_Deriv_Feq : (n,F,diffF,a,b,Hab,H:?)
  (incN:(included (Compact (less_leEq ??? Hab))
                  (Pred (N_Deriv n F diffF))))
  (Feq (Compact (less_leEq ??? Hab))
       (N_Deriv n F diffF) (n_deriv_I a b Hab n F H)).
(* End_Tex_Verb *)
Intros.
FEQ.
Apply n_deriv_inc.
Simpl.
Cut (!Diffble_I_n ?? (proper_compact_in_interval' ???? (compact_compact_in_interval I pI x Hx)) n F); Intros.
EApply eq_transitive_unfolded.
Apply (N_Deriv_char n F diffF x Hx H1).
Apply n_deriv_I_wd'; Auto.
Algebra.
Apply iprop_compact_in_interval_inc2; Apply iprop_compact_in_interval.
Apply included_imp_Diffble_n; Auto.
Apply included_interval'.
Apply (included_compact_in_interval I pI x Hx).
Apply (iprop_compact_in_interval_inc1 ???? (compact_compact_in_interval I pI x Hx)
  (Lend_leEq_Rend ? (compact_compact_in_interval I pI x Hx))).
Apply compact_inc_lft.
Apply (included_compact_in_interval I pI x Hx).
Apply (iprop_compact_in_interval_inc1 ???? (compact_compact_in_interval I pI x Hx)
  (Lend_leEq_Rend ? (compact_compact_in_interval I pI x Hx))).
Apply compact_inc_rht.
Apply incN; Apply compact_inc_lft.
Apply incN; Apply compact_inc_rht.
Elim diffF; Intros incF diffbleF.
Apply diffbleF; Auto.
EApply included_trans.
Apply iprop_compact_in_interval_inc1.
Included.
Qed.

(* Begin_Tex_Verb *)
Lemma N_Deriv_lemma : (n:nat)(F:PartIR)(H:(Diffble_n n I pI F))
  (Derivative_n n I pI F (N_Deriv ?? H)).
(* End_Tex_Verb *)
Intros.
Elim H; Intros incF diffF.
Split; Auto.
Split; Included.
Intros.
Cut (Diffble_I_n Hab n F); Intros; Auto.
EApply Derivative_I_n_wdr.
Apply Feq_symmetric; Apply (N_Deriv_Feq n F (incF,diffF) ?? Hab H1 H0).
Apply n_deriv_lemma.
Qed.

(* Begin_Tex_Verb *)
Lemma N_Deriv_S : (n:nat)(F:PartIR)
  (H:(Diffble_n n I pI F))(H':(Diffble_n (S n) I pI F))
  (Derivative I pI (N_Deriv ?? H) (N_Deriv ?? H')).
(* End_Tex_Verb *)
Intros.
Split; Included.
Split; Included.
Elim H; Intros incF diffFn.
Elim H'; Intros incF' diffFSn.
Intros.
Cut (Diffble_I_n Hab n F); Intros; Auto.
Cut (Diffble_I_n Hab (S n) F); Intros; Auto.
EApply Derivative_I_wdl.
Apply Feq_symmetric; Apply (N_Deriv_Feq n F (incF,diffFn) ?? Hab H1 H0).
EApply Derivative_I_wdr.
Apply Feq_symmetric; Apply (N_Deriv_Feq ?? (incF',diffFSn) ?? Hab H2 H0).
Apply n_Sn_deriv.
Qed.

(* Begin_Tex_Verb *)
Lemma N_Deriv_plus :
  (m,n:nat)(F:PartIR)(H:(Diffble_n n I pI F))
  (H':(Diffble_n (plus m n) I pI F))
  (Derivative_n m I pI (N_Deriv ?? H) (N_Deriv ?? H')).
(* End_Tex_Verb *)
Intros.
Split; Included.
Split; Included.
Intros.
Cut (Diffble_I_n Hab n F); Intros.
Cut (Diffble_I_n Hab (plus m n) F); Intros.
EApply Derivative_I_n_wdl.
Apply Feq_symmetric; Apply (N_Deriv_Feq n F H ?? Hab H1 H0).
EApply Derivative_I_n_wdr.
Apply Feq_symmetric; Apply (N_Deriv_Feq ?? H' ?? Hab H2 H0).
Apply n_deriv_plus.
Elim H'; Auto.
Elim H; Auto.
Qed.

(* Tex_Prose
Some useful characterization results.
*)

(* Begin_Tex_Verb *)
Lemma Derivative_n_O : (F:?)
  (included (iprop I) (Pred F))->(Derivative_n O I pI F F).
(* End_Tex_Verb *)
Intros.
Split; Included.
Split; Included.
Intros.
Red; Apply Feq_reflexive; Included.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_Sn : (F,n,fn,fSn:?)
  (Derivative_n n I pI F fn)->
  (Derivative_n (S n) I pI F fSn)->(Derivative I pI fn fSn).
(* End_Tex_Verb *)
Intros.
Cut (Diffble_n n I pI F); [Intro | EApply Derivative_n_imp_Diffble_n; Apply H].
Cut (Diffble_n (S n) I pI F); [Intro | EApply Derivative_n_imp_Diffble_n; Apply H0].
Apply Derivative_wdl with (N_Deriv ?? H1).
Apply Derivative_n_unique with n F.
Apply N_Deriv_lemma.
Auto.
Apply Derivative_wdr with (N_Deriv ?? H2).
Apply Derivative_n_unique with (S n) F.
Apply N_Deriv_lemma.
Auto.
Apply N_Deriv_S.
Qed.

End More_Results.

Section Derivating_Diffble.

(* Tex_Prose
As a special case we get a differentiation operator\ldots
*)

Variable F:PartIR.

(* Begin_Tex_Verb *)
Hypothesis diffF:(Diffble I pI F).
(* End_Tex_Verb *)

(* Begin_Tex_Verb *)
Lemma Diffble_imp_Diffble_n : (Diffble_n (1) I pI F).
(* End_Tex_Verb *)
Elim diffF; Intros incF diffbleF.
Split; Auto.
Intros; Exists (diffbleF a b Hab H).
Simpl; Included.
Qed.

(* Begin_Tex_Verb *)
Definition Deriv := (N_Deriv (1) F Diffble_imp_Diffble_n).
(* End_Tex_Verb *)

End Derivating_Diffble.

Section Corollaries.

(* Tex_Prose
\ldots for which the expected property also holds.
*)

(* Begin_Tex_Verb *)
Lemma Deriv_lemma : (F:PartIR)(diffF:?)(Derivative I pI F (Deriv F diffF)).
(* End_Tex_Verb *)
Intros; Unfold Deriv.
Apply Derivative_wdl with (N_Deriv (0) F (le_imp_Diffble_n (0) (1) (le_n_Sn (0)) F (Diffble_imp_Diffble_n ? diffF))).
Apply Derivative_n_unique with (0) F.
Apply N_Deriv_lemma.
Apply Derivative_n_O; Elim diffF; Auto.
Apply N_Deriv_S.
Qed.

(* Tex_Prose
Some more interesting properties.
*)

(* Begin_Tex_Verb *)
Lemma Derivative_n_1 : (F,G:?)(Derivative I pI F G)->
  (Derivative_n (1) I pI F G).
(* End_Tex_Verb *)
Intros.
Cut (Diffble I pI F); Intros.
Apply Derivative_n_wdr with (Deriv ? H0).
Apply Derivative_unique with pI F.
Apply Deriv_lemma.
Auto.
Unfold Deriv; Apply N_Deriv_lemma.
Apply Derivative_imp_Diffble with G; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_chain : (F,f:?)
  (Feq (iprop I) F (f O))->
  ((n:nat)(Derivative I pI (f n) (f (S n))))->
  (n:nat)(Derivative_n n I pI F (f n)).
(* End_Tex_Verb *)
Intros.
Induction n.
Apply Derivative_n_wdr with F.
Auto.
Apply Derivative_n_O.
Inversion_clear H; Inversion_clear H1; Auto.
Apply Derivative_n_plus with (1) n (f n); Auto.
Apply Derivative_n_1; Auto.
Rewrite plus_sym; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_imp_Continuous : (n,F,G:?)(lt O n)->
  (Derivative_n n I pI F G)->(Continuous I F).
(* End_Tex_Verb *)
Intros.
Cut (Diffble I pI F); Intros.
Apply Derivative_imp_Continuous with pI (Deriv ? H1).
Apply Deriv_lemma.
Apply Diffble_n_imp_Diffble with n; Auto.
Apply Derivative_n_imp_Diffble_n with G; Auto.
Qed.

(* Begin_Tex_Verb *)
Lemma Derivative_n_imp_Continuous' : (n,F,G:?)(lt O n)->
  (Derivative_n n I pI F G)->(Continuous I G).
(* End_Tex_Verb *)
Intros.
Cut (Diffble_n (pred n) I pI F); Intros.
Apply Derivative_imp_Continuous' with pI (N_Deriv ?? H1).
Apply Derivative_wdr with (N_Deriv ?? (Derivative_n_imp_Diffble_n ??? H0)).
Apply Derivative_n_unique with n F; Auto; Apply N_Deriv_lemma.
Cut n=(S (pred n)); [Intro | Apply S_pred with O; Auto].
Generalize H0.
Pattern 1 3 4 n; Rewrite H2.
Intro; Apply N_Deriv_S.
Apply le_imp_Diffble_n with n.
Auto with arith.
Apply Derivative_n_imp_Diffble_n with G; Auto.
Qed.

End Corollaries.

End Nth_Derivative.

Hints Resolve Derivative_const Derivative_id Derivative_plus Derivative_inv Derivative_minus Derivative_mult
  Derivative_scal Derivative_nth Derivative_recip Derivative_div Derivative_Sumx Derivative_Sum0 Derivative_Sum : derivate.

Hints Immediate Derivative_n_imp_inc Derivative_n_imp_inc' Diffble_n_imp_inc : included.

Hints Resolve Deriv_lemma N_Deriv_lemma : derivate.

Hints Immediate Derivative_n_imp_Continuous Derivative_n_imp_Continuous' : continuous.


Require Import Gappa_common.
Require Import Gappa_pred_bnd.

Theorem bnd_of_nzr_rel :
 forall a b : R, forall zi : FF,
 NZR b -> REL a b zi ->
 BND ((a - b) / b) zi.
Proof.
intros a b zi Hb (x,(Hr1,Hr2)).
cutrewrite ((a - b) / b = x)%R.
exact Hr1.
rewrite Hr2.
field.
exact Hb.
Qed.

Theorem rel_of_nzr_bnd :
  forall a b : R, forall zi : FF,
  NZR b -> BND ((a - b) / b) zi ->
  REL a b zi.
Proof.
intros a b zi Hb Hr.
exists ((a - b) / b)%R.
split.
exact Hr.
now field.
Qed.

Definition one_plus (xi : FF) :=
  makepairF (Fplus2 (Float2 1 0) (lower xi)) (Fplus2 (Float2 1 0) (upper xi)).

Lemma one_plus_correct :
  forall x xi,
  BND x xi ->
  BND (1 + x) (one_plus xi).
Proof.
intros x xi Hx.
apply IRplus with (xl := 1%R) (xu := 1%R) (4 := Hx) ; simpl.
rewrite Fplus2_correct.
apply Rplus_le_compat_r.
unfold float2R, Defs.F2R. simpl.
rewrite Rmult_1_l.
apply Rle_refl.
rewrite Fplus2_correct.
apply Rplus_le_compat_r.
unfold float2R, Defs.F2R. simpl.
rewrite Rmult_1_l.
apply Rle_refl.
split ; apply Rle_refl.
Qed.

Theorem bnd_of_bnd_rel_p :
  forall x y : R, forall yi ei xi : FF,
  BND y yi -> REL x y ei ->
  mul_pp_helper yi (one_plus ei) xi = true ->
  BND x xi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
rewrite He2.
apply mul_pp with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Theorem bnd_of_bnd_rel_o :
  forall x y : R, forall yi ei xi : FF,
  BND y yi -> REL x y ei ->
  mul_op_helper yi (one_plus ei) xi = true ->
  BND x xi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
rewrite He2.
apply mul_op with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Theorem bnd_of_bnd_rel_n :
  forall x y : R, forall yi ei xi : FF,
  BND y yi -> REL x y ei ->
  mul_np_helper yi (one_plus ei) xi = true ->
  BND x xi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
rewrite He2.
apply mul_np with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Lemma rel_swap :
  forall x y e ei,
  BND e ei ->
  x = (y * (1 + e))%R ->
  Fpos (lower (one_plus ei)) = true ->
  y = (x / (1 + e))%R.
Proof.
intros x y e ei He Hx Hb.
rewrite Hx.
field.
apply Rgt_not_eq.
apply Rlt_gt.
assert (H := one_plus_correct _ _ He).
destruct H as (H,_).
apply Rlt_le_trans with (2 := H).
now apply Fpos_correct.
Qed.

Theorem bnd_of_rel_bnd_p :
  forall x y : R, forall xi ei yi : FF,
  BND x xi -> REL x y ei ->
  div_pp_helper xi (one_plus ei) yi = true ->
  BND y yi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
destruct (andb_prop _ _ Hb) as (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
rewrite rel_swap with (1 := He1) (2 := He2) (3 := H1).
apply div_pp with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Theorem bnd_of_rel_bnd_o :
  forall x y : R, forall xi ei yi : FF,
  BND x xi -> REL x y ei ->
  div_op_helper xi (one_plus ei) yi = true ->
  BND y yi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
destruct (andb_prop _ _ Hb) as (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
rewrite rel_swap with (1 := He1) (2 := He2) (3 := H1).
apply div_op with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Theorem bnd_of_rel_bnd_n :
  forall x y : R, forall xi ei yi : FF,
  BND x xi -> REL x y ei ->
  div_np_helper xi (one_plus ei) yi = true ->
  BND y yi.
Proof.
intros x y yi ei xi Hy (e,(He1,He2)) Hb.
destruct (andb_prop _ _ Hb) as (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
generalize (andb_prop _ _ H1). clear H1. intros (H1,_).
rewrite rel_swap with (1 := He1) (2 := He2) (3 := H1).
apply div_np with (1 := Hy) (3 := Hb).
apply one_plus_correct with (1 := He1).
Qed.

Theorem rel_refl :
  forall a : R, forall zi : FF,
  contains_zero_helper zi = true ->
  REL a a zi.
Proof.
intros a zi Hb.
exists R0.
split.
now apply contains_zero.
ring.
Qed.

Lemma error_of_rel_generic :
 forall f,
 forall t: (forall x y : R, forall xi yi zi : FF,
            BND x xi -> BND y yi -> f xi yi zi = true ->
            BND (x * y) zi),
 forall a b : R, forall xi yi zi : FF,
 REL a b xi -> BND b yi ->
 f xi yi zi = true ->
 BND (a - b) zi.
Proof.
intros f t a b xi yi zi (x,(Hr1,Hr2)).
cutrewrite (a - b = x * b)%R.
now apply t.
rewrite Hr2.
ring.
Qed.

Definition error_of_rel_pp := error_of_rel_generic mul_pp_helper mul_pp.
Definition error_of_rel_po := error_of_rel_generic mul_po_helper mul_po.
Definition error_of_rel_pn := error_of_rel_generic mul_pn_helper mul_pn.
Definition error_of_rel_op := error_of_rel_generic mul_op_helper mul_op.
Definition error_of_rel_oo := error_of_rel_generic mul_oo_helper mul_oo.
Definition error_of_rel_on := error_of_rel_generic mul_on_helper mul_on.
Definition error_of_rel_np := error_of_rel_generic mul_np_helper mul_np.
Definition error_of_rel_no := error_of_rel_generic mul_no_helper mul_no.
Definition error_of_rel_nn := error_of_rel_generic mul_nn_helper mul_nn.

Definition rel_subset_helper (xi zi : FF) :=
 Fle2 (lower zi) (lower xi) &&
 Fle2 (upper xi) (upper zi).

Theorem rel_subset :
  forall x xr : R, forall xi zi : FF,
  REL x xr xi ->
  rel_subset_helper xi zi = true ->
  REL x xr zi.
Proof.
intros x xr xi zi (xe,(Hx1,Hx2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_correct in H1.
apply Fle2_correct in H2.
exists xe.
split.
apply IRsubset with (1 := H1) (2 := H2) (3 := Hx1).
exact Hx2.
Qed.

Definition intersect_rr_helper (xf yf : float2) (zi : FF) :=
  Fle2 (lower zi) (upper zi) &&
  Fle2 (lower zi) yf &&
  Fle2 xf (upper zi).

Theorem intersect_rr :
  forall z1 z2 : R, forall xi yi zi : FF,
  REL z1 z2 xi -> REL z1 z2 yi ->
  intersect_rr_helper (upper xi) (lower yi) zi = true ->
  REL z1 z2 zi.
Proof.
intros z1 z2 xi yi zi (xe,(Hx1,Hx2)) (ye,(Hy1,Hy2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_correct in H1.
apply Fle2_correct in H2.
apply Fle2_correct in H3.
case (Req_dec z2 0) ; intro.
exists (float2R (lower zi)).
split.
split.
apply Rle_refl.
exact H1.
rewrite Hx2.
rewrite H.
repeat rewrite Rmult_0_l.
apply refl_equal.
exists xe.
split.
split.
apply Rle_trans with (1 := H2).
replace xe with ye.
apply Hy1.
apply Rplus_eq_reg_l with 1%R.
apply Rmult_eq_reg_l with (2 := H).
now rewrite <- Hy2.
now apply Rle_trans with (2 := H3).
exact Hx2.
Qed.

Definition intersect_rr0_helper (xf yf : float2) (zi : FF) :=
  Flt2 xf yf &&
  Fneg0 (lower zi) &&
  Fpos0 (upper zi).

Theorem intersect_rr0 :
  forall z1 z2 : R, forall xi yi zi : FF,
  REL z1 z2 xi -> REL z1 z2 yi ->
  intersect_rr0_helper (upper xi) (lower yi) zi = true ->
  BND z2 zi.
Proof.
intros z1 z2 xi yi zi (xe,(Hx1,Hx2)) (ye,(Hy1,Hy2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Flt2_correct in H1.
apply Fneg0_correct in H2.
apply Fpos0_correct in H3.
destruct (Req_dec z2 0) as [Hz|Hz].
rewrite Hz.
now split.
elim (Rle_not_lt xe ye).
apply Req_le.
apply Rplus_eq_reg_l with 1%R.
apply Rmult_eq_reg_l with (2 := Hz).
now rewrite <- Hy2.
apply Rle_lt_trans with (1 := proj2 Hx1).
apply Rlt_le_trans with (2 := proj1 Hy1).
exact H1.
Qed.

Theorem absurd_intersect_rr :
  forall z1 z2 : R, forall xi yi : FF,
  REL z1 z2 xi -> REL z1 z2 yi -> NZR z2 ->
  Flt2 (upper xi) (lower yi) = true ->
  False.
Proof.
intros z1 z2 xi yi (xe,(Hx1,Hx2)) (ye,(Hy1,Hy2)) Hz Hb.
generalize (Flt2_correct _ _ Hb). clear Hb. intro H.
generalize (Rle_lt_trans _ _ _ (proj2 Hx1) H). clear H. intro H.
replace xe with ye in H.
generalize (Rlt_le_trans _ _ _ H (proj1 Hy1)). clear H. intro H.
elim (Rlt_irrefl _ H).
clear H.
apply sym_eq.
apply Rplus_eq_reg_l with 1%R.
apply Rmult_eq_reg_l with (2 := Hz).
now rewrite <- Hx2.
Qed.

Definition mul_rr_helper (xi yi zi : FF) :=
  Fle2_m1 (lower xi) &&
  Fle2_m1 (lower yi) &&
  Fle2 (lower zi) (Fplus2 (Fplus2 (lower xi) (lower yi))
                          (Fmult2 (lower xi) (lower yi))) &&
  Fle2 (Fplus2 (Fplus2 (upper xi) (upper yi))
               (Fmult2 (upper xi) (upper yi))) (upper zi).

Theorem mul_rr :
  forall x1 x2 y1 y2 : R, forall xi yi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi ->
  mul_rr_helper xi yi zi = true ->
  REL (x1 * y1) (x2 * y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi zi (xe,(Hx1,Hx2)) (ye,(Hy1,Hy2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H4).
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_m1_correct in H1.
apply Fle2_m1_correct in H2.
generalize (Fle2_correct _ _ H3).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H3. intro H3.
generalize (Fle2_correct _ _ H4).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H4. intro H4.
exists (xe + ye + xe * ye)%R.
split.
apply IRcompose with (1 := H1) (2 := H2) (3 := H3) (4 := H4) (5 := Hx1) (6 := Hy1).
rewrite Hx2.
rewrite Hy2.
ring.
Qed.

Definition div_rr_helper (xi yi zi : FF) :=
  Fle2_m1 (lower xi) &&
  Flt2_m1 (lower yi) &&
  Fle2 (upper xi) (Fplus2 (Fplus2 (lower yi) (upper zi))
                          (Fmult2 (lower yi) (upper zi))) &&
  Fle2 (Fplus2 (Fplus2 (upper yi) (lower zi))
               (Fmult2 (upper yi) (lower zi))) (lower xi).

Theorem div_rr :
  forall x1 x2 y1 y2 : R, forall xi yi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi -> NZR y2 ->
  div_rr_helper xi yi zi = true ->
  REL (x1 / y1) (x2 / y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi zi (xe,(Hx1,Hx2)) (ye,(Hy1,Hy2)) Hy4 Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H4).
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_m1_correct in H1.
apply Flt2_m1_correct in H2.
generalize (Fle2_correct _ _ H3).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H3. intro H3.
generalize (Fle2_correct _ _ H4).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H4. intro H4.
exists ((xe - ye) / (1 + ye))%R.
split.
apply IRcompose_inv with (1 := H1) (2 := H2) (3 := H4) (4 := H3) (5 := Hx1) (6 := Hy1).
rewrite Hx2.
rewrite Hy2.
field.
split.
apply Rgt_not_eq.
apply Rlt_le_trans with (2 := Rplus_le_compat_l R1 _ _ (proj1 Hy1)).
rewrite <- (Rplus_opp_r 1).
apply Rplus_lt_compat_l with (1 := H2).
exact Hy4.
Qed.

Definition inv_r_helper (xi zi : FF) :=
  Flt2_m1 (lower xi) &&
  Fpos0 (Fplus2 (Fplus2 (lower xi) (upper zi)) (Fmult2 (lower xi) (upper zi))) &&
  Fneg0 (Fplus2 (Fplus2 (upper xi) (lower zi)) (Fmult2 (upper xi) (lower zi))).

Theorem inv_r :
  forall x1 x2 y : R, forall xi zi : FF,
  REL x1 x2 xi -> NZR x2 ->
  inv_r_helper xi zi = true ->
  REL (y / x1) (y / x2) zi.
Proof.
intros x1 x2 y xi zi (xe,(Hx1,Hx2)) Hx3 Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Flt2_m1_correct in H1.
generalize (Fpos0_correct _ H2).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H2. intro H2.
generalize (Fneg0_correct _ H3).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H3. intro H3.
exists ((0 - xe) / (1 + xe))%R.
split.
apply IRcompose_inv with (xl := R0) (xu := R0) (2 := H1) (3 := H3) (4 := H2) (6 := Hx1).
apply Rge_le, Ropp_0_le_ge_contravar, Rle_0_1.
split ; apply Rle_refl.
rewrite Hx2.
field.
split.
apply Rgt_not_eq.
apply Rlt_le_trans with (2 := Rplus_le_compat_l R1 _ _ (proj1 Hx1)).
rewrite <- (Rplus_opp_r 1).
apply Rplus_lt_compat_l with (1 := H1).
exact Hx3.
Qed.

Theorem compose :
  forall x1 x2 y2 : R, forall xi yi zi : FF,
  REL x1 x2 xi -> REL x2 y2 yi ->
  mul_rr_helper xi yi zi = true ->
  REL x1 y2 zi.
Proof.
intros x1 x2 y2 xi yi zi (xe,(Hx1,Hx2)) (ye,(Hy1,Hy2)) Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H4).
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb,H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1,H2).
apply Fle2_m1_correct in H1.
apply Fle2_m1_correct in H2.
generalize (Fle2_correct _ _ H3).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H3. intro H3.
generalize (Fle2_correct _ _ H4).
repeat rewrite Fplus2_correct.
rewrite Fmult2_correct. clear H4. intro H4.
exists (xe + ye + xe * ye)%R.
split.
apply IRcompose with (1 := H1) (2 := H2) (3 := H3) (4 := H4) (5 := Hx1) (6 := Hy1).
rewrite Hx2.
rewrite Hy2.
ring.
Qed.

Theorem compose_swap :
  forall x y r1 r2 : R, forall xi yi zi : FF,
  REL x (y * r2) xi -> REL r1 (1 / r2) yi -> NZR r2 ->
  mul_rr_helper xi yi zi = true ->
  REL (x * r1) y zi.
Proof.
intros x y r1 r2 xi yi zi Hx Hy Hr Hb.
generalize (mul_rr _ _ _ _ _ _ _ Hx Hy Hb).
replace (y * r2 * (1 / r2))%R with y.
easy.
now field.
Qed.

Definition FImult2 (x : float2) (yi : FF) :=
  let (yl,yu) := yi in
  if Fpos0 x then makepairF (Fmult2 x yl) (Fmult2 x yu)
  else makepairF (Fmult2 x yu) (Fmult2 x yl).

Lemma FImult2_correct :
  forall (x : float2) yi y, BND y yi ->
  BND (x * y) (FImult2 x yi).
Proof.
intros x (yl,yu) y Hy.
unfold FImult2.
replace (Fpos0 x) with (Zle_bool 0 (Fnum x)) by now unfold Fpos0 ; case (Fnum x).
case Zle_bool_spec ; split ; simpl ; rewrite Fmult2_correct.
apply monotony_1p.
now apply Float_prop.F2R_ge_0.
apply Hy.
apply monotony_1p.
now apply Float_prop.F2R_ge_0.
apply Hy.
apply monotony_1n.
apply Float_prop.F2R_le_0.
now apply Zlt_le_weak.
apply Hy.
apply monotony_1n.
apply Float_prop.F2R_le_0.
now apply Zlt_le_weak.
apply Hy.
Qed.

Definition add_rr_helper (xi yi qi zi : FF) :=
  let xql := FImult2 (lower qi) xi in
  let xqu := FImult2 (upper qi) xi in
  let yql := FImult2 (Fminus2 (Float2 1 0) (lower qi)) yi in
  let yqu := FImult2 (Fminus2 (Float2 1 0) (upper qi)) yi in
  Fle2 (lower zi) (Fplus2 (lower xql) (lower yql)) &&
  Fle2 (lower zi) (Fplus2 (lower xqu) (lower yqu)) &&
  Fle2 (Fplus2 (upper xql) (upper yql)) (upper zi) &&
  Fle2 (Fplus2 (upper xqu) (upper yqu)) (upper zi).

Theorem add_rr :
  forall x1 x2 y1 y2 : R, forall xi yi qi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi -> BND (x2 / (x2 + y2)) qi -> NZR (x2 + y2) ->
  add_rr_helper xi yi qi zi = true ->
  REL (x1 + y1) (x2 + y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi qi zi (ex,(Hx1,Hx2)) (ey,(Hy1,Hy2)) Hq Zxy Hb.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb, H4).
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb, H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1, H2).
apply Fle2_correct in H1. rewrite Fplus2_correct in H1.
apply Fle2_correct in H2. rewrite Fplus2_correct in H2.
apply Fle2_correct in H3. rewrite Fplus2_correct in H3.
apply Fle2_correct in H4. rewrite Fplus2_correct in H4.
assert (H5 := FImult2_correct (lower qi) xi _ Hx1).
assert (H6 := FImult2_correct (upper qi) xi _ Hx1).
assert (H7 := FImult2_correct (Fminus2 (Float2 1 0) (lower qi)) yi _ Hy1).
assert (H8 := FImult2_correct (Fminus2 (Float2 1 0) (upper qi)) yi _ Hy1).
assert (H9 : float2R (Float2 1 0) = R1) by apply Rmult_1_r.
assert (Ha : (float2R (Fminus2 (Float2 1 0) (lower qi)) = 1 - lower qi)%R).
now rewrite Fminus2_correct, H9.
assert (Hb : (float2R (Fminus2 (Float2 1 0) (upper qi)) = 1 - upper qi)%R).
now rewrite Fminus2_correct, H9.
exists ((x1 + y1) / (x2 + y2) - 1)%R.
split.
2: now field.
rewrite Hx2, Hy2.
replace ((x2 * (1 + ex) + y2 * (1 + ey)) / (x2 + y2) - 1)%R with
  (ey + x2 / (x2 + y2) * (ex - ey))%R by now field.
unfold BND in Hq.
destruct (Rle_or_lt (ex - ey) 0) as [He|He].
split.
apply Rle_trans with (ey + upper qi * (ex - ey))%R.
replace (ey + upper qi * (ex - ey))%R with (upper qi * ex + (1 - upper qi) * ey)%R by ring.
apply Rle_trans with (1 := H2).
apply Rplus_le_compat.
apply H6.
rewrite <- Hb.
apply H8.
apply Rplus_le_compat_l.
now apply monotony_2n.
apply Rle_trans with (ey + lower qi * (ex - ey))%R.
apply Rplus_le_compat_l.
now apply monotony_2n.
replace (ey + lower qi * (ex - ey))%R with (lower qi * ex + (1 - lower qi) * ey)%R by ring.
apply Rle_trans with (2 := H3).
apply Rplus_le_compat.
apply H5.
rewrite <- Ha.
apply H7.
apply Rlt_le in He.
split.
apply Rle_trans with (ey + lower qi * (ex - ey))%R.
replace (ey + lower qi * (ex - ey))%R with (lower qi * ex + (1 - lower qi) * ey)%R by ring.
apply Rle_trans with (1 := H1).
apply Rplus_le_compat.
apply H5.
rewrite <- Ha.
apply H7.
apply Rplus_le_compat_l.
now apply monotony_2p.
apply Rle_trans with (ey + upper qi * (ex - ey))%R.
apply Rplus_le_compat_l.
now apply monotony_2p.
replace (ey + upper qi * (ex - ey))%R with (upper qi * ex + (1 - upper qi) * ey)%R by ring.
apply Rle_trans with (2 := H4).
apply Rplus_le_compat.
apply H6.
rewrite <- Hb.
apply H8.
Qed.

Theorem sub_rr :
  forall x1 x2 y1 y2 : R, forall xi yi qi zi : FF,
  REL x1 x2 xi -> REL y1 y2 yi -> BND (x2 / (x2 - y2)) qi -> NZR (x2 - y2) ->
  add_rr_helper xi yi qi zi = true ->
  REL (x1 - y1) (x2 - y2) zi.
Proof.
intros x1 x2 y1 y2 xi yi qi zi Hx (ey,(Hy1,Hy2)) Hq Zxy Hb.
apply add_rr with (1 := Hx) (3 := Hq) (4 := Zxy) (5 := Hb).
exists ey.
split.
exact Hy1.
rewrite Hy2.
ring.
Qed.

Definition mul_helper (xi yi zi : FF) :=
  let xly := FImult2 (lower xi) yi in
  let xuy := FImult2 (upper xi) yi in
  Fle2 (lower zi) (lower xly) &&
  Fle2 (lower zi) (lower xuy) &&
  Fle2 (upper xly) (upper zi) &&
  Fle2 (upper xuy) (upper zi).

Theorem bnd_div_of_rel_bnd_div :
  forall x1 x2 y : R, forall xi yi zi : FF,
  REL x1 x2 xi -> BND (x2 / y) yi -> NZR y ->
  mul_helper xi yi zi = true ->
  BND ((x1 - x2) / y) zi.
Proof.
intros x1 x2 y xi yi zi (ex,(Hx1,Hx2)) Hxy Zy Hb.
rewrite Hx2.
replace ((x2 * (1 + ex) - x2) / y)%R with (ex * (x2 / y))%R by now field.
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb, H4).
generalize (andb_prop _ _ Hb). clear Hb. intros (Hb, H3).
generalize (andb_prop _ _ Hb). clear Hb. intros (H1, H2).
apply Fle2_correct in H1.
apply Fle2_correct in H2.
apply Fle2_correct in H3.
apply Fle2_correct in H4.
assert (H5 := FImult2_correct (lower xi) yi _ Hxy).
assert (H6 := FImult2_correct (upper xi) yi _ Hxy).
destruct (Rle_or_lt 0 (x2 / y)) as [Hy|Hy].
split.
apply Rle_trans with (1 := H1).
apply Rle_trans with (1 := proj1 H5).
now apply monotony_2p.
apply Rle_trans with (2 := H4).
apply Rle_trans with (2 := proj2 H6).
now apply monotony_2p.
apply Rlt_le in Hy.
split.
apply Rle_trans with (1 := H2).
apply Rle_trans with (1 := proj1 H6).
now apply monotony_2n.
apply Rle_trans with (2 := H3).
apply Rle_trans with (2 := proj2 H5).
now apply monotony_2n.
Qed.


Require Import Crypto.Specific.Framework.RawCurveParameters.
Require Import Crypto.Util.LetIn.

(***
Modulus : 2^206 - 5
Base: 32
***)

Definition curve : CurveParameters :=
  {|
    sz := 7%nat;
    base := 32;
    bitwidth := 32;
    s := 2^206;
    c := [(1, 5)];
    carry_chains := None;

    a24 := None;
    coef_div_modulus := None;

    goldilocks := None;
    karatsuba := None;
    montgomery := true;
    freeze := Some false;
    ladderstep := false;

    mul_code := None;

    square_code := None;

    upper_bound_of_exponent_loose := None;
    upper_bound_of_exponent_tight := None;
    allowable_bit_widths := None;
    freeze_extra_allowable_bit_widths := None;
    modinv_fuel := None
  |}.

Ltac extra_prove_mul_eq _ := idtac.
Ltac extra_prove_square_eq _ := idtac.


Require Import Lists.List Lists.ListSet Vector Arith.PeanoNat AbstractRelation Tribool Common.

Module Type RC.
  Import Db.

  Inductive tm :=
  | cst     : BaseConst -> tm
  | null    : tm
  | pred    : forall n, (forall l : list BaseConst, length l = n -> bool) -> list tm -> tm
  | var     : nat -> tm
  | mktup   : list (Name * tm) -> tm
  | proj    : tm -> Name -> tm
  | tab     : Name -> tm
  | nil     : bool -> Scm -> tm      (* is set, schema *)
  | single  : bool -> tm -> tm       (* is_set *)
  | union   : tm -> tm -> tm
  | inters  : tm -> tm -> tm
  | diff    : tm -> tm -> tm
  | comprn  : tm -> tm -> tm
  | cwhere  : tm -> tm -> tm
  | dist    : tm -> tm
  | prom    : tm -> tm
  | empty   : bool -> tm -> tm

  | rctrue  : tm
  | rcfalse : tm
  | isnull  : tm -> tm
  | istrue  : tm -> tm
  | rcand   : tm -> tm -> tm
  | rcor    : tm -> tm -> tm
  | rcnot   : tm -> tm
  .

  Inductive j_var (a : Name) : Scm -> Prop :=
  | j_varhd   : forall s, ~ List.In a s -> j_var a (a::s)
  | j_varcons : forall b s, a <> b -> j_var a s -> j_var a (b::s).

  Inductive j_base (d : Db.D) : list Scm -> tm -> Prop :=
  | j_cst  : forall g c, j_base d g (cst c)
  | j_null : forall g, j_base d g null
  | j_proj : forall g t x s, j_tuple d g t s -> j_var x s -> j_base d g (proj t x)

  with j_tuple (d : Db.D) : list Scm -> tm -> Scm -> Prop :=
  | j_tmvar : forall g n s, List.nth_error g n = Some s -> j_tuple d g (var n) s
  | j_mktup : forall g bl,
      List.NoDup (List.map fst bl) ->
      (forall t, List.In t (List.map snd bl) -> j_base d g t)
      -> j_tuple d g (mktup bl) (List.map fst bl).

  Inductive j_cond (d : Db.D) : list Scm -> tm -> Prop :=
  | j_empty : forall g q b s, j_coll d g q b s -> j_cond d g (empty b q)
  | j_pred : forall g n p tl,
      (forall t, List.In t tl -> j_base d g t) -> length tl = n
      -> j_cond d g (pred n p tl)
  | j_true : forall g, j_cond d g rctrue
  | j_false : forall g, j_cond d g rcfalse
  | j_isnull : forall g t, j_base d g t -> j_cond d g (isnull t)
  | j_istrue : forall g c, j_cond d g c -> j_cond d g (istrue c)
  | j_and : forall g c1 c2, j_cond d g c1 -> j_cond d g c2 -> j_cond d g (rcand c1 c2)
  | j_or : forall g c1 c2, j_cond d g c1 -> j_cond d g c2 -> j_cond d g (rcor c1 c2)
  | j_not : forall g c, j_cond d g c -> j_cond d g (rcnot c)

  with j_coll (d : Db.D) : list Scm -> tm -> bool -> Scm -> Prop :=
  | j_tab : forall g x s, Db.db_schema d x = Some s -> j_coll d g (tab x) false s
  | j_nil : forall g b s, List.NoDup s -> j_coll d g (nil b s) b s
  | j_single : forall g b t s, j_tuple d g t s -> j_coll d g (single b t) b s
  | j_union : forall g q1 q2 b s, j_coll d g q1 b s -> j_coll d g q2 b s -> j_coll d g (union q1 q2) b s
  | j_inters : forall g q1 q2 b s , j_coll d g q1 b s -> j_coll d g q2 b s -> j_coll d g (inters q1 q2) b s
  | j_diff : forall g q1 q2 b s, j_coll d g q1 b s -> j_coll d g q2 b s -> j_coll d g (diff q1 q2) b s
  | j_comprn : forall g q1 q2 b s1 s2, j_coll d g q2 b s2 -> j_coll d (s2::g) q1 b s1 -> j_coll d g (comprn q1 q2) b s1
  | j_cwhere : forall g q s c b, j_coll d g q b s -> j_cond d g c -> j_coll d g (cwhere q c) b s
  | j_dist : forall g q s, j_coll d g q false s -> j_coll d g (dist q) true s
  | j_prom : forall g q s, j_coll d g q true s -> j_coll d g (prom q) false s.

  Fixpoint bigunion (b : bool) (s : Scm) (ql : list tm) : tm :=
    match ql with
    | List.nil => nil b s
    | q0::ql0 => union q0 (bigunion b s ql0)
    end.

  Fixpoint multi_comprn q ql : tm :=
    match ql with
    | List.nil => q
    | q0::ql0 => multi_comprn (comprn q q0) ql0
    end.

  Definition not_union t :=
    match t with
    | union _ _ => false
    | _ => true
    end.

  (* normal forms *)
  Inductive j_nbase (d : Db.D) : list Scm -> tm -> Prop :=
  | j_ncst  : forall g c, j_nbase d g (cst c)
  | j_nnull  : forall g, j_nbase d g null
  | j_nproj : forall g n x s, List.nth_error g n = Some s -> j_var x s -> j_nbase d g (proj (var n) x).

  Definition j_nbasel d g tl := forall t, List.In t tl -> j_nbase d g t.

  Inductive j_ntuple (d : Db.D) : list Scm -> tm -> Scm -> Prop :=
  | j_nmktup : forall g bl,
      List.NoDup (List.map fst bl) -> j_nbasel d g (List.map snd bl)
      -> j_ntuple d g (mktup bl) (List.map fst bl).

  Inductive j_ncond (d : Db.D) : list Scm -> tm -> Prop :=
  | j_nempty : forall g q b s, j_ncoll d g q b s -> j_ncond d g (empty b q)
  | j_npred : forall g n p tl,
      j_nbasel d g tl -> length tl = n
      -> j_ncond d g (pred n p tl)
  | j_ntrue : forall g, j_ncond d g rctrue
  | j_nfalse : forall g, j_ncond d g rcfalse
  | j_nisnull : forall g t, j_nbase d g t -> j_ncond d g (isnull t)
  | j_nistrue : forall g c, j_ncond d g c -> j_ncond d g (istrue c)
  | j_nand : forall g c1 c2, j_ncond d g c1 -> j_ncond d g c2 -> j_ncond d g (rcand c1 c2)
  | j_nor : forall g c1 c2, j_ncond d g c1 -> j_ncond d g c2 -> j_ncond d g (rcor c1 c2)
  | j_nnot : forall g c, j_ncond d g c -> j_ncond d g (rcnot c)

  with j_ncoll (d : Db.D) : list Scm -> tm -> bool -> Scm -> Prop :=
  | j_ncnil : forall g b s, List.NoDup s -> j_ncoll d g (nil b s) b s
  | j_ncdisjunct : forall g t b s, not_union t = true -> j_ndisjunct d g t b s -> j_ncoll d g t b s
  | j_ncunion : forall g t1 t2 b s,
      j_ndisjunct d g t1 b s ->
      j_ncoll d g t2 b s
      -> j_ncoll d g (union t1 t2) b s

  with j_ndisjunct (d : Db.D) : list Scm -> tm -> bool -> Scm -> Prop :=
  | j_nsingle : forall g b tup c,
      forall s, j_ntuple d g tup s -> j_ncond d g c
      -> j_ndisjunct d g (cwhere (single b tup) c) b s
  | j_ncomprn : forall g q1 q2,
      forall b s s2, j_ngen d g q2 b s2 -> j_ndisjunct d (s2::g) q1 b s
      -> j_ndisjunct d g (comprn q1 q2) b s

  with j_ngen (d : Db.D) : list Scm -> tm -> bool -> Scm -> Prop :=
  | j_ntab : forall g x s, Db.db_schema d x = Some s -> j_ngen d g (tab x) false s
  | j_nprom : forall g q s, j_ncoll d g q true s -> j_ngen d g (prom q) false s
  | j_nbagdiff : forall g q1 q2 s,
      j_ncoll d g q1 false s -> j_ncoll d g q2 false s
      -> j_ngen d g (diff q1 q2) false s
  | j_ndtab : forall g x s, Db.db_schema d x = Some s -> j_ngen d g (dist (tab x)) true s
  | j_nddiff : forall g q1 q2 s,
      j_ncoll d g q1 false s -> j_ncoll d g q2 false s
      -> j_ngen d g (dist (diff q1 q2)) true s
  .

  Scheme jnw_ind_mut := Induction for j_ncond      Sort Prop
  with jnc_ind_mut   := Induction for j_ncoll      Sort Prop
  with jnd_ind_mut   := Induction for j_ndisjunct  Sort Prop
  with jng_ind_mut   := Induction for j_ngen       Sort Prop.

  Combined Scheme j_norm_ind_mut from jnw_ind_mut, jnc_ind_mut, jnd_ind_mut, jng_ind_mut.

End RC.


Require Export pcf_subpo.

Set Implicit Arguments.
Unset Strict Implicit.

Unset Automatic Introduction.

Section PCFPO_representation.

(** a lot of notation to make things readable *)

Notation "'TY'" := PCF.TY.

Notation "'IP'" := (IO TY).
Notation "a '~>' b" := (PCF.arrow a b) (at level 69, right associativity).
(* Notation "a ~> b" := (Module_Hom a b) (at level 50).*)
(*Notation "a 'x' b" := (Prod_Mod _ a b) (at level 30).*)

Notation "a 'x' b" := (product (*C:= MOD _ _*) a b) (at level 30).

(* Notation "P ^ z" := (FIB_MOD _ z P). *)
Notation "P [ z ]" := (FIB_MOD _ z P) (at level 35).

(*Notation "P ''' s" := (DER_MOD _ _ s P ) (at level 25).*)
Notation "'d' P // s" := (DER_MOD _ _ s P) (at level 25).
(*Notation " '*' " := (Term (*C:=MOD _ _*)).*)
Notation "'*'" := (Term (C:=MOD _ SO)).
Notation "'Bool'" := PCF.Bool.
Notation "'Nat'" := PCF.Nat.

Notation "f 'X' g" := (product_mor (*C:= MOD _ _ *) _ f g)(at level 30).

Notation "'FM'" := (#(FIB_MOD _ _ )).
Notation "'FPB'":= (FIB_PB _ _ _ ).
Notation "'PRPB'":= (PROD_PB _ _ _ _ ).
Notation "'PBF'":= (PB_FIB _ _ _ ).
Notation "'PBM'":= (#(PB_MOD _ _ )).
Notation "'DM'":= (#(DER_MOD _ _ _ )).
Notation "'DPB'":= (DER_PB _ _ _ ).
Notation "y [* := z ]":= (IOsubstar z  y)(at level 55).
(** a monad is a representation if it is accompagnied by
    - a lot of morphisms of modules
    - beta-reduction
*)

Class PCFPO_rep_struct (P : Monad IP) := {
  App : forall r s, (P[r~>s]) x (P[r]) ---> P[s];
  Abs : forall r s, (d P // r)[s] ---> P[r ~> s];
  Rec : forall t, P[t ~> t] ---> P[t];
  ttt :  * ---> P[Bool];
  fff :  * ---> P[Bool];
  nats: forall m:nat, * ---> P[Nat];
  succ: * ---> P[Nat ~> Nat];
  zero : * ---> P[Nat ~> Bool];
  condN: * ---> P[Bool ~> Nat ~> Nat ~> Nat];
  condB: * ---> P[Bool ~> Bool ~> Bool ~> Bool];
  Bottom: forall t, * ---> P[t];

  beta: forall r s V y z,
        App r s V (Abs r s V y, z) <<  (*IPsubstar z _ y*) y[*:= z] ;

  propag_App1: forall r s V y y' z,
        y << y' -> App r s V (y,z) << App _ _ _ (y',z) ;

  propag_App2: forall r s V y z z',
        z << z' -> App r s V (y,z) << App _ _ _ (y,z') ;

  propag_Abs: forall r s V y y',
        y << y' -> Abs r s V y << Abs _ _ _ y' ;

  propag_Rec: forall s V y y',
        y << y' -> Rec s V y << Rec _ _ y'

(*
  these two are not necessary, since we are over PO

  beta_refl : forall r V (y : P V r), y << y ;

  beta_trans : forall r V (a b c : P V r),
          a << b -> b << c -> a << c
*)
}.

Record PCFPO_rep := {
  pcfpo_rep_monad :> Monad IP;
  pcfpo_rep_struct :> PCFPO_rep_struct pcfpo_rep_monad
}.

Existing Instance pcfpo_rep_struct.

(** morphisms of representations *)

Section PCFPO_rep_Hom.

Variables P R : PCFPO_rep.

Section Rep_Hom_Class.

Variable Sig : Monad_Hom P R.

Notation "'sig'":= (PbMod_ind_Hom Sig).

(** for the constants we need a special morphism of modules

    [* ---> (\Sigma * ) *]

    being the empty product  *)

Lemma id_Term_PB_struct:
   Module_Hom_struct (S:= Term (C:= MOD _ SO))  (T:=(PB_MOD Sig SO Term))
                 (fun r => id SO_TERM).
Proof.
  constructor.
  intros.
  rewrite idl.
  rewrite idr.
  apply hom_refl.
Qed.

Definition PBT : Term ---> (PB_MOD Sig SO Term) :=
      Build_Module_Hom id_Term_PB_struct.

(*
Notation "'FM'" := (!(FIB_MOD _ _ )).
Notation "'FPB'":= (FIB_PB _ _ _ ).
Notation "'PRPB'":= (PROD_PB _ _ _ _ ).
Notation "'PBF'":= (PB_FIB _ _ _ ).
Notation "'sig'":= (PbMod_ind_Hom Sig).
Notation "'PBM'":= (!(PB_MOD _ _ )).
Notation "'DM'":= (!(DER_MOD _ _ _ )).
Notation "'DPB'":= (DER_PB _ _ _ ).
*)

(** Sig : P -> R is a morphism of representations if it makes commute
    all these weird diagrams
*)

Class PCFPO_rep_Hom_struct := {
  App_Hom: forall r s,
        App r s ;; FM sig  ==
          (FM sig ;; FPB) X (FM sig ;; FPB);;
                   PRPB ;; PBM (App r s) ;; PBF        ;

  Abs_Hom: forall r s,
         Abs r s ;; FM sig ==
          FM (DM sig ;; DPB) ;; FPB ;; PBM (Abs r s) ;; PBF  ;

  Rec_Hom: forall t,
         Rec t ;; FM sig ==
            FM sig ;; FPB ;; PBM (Rec t) ;; PBF ;

  ttt_Hom: ttt ;; FM sig ==
          PBT ;; PBM ttt ;; PBF ;

  fff_Hom: fff ;; FM sig ==
          PBT ;; PBM fff ;; PBF ;

  nats_Hom : forall m,
         nats m ;; FM sig ==
            PBT ;; PBM (nats m) ;; PBF ;

  succ_Hom: succ ;; FM sig ==
          PBT ;; PBM succ ;; PBF  ;

  zero_Hom: zero ;; FM sig ==
          PBT ;; PBM zero ;; PBF  ;

  condN_Hom: condN ;; FM sig ==
          PBT ;; PBM condN ;; PBF  ;

  condB_Hom: condB ;; FM sig ==
          PBT ;; PBM condB ;; PBF ;

  Bottom_Hom: forall t,
          Bottom t ;; FM sig ==
          PBT ;; PBM (Bottom t) ;; PBF

}.

End Rep_Hom_Class.

(** the type of morphismes of representations P -> R *)

Record PCFPO_rep_Hom := {
  rep_Hom_monad :> Monad_Hom P R ;
  rep_Hom_monad_struct :> PCFPO_rep_Hom_struct rep_Hom_monad
}.

End PCFPO_rep_Hom.
(*Existing Instance MONAD_struct.*)
Existing Instance rep_Hom_monad_struct.

(** on our way to a category of representations:
    - an equality on morphisms of reps*)

(** two morphisms are equal if their monad homs are equal,
     proof of "equivalence relation" is more or less already done in
           Monad_Hom_equiv *)

(*
Definition eq_Rep (P R: PCFPO_rep) : relation (PCFPO_rep_Hom P R) :=
       fun a c => rep_Hom_monad a == rep_Hom_monad c.
*)

Lemma eq_Rep_equiv (P R: PCFPO_rep) :
     Equivalence (A:=PCFPO_rep_Hom P R)
         (fun a c => rep_Hom_monad a == rep_Hom_monad c).
Proof.
 intros P R.
 set (H:= Monad_Hom_equiv P R).
 destruct H as [Hr Hs Ht].
 constructor;
 simpl in *.
 unfold Reflexive; intros. apply Hr.
 unfold Symmetric; intros r s; apply Hs.
 unfold Transitive; intros r s t; apply Ht.
Qed.

Definition eq_Rep_oid (P R : PCFPO_rep) := Build_Setoid (eq_Rep_equiv P R).

(** Identity Representation *)

Lemma Rep_id_struct (P : PCFPO_rep) :
         PCFPO_rep_Hom_struct (Monad_Hom_id P).
Proof.
  intro P;
  unfold Monad_Hom_id.
  simpl.
  constructor;
  simpl;
  intros;
  try rewrite <- surjective_pairing;
  auto.
Qed.

Definition Rep_id (P: PCFPO_rep) := Build_PCFPO_rep_Hom (Rep_id_struct P).

(** Composition of Representations *)
Section Rep_comp.
Variables P Q R: PCFPO_rep.
Variable M: PCFPO_rep_Hom P Q.
Variable N: PCFPO_rep_Hom Q R.

Program Instance Rep_comp_struct :
      PCFPO_rep_Hom_struct (Monad_Hom_comp M N).
Next Obligation.
Proof.
  set (HM:=App_Hom (Sig := M)).
  set (HN:=App_Hom (Sig := N)).
  simpl in *.
  rewrite HM.
  rewrite HN.
  auto.
Qed.
Next Obligation.
  set (HM:=Abs_Hom (Sig := M)).
  set (HN:=Abs_Hom (Sig := N)).
  simpl in *.

  rewrite HM.
  rewrite HN.
  auto.
Qed.
Next Obligation.
  set (HM:=Rec_Hom (Sig := M)).
  set (HN:=Rec_Hom (Sig := N)).
  simpl in *.

  rewrite HM.
  rewrite HN.
  auto.
Qed.
Next Obligation.
  set (HM:=ttt_Hom (Sig := M)).
  set (HN:=ttt_Hom (Sig := N)).
  simpl in *.

  rewrite HM.
  rewrite HN.
  auto.
Qed.
Next Obligation.
  set (HM:=fff_Hom (Sig := M)).
  set (HN:=fff_Hom (Sig := N)).
  simpl in *.

  rewrite HM.
  rewrite HN.
  auto.
Qed.
Next Obligation.
  set (HM:=nats_Hom (Sig := M)).
  set (HN:=nats_Hom (Sig := N)).
  simpl in *.

  rewrite HM.
  rewrite HN.
  auto.
Qed.
Next Obligation.
  set (HM:=succ_Hom (Sig := M)).
  set (HN:=succ_Hom (Sig := N)).
  simpl in *.

  rewrite HM.
  rewrite HN.
  auto.
Qed.
Next Obligation.
  set (HM:=zero_Hom (Sig := M)).
  set (HN:=zero_Hom (Sig := N)).
  simpl in *.

  rewrite HM.
  rewrite HN.
  auto.
Qed.
Next Obligation.
  set (HM:=condN_Hom (Sig := M)).
  set (HN:=condN_Hom (Sig := N)).
  simpl in *.

  rewrite HM.
  rewrite HN.
  auto.
Qed.
Next Obligation.
  set (HM:=condB_Hom (Sig := M)).
  set (HN:=condB_Hom (Sig := N)).
  simpl in *.

  rewrite HM.
  rewrite HN.
  auto.
Qed.
Next Obligation.
  set (HM:=Bottom_Hom (Sig := M)).
  set (HN:=Bottom_Hom (Sig := N)).
  simpl in *.

  rewrite HM.
  rewrite HN.
  auto.
Qed.

Definition Rep_comp := Build_PCFPO_rep_Hom Rep_comp_struct.

End Rep_comp.

(** category of representations *)

Program Instance PCFPO_REP_struct : Cat (fun a c => PCFPO_rep_Hom a c) := {
  mor_oid a c := eq_Rep_oid a c;
  id a := Rep_id a;
  comp P Q R f g := Rep_comp f g
}.
Next Obligation.
Proof.
  unfold Proper in *; do 2 red.
  simpl.
  intros y z h y' z' h' e r t.
  rewrite h.
  rewrite h'.
  auto.
Qed.

Definition PCFPO_REP := Build_Category PCFPO_REP_struct.

End PCFPO_representation.

Existing Instance pcfpo_rep_struct.