Require Import Coq.omega.Omega.
Set Implicit Arguments.

Require Import Platform.AutoSep Coq.Arith.Arith.

(* usuful and safe hints *)
Local Hint Resolve bound_N_nat : N.
Hint Rewrite Npow2_nat : N.
Hint Rewrite natToWord_wordToNat : N.

(* ============================================================================
 * word to nat
 * ========================================================================= *)

Theorem wordToNat_inj : forall sz (x y:word sz),
                          wordToNat x = wordToNat y -> x = y.
  intros.
  apply (f_equal (natToWord sz)) in H.
  autorewrite with N in *.
  assumption.
Qed.

Theorem wordToNat_inj' : forall sz (x y:word sz), x <> y ->
                                                  wordToNat x <> wordToNat y.
  intros.
  contradict H.
  apply wordToNat_inj; assumption.
Qed.

(* ============================================================================
 * nat to word
 * ========================================================================= *)

Lemma natToWord_pow2' : forall(sz k:nat)(w:word sz),
                          natToWord sz (k * pow2 sz) ^+ w = w.
  induction k; intros; simpl.

  apply wplus_unit.

  rewrite natToWord_plus.
  rewrite <- wplus_assoc.
  rewrite natToWord_pow2.
  rewrite wplus_unit.
  apply IHk.
Qed.

Lemma natToWord_pow2_zero: forall sz n, $ (n * pow2 sz) = natToWord sz 0.
  intros.
  rewrite <- (wplus_unit $ (n * pow2 sz)).
  rewrite wplus_comm.
  apply natToWord_pow2'.
Qed.

Lemma natToWord_pow2_factor : forall (sz:nat)(w:word sz), exists n, forall k,
                                                                      (n < pow2 sz)%nat /\ w = natToWord sz (k * pow2 sz + n).
  intros.
  exists (wordToNat w).
  intro.
  split.
  apply (wordToNat_bound w).
  rewrite natToWord_plus.
  rewrite natToWord_pow2'.
  rewrite natToWord_wordToNat.
  reflexivity.
Qed.

Corollary word_eq_natToWord : forall (sz:nat)(w:word sz), exists n,
                                (n < pow2 sz)%nat /\ w = natToWord sz n.
intros.
generalize natToWord_pow2_factor; intro.
specialize (H sz w).
destruct H.
specialize (H 0).
destruct H.
simpl in H0.
exists x; auto.
Qed.

Lemma natToWord_inj' : forall sz a b, goodSize a -> goodSize b
                                      -> natToWord sz a <> $ b
                                      -> a <> b.
  intros; intro; subst; congruence.
Qed.

(* ============================================================================
 * nat to W
 * ========================================================================= *)

Transparent goodSize.

Lemma goodSize_natToW_wlt_lt : forall n m:nat, goodSize n -> goodSize m ->
                                               natToW n < natToW m -> (n < m)%nat.
  unfold goodSize, natToW.
  generalize dependent 32; intros; nomega.
Qed.

Corollary W_eq_natToW : forall(w:W), exists n, goodSize n /\ w = natToW n.
intros.
generalize word_eq_natToWord; intro.
specialize (H 32 w).
destruct H.
destruct H.
exists x.
unfold goodSize.
split; auto.
Qed.

Opaque goodSize.

Lemma wneg_natToW_pow2_minus : forall n:nat, goodSize n ->
                                             ^~ (natToW n) = natToW (pow2 32 - n).
  unfold wneg; intros.
  rewrite NToWord_nat.
  autorewrite with N; reflexivity.
Qed.

Lemma natToW_plus_pow2 : forall n : nat, natToW (pow2 32 + n) = $ n.
  unfold natToW; intros.
  rewrite natToWord_plus.
  rewrite natToWord_pow2.
  words.
Qed.

(* ============================================================================
 * destruct_word
   Turn word arithmetic into nat arithmetic.
 * ========================================================================= *)

Ltac destruct_word sz w n :=
  let H := fresh "W" in
  let Hub := fresh "Wub" in
  let Heq := fresh "Weq" in
  assert (H:exists w', (w' < pow2 sz)%nat /\ w = natToWord sz w') by
      apply word_eq_natToWord;
    elim H; clear H; intros n H; elim H; intros Hub Heq; rewrite Heq in *; clear H Heq w.

Ltac destruct_W w n :=
  let H := fresh "W" in
  let Hub := fresh "Wub" in
  let Heq := fresh "Weq" in
  assert (H:exists w', goodSize w' /\ w = natToW w') by
      apply W_eq_natToW;
    elim H; clear H; intros n H; elim H; intros Hub Heq; rewrite Heq in *; clear H Heq w.

Ltac destruct_words := repeat
                         match goal with
                           | w : W |- context[?w] =>
                             is_var w; let w' := fresh "w" in destruct_W w w'
                           | w : word 32 |- context[?w] =>
                             is_var w; let w' := fresh "w" in destruct_W w w'
                           | w : word ?sz |- context[?w] =>
                             is_var w; let w' := fresh "w" in destruct_word sz w w'
                         end.

(* ============================================================================
 * goodsize tactic
 * ========================================================================= *)

Ltac goodsize :=
  match goal with
    | |- (_ < pow2 32)%nat => apply goodSize_danger
    | _ => idtac
  end;
  match goal with
    | [ H: goodSize _ |- goodSize _ ]
      => solve [apply (goodSize_weaken _ _ H); auto; omega]
    | |- goodSize _ => solve [auto]
    | _ => omega
  end.

(* ============================================================================
 * roundTrip-related lemmas and roundtrip tactic
 * ========================================================================= *)

Corollary wordToNat_natToWord_idempotent_W : forall n,
                                               goodSize n ->
                                               wordToNat (natToW n) = n.
intros; apply wordToNat_natToWord_idempotent; auto.
Qed.
Hint Rewrite wordToNat_natToWord_idempotent_W using solve [goodsize] : N.

Corollary roundTrip : forall sz n : nat,
                        (n < pow2 sz)%nat -> wordToNat (natToWord sz n) = n.
intros; apply wordToNat_natToWord_idempotent; nomega.
Qed.
Hint Rewrite roundTrip using solve [eauto] : N.

Lemma natToW_wordToNat : forall w:W, natToW (wordToNat w) = w.
  intros; rewrite <- natToWord_wordToNat; auto.
Qed.
Hint Rewrite natToW_wordToNat : N.

Lemma wordToNat_wplus' : forall sz (x y: word sz),
                           (wordToNat x + wordToNat y < pow2 sz)%nat
                           -> wordToNat (x ^+ y) = wordToNat x + wordToNat y.
  intros.
  destruct_words.
  rewrite <- natToWord_plus.
  rewrite roundTrip; auto.
  pre_nomega; auto.
  rewrite wordToNat_natToWord_idempotent in * by nomega.
  rewrite wordToNat_natToWord_idempotent in * by nomega.
  auto.
Qed.

Corollary wordToNat_wplus'' : forall sz (x y: nat), (x + y < pow2 sz)%nat
                                                    -> wordToNat ($ x ^+ natToWord sz y) = x + y.
intros.
rewrite wordToNat_wplus' by nomega.
rewrite ! roundTrip; auto.
Qed.

Corollary wordToNat_wminus'' : forall sz (x y: nat), (x < pow2 sz)%nat
                                                     -> (y <= x)%nat
                                                     -> wordToNat ($ x ^- natToWord sz y) = x - y.
intros.
rewrite wordToNat_wminus by nomega.
rewrite ! roundTrip; auto.
Qed.

Lemma mult_S : forall x y, (x <= x * S y)%nat.
  intros; rewrite mult_comm; simpl; apply le_plus_l.
Qed.
Local Hint Resolve mult_S.

Local Hint Resolve mult_comm.

Corollary wordToNat_wmult_W : forall (x y: nat), goodSize (x * y)%nat
                                                 -> wordToNat (natToW x ^* natToW y) = x * y.
intros.
unfold natToW in *.
destruct x, y; simpl; auto.
assert (wordToNat (natToWord 32 0) = 0).
rewrite roundTrip by goodsize; auto.
rewrite wordToNat_wmult.
unfold natToW in *; rewrite H0; omega.
rewrite H0; simpl; goodsize.

assert (goodSize (S x)) by goodsize.
assert (goodSize (S y)).
{
  apply (goodSize_weaken _ _ H).
  rewrite mult_comm; auto.
}
rewrite wordToNat_wmult.
rewrite ! roundTrip by goodsize; simpl; omega.
rewrite ! roundTrip by goodsize; auto.
Qed.

(* ============================================================================
 * natToWord and operators
 * ========================================================================= *)

Lemma natToWord_mult : forall sz x y, natToWord sz (x * y)
                                      = natToWord _ x ^* natToWord _ y.
  unfold "^*", wordBin; intros.
  pre_nomega.
  rewrite <- Nat2N.inj_mul.
  rewrite NToWord_nat.
  pre_nomega.

  destruct (wordToNat_natToWord' sz x).
  rewrite <- H at 1.
  remember (wordToNat $ (x)) as x'.

  rewrite mult_plus_distr_r.
  rewrite natToWord_plus.
  replace (x0 * pow2 sz * y)%nat with ((x0 * y) * pow2 sz)%nat.
  rewrite natToWord_pow2_zero.
  rewrite <- natToWord_plus.
  rewrite plus_0_r.

  destruct (wordToNat_natToWord' sz y).
  rewrite <- H0 at 1.
  remember (wordToNat $ (y)) as y'.
  rewrite mult_plus_distr_l.
  rewrite natToWord_plus.
  replace (x' * (x1 * pow2 sz))%nat with ((x' * x1) * pow2 sz)%nat by apply mult_assoc_reverse.
  rewrite natToWord_pow2_zero.
  rewrite <- natToWord_plus; auto.

  rewrite 2 mult_assoc_reverse.
  f_equal.
  apply mult_comm.
Qed.

(* ============================================================================
 * simplification tactic
 * ========================================================================= *)

Ltac roundtrip :=
  pre_nomega; unfold natToW in *;
  repeat match goal with
           | _ => rewrite wordToNat_natToWord_idempotent_W in * by goodsize
           | _ => rewrite wordToNat_wminus'' in * by goodsize
           | _ => rewrite wordToNat_wminus in * by nomega
           | _ => rewrite wordToNat_wplus'' in * by goodsize
           | _ => rewrite wordToNat_wplus' in * by goodsize
           | _ => rewrite wordToNat_wmult_W in * by goodsize
           | _ => rewrite wordToNat_wmult in * by goodsize

           | H: _ |- _ => rewrite <- natToW_minus in H by omega; unfold natToW in H
           | H: _ |- _ => rewrite <- natToWord_plus in H
           | H: _ |- _ => rewrite <- natToWord_mult in H
           | H: natToWord ?sz _ = natToWord ?sz _ |- _
             => apply natToWord_inj with sz _ _ in H; try goodsize
           | H: not (natToWord ?sz _ = natToWord ?sz _) |- _
             => apply natToWord_inj' with sz _ _ in H; try goodsize
         end.

(* ============================================================================
 * word equality lemmas
 * ========================================================================= *)

Definition eq_W_dec : forall x y : W, { x = y } + { x <> y }.
  intros.
  destruct (Word.weqb x y) eqn:Heq; [apply weqb_sound in Heq | ]; auto.
  right; intro.
  apply weqb_true_iff in H; congruence.
Qed.

Lemma weqb_false_iff : forall sz (x y : word sz), Word.weqb x y = false <-> x <> y.
  intros.
  split; intros.
  intro Eq; apply weqb_true_iff in Eq; congruence.
  case_eq (Word.weqb x y); intro; auto.
  apply weqb_sound in H0; congruence.
Qed.

Lemma weqb_refl : forall w, weqb w w = true.
  intros; apply weqb_true_iff; auto.
Qed.
Hint Rewrite weqb_refl : N.

Lemma weqb_refl' : forall x y, x = y -> weqb x y = true.
  intros; subst; autorewrite with N; auto.
Qed.
Hint Rewrite weqb_refl' using solve [auto; words] : N.

Lemma weqb_diff : forall w1 w2, w1 <> w2 -> weqb w1 w2 = false.
  intros; apply weqb_false_iff; auto.
Qed.
Hint Rewrite weqb_diff using solve [auto; discriminate] : N.

(* ============================================================================
 * word operators
 * ========================================================================= *)

Lemma wplus_unit_r : forall sz w, w ^+ natToWord sz 0 = w.
  intros; rewrite wplus_comm; rewrite wplus_unit; auto.
Qed.
Hint Rewrite wplus_unit wplus_unit_r : N.

Lemma wminus_unit : forall sz w, w ^- natToWord sz 0 = w.
  intros.
  unfold "^-", "^~".
  roundtrip.
  rewrite N.sub_0_r.
  rewrite NToWord_nat.
  roundtrip.
  rewrite natToWord_pow2.
  autorewrite with N; auto.
Qed.

Lemma wmult_zero : forall w, natToW 0 ^* w = natToW 0.
  auto.
Qed.

Lemma wmult_zero_r : forall w, w ^* natToW 0 = natToW 0.
  intros; roundtrip; rewrite wmult_comm; auto.
Qed.
Hint Rewrite wmult_zero wmult_zero_r : N.

(* ============================================================================
 * natToW and operators
 * ========================================================================= *)

Lemma natToW_S_wminus_1 : forall n, $ (S n) ^- $1 = natToW n.
  unfold natToW; intros.
  replace (S n) with (n + 1) by omega; rewrite natToWord_plus.
  words.
Qed.
Hint Rewrite natToW_S_wminus_1 : N.

(* ============================================================================
 * word inequalities
 * ========================================================================= *)

Lemma wle_wneq_wlt : forall i j:W, i <= j -> i <> j -> i < j.
  intros; destruct_words.
  apply wordToNat_inj' in H0.
  autorewrite with N in *; nomega.
Qed.

Lemma wle_wle_antisym : forall n m:W, n <= m -> m <= n -> n = m.
  intros; destruct_words; f_equal; nomega.
Qed.


Require Import UniMath.Foundations.All.
Require Import UniMath.MoreFoundations.All.

Require Import UniMath.CategoryTheory.Core.Categories.
Require Import UniMath.CategoryTheory.Core.Functors.

Require Import UniMath.CategoryTheory.DaggerCategories.Categories.

Local Open Scope cat.

Section DaggerFunctors.

  Definition is_dagger_functor {C D : category}
             (dagC : dagger C) (dagD : dagger D)
             (F : functor C D)
    : UU
    := ∏ (x y : C) (f : C⟦x,y⟧), #F (dagC _ _ f) = dagD _ _ (#F f).

  Identity Coercion is_dagger_functor_to_family_of_equalities
    : is_dagger_functor >-> Funclass.

  Lemma isaprop_is_dagger_functor
        {C D : category}
        (dagC : dagger C) (dagD : dagger D)
        (F : functor C D)
    : isaprop (is_dagger_functor dagC dagD F).
  Proof.
    repeat (apply impred_isaprop ; intro) ; apply homset_property.
  Qed.

  Definition dagger_functor_id
             {C : category} (dag : dagger C)
    : is_dagger_functor dag dag (functor_identity C).
  Proof.
    intro ; intros ; apply idpath.
  Qed.

  Definition is_dagger_functor_comp {C D E : category}
             {dagC : dagger C} {dagD : dagger D} {dagE : dagger E}
             {F : functor C D} {G : functor D E}
             (dF : is_dagger_functor dagC dagD F)
             (dG : is_dagger_functor dagD dagE G)
    : is_dagger_functor dagC dagE (functor_composite F G).
  Proof.
    intros x y f.
    refine (maponpaths #G (dF _ _ _) @ _).
    apply dG.
  Qed.

  Definition dagger_functor
             {C D : category}
             (dagC : dagger C) (dagD : dagger D)
    : UU
    := ∑ F : functor C D, is_dagger_functor dagC dagD F.

  Lemma dagger_functor_equality
        {C D : category}
        {dagC : dagger C} {dagD : dagger D}
        (F G : dagger_functor dagC dagD)
    : pr11 F = pr11 G -> F = G.
  Proof.
    intro p.
    use subtypePath.
    { intro ; apply isaprop_is_dagger_functor. }
    use (functor_eq _ _ (homset_property D)).
    exact p.
  Defined.

  Definition dagger_functor_to_functor
             {C D : category}
             {dagC : dagger C} {dagD : dagger D}
             (F : dagger_functor dagC dagD)
    : functor C D
    := pr1 F.
  Coercion dagger_functor_to_functor : dagger_functor >-> functor.

  Definition dagger_functor_to_is_dagger_functor
             {C D : category}
             {dagC : dagger C} {dagD : dagger D}
             (F : dagger_functor dagC dagD)
    : is_dagger_functor dagC dagD F
    := pr2 F.

  Definition make_dagger_functor
    {C D : category}
    {F : functor C D}
    {dagC : dagger C} {dagD : dagger D}
    (dagF : is_dagger_functor dagC dagD F)
    : dagger_functor dagC dagD
    := F ,, dagF.

End DaggerFunctors.


From Undecidability Require Import SeparationLogic.MSL.
From Undecidability Require Import Shared.ListAutomation.
Import ListAutomationNotations.

(* Separation logic **)

(* Syntax **)

Inductive sp_form :=
| emp : sp_form                                    (* heap emptiness *)
| sand : sp_form -> sp_form -> sp_form               (* separating conjunction *)
| simp : sp_form -> sp_form -> sp_form               (* separating implication *)
| pointer : sp_term -> sp_term -> sp_term -> sp_form  (* strict binary pointer *)
| equality : sp_term -> sp_term -> sp_form
| bot : sp_form
| imp : sp_form -> sp_form -> sp_form
| and : sp_form -> sp_form -> sp_form
| or : sp_form -> sp_form -> sp_form
| all : sp_form -> sp_form
| ex : sp_form -> sp_form.

(* Semantics **)

Definition disjoint (h h' : heap) :=
  ~ exists l p p', (l, p) el h /\ (l, p') el h'.

Definition equiv (h h' : heap) :=
  h <<= h' /\ h' <<= h.

Fixpoint sp_sat (s : stack) (h : heap) (P : sp_form) :=
  match P with
  | pointer E E1 E2 => exists l, sp_eval s E = Some l /\ h = [(l, (sp_eval s E1, sp_eval s E2))]
  | equality E1 E2 => sp_eval s E1 = sp_eval s E2
  | bot => False
  | imp P1 P2 => sp_sat s h P1 -> sp_sat s h P2
  | and P1 P2 => sp_sat s h P1 /\ sp_sat s h P2
  | or P1 P2 => sp_sat s h P1 \/ sp_sat s h P2
  | all P => forall v, sp_sat (update_stack s v) h P
  | ex P => exists v, sp_sat (update_stack s v) h P
  | emp => h = nil
  | sand P1 P2 => exists h1 h2, equiv h (h1 ++ h2) /\ sp_sat s h1 P1 /\ sp_sat s h2 P2
  | simp P1 P2 => forall h', disjoint h h' -> sp_sat s h' P1 -> sp_sat s (h ++ h') P2
  end.

(* Satisfiability problem **)

Definition SLSAT (P : sp_form) :=
  exists s h, functional h /\ sp_sat s h P.


Load LFindLoad.
From lfind Require Import LFind.
Unset Printing Notations.
Set Printing Implicit.

Inductive natural : Type := Succ : natural -> natural |  Zero : natural.

Inductive lst : Type := Cons : natural -> lst -> lst |  Nil : lst.

Inductive tree : Type := Node : natural -> tree -> tree -> tree |  Leaf : tree.

Inductive Pair : Type := mkpair : natural -> natural -> Pair
with Zlst : Type := zcons : Pair -> Zlst -> Zlst |  znil : Zlst.

Fixpoint append (append_arg0 : lst) (append_arg1 : lst) : lst
           := match append_arg0, append_arg1 with
              | Nil, x => x
              | Cons x y, z => Cons x (append y z)
              end.

Fixpoint len (len_arg0 : lst) : natural
           := match len_arg0 with
              | Nil => Zero
              | Cons x y => Succ (len y)
              end.

Lemma lem : forall l1 l2 n, Succ (len (append l1 l2)) = len (append l1 (Cons n l2)).
Proof.
   induction l1.
   - intros. simpl. f_equal. apply IHl1.
   - intros. reflexivity.
Qed.

Lemma lem2 : forall l, len l = len (append l Nil).
Proof.
   induction l.
   - simpl. f_equal. apply IHl.
   - reflexivity.
Qed.

Theorem theorem0 : forall (x : lst) (y : lst), eq (len (append x y)) (len (append y x)).
Proof.
   induction x.
   - intros. simpl. rewrite IHx. apply lem.
   - intros. simpl. lfind. Admitted.


(****************************************************************************)
(*                                                                          *)
(*                                                                          *)
(*                        Solange Coupet-Grimal                             *)
(*                                                                          *)
(*                                                                          *)
(*           Laboratoire d'Informatique Fondamentale de Marseille           *)
(*                   CMI-Technopole de Chateau-Gombert                      *)
(*                       39, Rue F. Joliot Curie                            *)
(*                       13453 MARSEILLE Cedex 13                           *)
(*                    Solange.Coupet@cmi.univ-mrs.fr                        *)
(*                                                                          *)
(*                                                                          *)
(*                                Coq V7.0                                  *)
(*                                Juin 2002                                 *)
(*                                                                          *)
(****************************************************************************)
(*                                 ltl .v                                   *)
(****************************************************************************)

Section ltl.

Require Export Relations.

Set Implicit Arguments.
Unset Strict Implicit.

Variables (state : Set) (label : Set) (init_state : state -> Prop)
  (transition : label -> relation state) (fair : label -> Prop).

(**************************** transitions  **********************************)

Inductive step (s t : state) : Prop :=
    C_trans : forall a : label, transition a s t -> step s t.

Inductive enabled (r : relation state) (s : state) : Prop :=
    c_pos_trans : forall t : state, r s t -> enabled r s.

Inductive none_or_one_step (s : state) : state -> Prop :=
  | none : none_or_one_step s s
  | one : forall t : state, step s t -> none_or_one_step s t.

(********************************** Streams *********************************)

CoInductive stream : Set :=
    cons_str : state -> stream -> stream.

Definition head_str (str : stream) : state :=
  match str with
  | cons_str s _ => s
  end.

Definition tl_str (str : stream) : stream :=
  match str with
  | cons_str _ tl => tl
  end.

Definition stream_formula := stream -> Prop.

Definition state_formula := state -> Prop.

Definition state2stream_formula (P : state_formula) : stream_formula :=
  fun str => P (head_str str).

Definition and (P Q : stream_formula) : stream_formula :=
  fun str => P str /\ Q str.

Definition and_state (P Q : state_formula) : state_formula :=
  fun s => P s /\ Q s.

Definition leads_to (P Q : state_formula) : Prop :=
  forall s t : state, P s -> step s t -> Q t.

(****************************** LTL basic operators *************************)

Definition next (P : stream_formula) : stream_formula :=
  fun str => P (tl_str str).

CoInductive always (P : stream_formula) : stream -> Prop :=
    C_always :
      forall (s0 : state) (str : stream),
      P (cons_str s0 str) -> always P str -> always P (cons_str s0 str).

Definition trace : stream -> Prop :=
  always
    (fun str : stream =>
     none_or_one_step (head_str str) (head_str (tl_str str))).

Definition run (str : stream) : Prop :=
  init_state (head_str str) /\ trace str.

Inductive eventually (P : stream_formula) : stream -> Prop :=
  | ev_h : forall str : stream, P str -> eventually P str
  | ev_t :
      forall (s : state) (str : stream),
      eventually P str -> eventually P (cons_str s str).

Inductive until (P Q : stream_formula) : stream -> Prop :=
  | until_h : forall str : stream, Q str -> until P Q str
  | until_t :
      forall (s : state) (str : stream),
      P (cons_str s str) -> until P Q str -> until P Q (cons_str s str).

CoInductive unless (P Q : stream_formula) : stream -> Prop :=
  | unless_h : forall str : stream, Q str -> unless P Q str
  | unless_t :
      forall (s : state) (str : stream),
      P (cons_str s str) -> unless P Q str -> unless P Q (cons_str s str).

(****************************** LTL derived operators ***********************)

Definition infinitely_often (P : stream_formula) :
  stream -> Prop := always (eventually P).

Definition implies (P Q : stream_formula) : stream -> Prop :=
  always (fun str : stream => P str -> Q str).

Definition is_followed (P Q : stream_formula) (str : stream) : Prop :=
  P str -> eventually Q str.

Definition is_always_followed (P Q : stream_formula) :
  stream -> Prop := always (is_followed P Q).

Definition eventually_permanently (P : stream_formula) :
  stream -> Prop := eventually (always P).

Definition once_always (P Q : stream_formula) : stream -> Prop :=
  implies P (always Q).

Definition leads_to_via (P Q R : stream_formula) :
  stream -> Prop := implies P (until Q R).

Definition once_until (P Q : stream_formula) : stream -> Prop :=
  leads_to_via P P Q.

(********************************** Fairness ********************************)

Definition fairness (a : label) (str : stream) : Prop :=
  infinitely_often (state2stream_formula (enabled (transition a))) str ->
  eventually
    (fun str : stream => transition a (head_str str) (head_str (tl_str str)))
    str.

Inductive fair_step (s1 s2 : state) : Prop :=
    c_fstep :
      forall a : label, fair a -> transition a s1 s2 -> fair_step s1 s2.

Definition fairstr : stream -> Prop :=
  infinitely_often
    (fun str =>
     enabled fair_step (head_str str) ->
     fair_step (head_str str) (head_str (tl_str str))).

Definition strong_fairstr (str : stream) : Prop :=
  always
    (eventually
       (fun str' => fair_step (head_str str') (head_str (tl_str str')))) str.

(************************************  Safety *******************************)

Definition invariant (P : state_formula) : Prop := leads_to P P.

Definition safe (P : stream_formula) : Prop :=
  forall str : stream, run str -> always P str.

End ltl.


Theorem or_distributes_over_and : forall P Q R : Prop,
  P \/ (Q /\ R) <-> (P \/ Q) /\ (P \/ R).
Proof.
  intros.
  split.
  - intros.
    split.
    + destruct H.
      * left. apply H.
      * destruct H.
        right.
        apply H.
    + destruct H.
      * left. apply H.
      * destruct H.
        right.
        apply H0.
  - intros.
    destruct H.
    destruct H.
    + left. apply H.
    + destruct H0.
      * left.
        apply H0.
      * right.
        split.
          apply H.
          apply H0.
Qed.


(*
Guido Salazar
Taller 4 Logica Computacional
09/10/2020
*)

(*Punto 1*)

(*1. Si el ejército marcha contra el enemigo, tiene posibilidades de éxito; y
arrasara la capital enemiga, si tiene posibilidades de éxito. El ejercito marcha
contra el enemigo o se repliega rápidamente. Si se repliega rápidamente,
el enemigo atacará su retaguardia; y perderá la guerra, si el enemigo ataca
su retaguardia. Por lo tanto, si no arrasa la capital enemiga, perderá la
guerra.*)

(*
p: El ejercito marcha contra el enemigo.
q: El ejercito tiene posibilidades de exito.
r: El ejercito arrasara la capital enemiga.
s: El enemigo ataca la retaguardia.
t: El ejercito Pierde la guerra.
u: El ejercito se repliega.
*)

Section punto1.

Variables P Q R S T U : Prop.
Hypothesis H : P -> Q.
Hypothesis H0 :Q -> R.
Hypothesis H1 : P \/ U.
Hypothesis H2 : U -> S.
Hypothesis H3 : S -> T.
Lemma punt1 : ~R -> T.
Proof.
intro.
apply H3.
apply H2.
destruct H1.
destruct H4.
apply H0.
apply H.
assumption.
assumption.
Qed.

End punto1.

(*punto 2*)

(*2. La física describe la naturaleza a base de observables clásicos o a base
de estados abstractos. Si la describe mediante los primeros, entonces nos
permite representar las cosas intuitivamente, pero nos exige renunciar a la
causalidad. En cambio, si la describe mediante los segundos, nos impide
la representación intuitiva, pero nos permite conservar la causalidad. La
física nos permitirá representar las cosas intuitivamente, a no ser que nos
exija renunciar a la causalidad. Por lo tanto, no es cierto que nos permita
representar las cosas intuitivamente sólo si no renuncia a la causalidad.*)

(*
p: La física describe la naturaleza a base de observables clásicos.
q: La física describe la naturaleza a base de estados abstractos.
r: La física nos permite representar las cosas intuitivamente
s: La física nos permite conservar la causalidad.
*)

Section punto2.

Variables P Q R S : Prop.
Hypothesis H : P \/ Q.
Hypothesis H0 : P -> (R /\ ~S).
Hypothesis H1 : Q -> (~R /\ S).
Hypothesis H2 : ~S -> R.
Lemma punt2 : ~~S -> ~R.
Proof.
intro.
apply H1.
destruct H.
destruct H3.
apply H0.
assumption.
assumption.
Qed.

End punto2.

(*Punto 3*)

(*3. Si Mariana estaba borracha, entonces Simón es el asesino o Mariana está
mintiendo. Simón es el asesino o Mariana no estaba borracha y el crimen
ocurrió después de la media noche. Si el crimen tuvo lugar después de
la media noche, entonces Simón es el asesino o Mariana Miente. Ademas
sabemos que Mariana no miente cuando está sobria.*)

(*
p: Mariana estaba borracha.
q: Simón es el asesino.
r: Mariana esta mintiendo
s: El crimen fue después la media noche
*)

Section punto3.

Variables P Q R S : Prop.
Hypothesis H : P -> (Q \/ R).
Hypothesis H0 : Q \/ (~P /\ S).
Hypothesis H1 : S -> (Q \/ R).
Hypothesis H2 : ~P -> ~R.
Lemma punt3 : Q.
Proof.
destruct H0.
assumption.
destruct H3.
destruct H1.
assumption.
assumption.
destruct H2.
assumption.
assumption.
Qed.

End punto3.

(*Punto 4*)

(*4. Sabemos que alguien en el equipo consumió drogas. Cuando le preguntamos a Sam,
dijo que Michael o Bill consumieron drogas, pero que no es posible que los dos.
En cambio Michael dijo que o Richard o Sam consumieron drogas, pero no ambos.
Pero si le preguntamos a Bill, el afirma que Michael y Matt son los más probables a consumir drogas,
pero no los dos. Richard por su parte cree que Bill o Matt consumieron drogas,
pero no los dos. Por último, Matt está seguro que Bill o Richard consumieron drogas,
pero no los dos. Entre todos, Tom es el único que dice que si Richard consumió drogas,
entonces Bill lo hizo también. En conclusión, Matt o Michael consumieron drogas.*)

(*
p: Michael consumio drogas.
q: Bill consumio drogas.
r: Richard consumio drogas.
s: Sam consumio drogas.
t: Matt consumio drogas.
*)

Section punto4.

Variables P Q R S T : Prop.
Hypothesis H : (P \/ Q) /\ ~(P /\ Q).
Hypothesis H0 : (R \/ S) /\ ~(R /\ S).
Hypothesis H1 : (P \/ T) /\ ~(P /\ T).
Hypothesis H2 : (Q \/ T) /\ ~(Q /\ T).
Hypothesis H3 : (Q \/ R) /\ ~(Q /\ R).
Hypothesis H4 : R -> Q.
Lemma punt4 : P \/ T.
Proof.
destruct H1.
assumption.
Qed.

End punto4.

(*Punto 5*)

(*5. Si el euro está fuerte, el petróleo está barato pero las exportaciones resultan caras.
Si Europa se endeuda o la economía no crece, el petróleo no estará barato.
La economáa crece si y sólo si ni las exportaciones resultan caras ni la inflación aumenta.
Por tanto, si la inflación aumenta, el euro no está fuerte.*)

(*
p: El euro está fuerte.
q: el petróleo está barato
r: las exportaciones estan caras.
s: Europa se endeuda
t: La economia crece
u: La inflación aumenta
*)

Section punto5.

Variables P Q R S T U: Prop.
Hypothesis H : P -> (Q /\ R).
Hypothesis H0 : (S \/ ~T) -> ~Q.
Hypothesis H1 : T <-> (~R /\ ~U).
Lemma punt5 : U -> ~P.
Proof.
unfold not.
intros.
destruct H.
assumption.
destruct H0.
right.
intro.
destruct H1.
destruct H7.
assumption.
contradiction.
assumption.
Qed.

End punto5.

(*Punto 6*)

(*Un bar tiene las siguientes reglas para sus miembros:
I. Todo miembro que no sea escoces tiene medias.
II. Todo miembro o usa falda o no usa medias.
III. Las personas casadas no van los domingos.
IV. Una persona va el domingo si y solamente si es escoces.
V. Toda persona que usa falda es escoces y esta casado.
VI. Todo escoces usa falda.
Se puede concluir entonces que a este bar no viene nadie.*)

(*
p: La persona es miembro
q: La persona es escoces
r: La persona tiene medias
s: La persona usa falda
t: la persona esta casada
u: la persona va el domingo
*)

Section punto6.

Variables P Q R S T U: Prop.
Hypothesis H : P /\ ~Q /\ R.
Hypothesis H0 : P -> (S \/ ~R).
Hypothesis H1 : T -> ~U.
Hypothesis H2 : U <-> Q.
Hypothesis H3 : S -> (Q /\ T).
Hypothesis H4 : Q -> S.
Lemma punt6 : False.
Proof.
destruct H2.
destruct H.
destruct H8.
destruct H0.
assumption.
destruct H1.
apply H3.
assumption.
destruct H3.
assumption.
contradiction.
contradiction.
Qed.

End punto6.


(*
  Author(s):
    Andrej Dudenhefner (1)
  Affiliation(s):
    (1) Saarland University, Saarbrücken, Germany
*)

(*
  Definition(s):
    Stack Machines with Exchange
*)

Require Import List.
Import ListNotations.
Require Import Relation_Operators.

Section SMX.
  Context {State Symbol : Set}.

  Definition Stack : Set := list Symbol.

  (* configuration: (left stack, right stack), state *)
  Definition Config : Set := Stack * Stack * State.

  (* instruction: vXw -> rYs
    if last parameter is true, then exchange stacks after operation *)
  Definition Instruction : Set := Config * Config * bool.

  (* simple stack machine: list of instructions *)
  Definition SMX : Set := list Instruction.

  Inductive step (M : SMX) : Config -> Config -> Prop :=
    | transition (v w r s r' s': Stack) (x y: State) (b: bool) :
      In ((r, s, x), (r', s', y), b) M ->
      step M (r ++ v, s ++ w, x)
        match b with
        | false => (r' ++ v, s' ++ w, y)
        | true => (s' ++ w, r' ++ v, y)
        end.

  (* step is functional *)
  Definition deterministic (M: SMX) := forall (X Y Z: Config), step M X Y -> step M X Z -> Y = Z.

  (* reflexive transitive closure of step *)
  Definition reachable (M: SMX) : Config -> Config -> Prop := clos_refl_trans Config (step M).

  (* uniform bound for the number of reachable configurations *)
  Definition bounded (M: SMX) (n: nat) : Prop :=
    forall (X: Config), exists (L: list Config), (forall (Y: Config), reachable M X Y -> In Y L) /\ length L <= n.

End SMX.


(**************************************************************************)
(*   Mechanised Framework for Local Interactions & Distributed Algorithms *)
(*   P. Courtieu, L. Rieg, X. Urbain                                      *)
(*   PACTOLE project                                                      *)
(*                                                                        *)
(*   This file is distributed under the terms of the CeCILL-C licence     *)
(*                                                                        *)
(**************************************************************************)

(**************************************************************************)
(**  Mechanised Framework for Local Interactions & Distributed Algorithms

     P. Courtieu, L. Rieg, X. Urbain

     PACTOLE project

     This file is distributed under the terms of the CeCILL-C licence
                                                                          *)
(**************************************************************************)

Require Import Lia.
Require Import Morphisms.
Require Import Rbase.
Require Import Psatz.
Require Import SetoidDec.
Require Import SetoidClass.
Require Import Pactole.Util.Coqlib.

(** **  Ratio  **)

(** A ratio (of some quantity), as a real number between [0] and [1]. *)
Definition ratio := {x : R | 0 <= x <= 1}%R.

Instance ratio_Setoid : Setoid ratio := sig_Setoid _.
Instance ratio_EqDec : EqDec ratio_Setoid := @sig_EqDec _ _ _ _.

Definition proj_ratio : ratio -> R := @proj1_sig _ _.

Instance proj_ratio_compat : Proper (equiv ==> equiv) proj_ratio.
Proof. intros ? ? Heq. apply Heq. Qed.

Coercion proj_ratio : ratio >-> R.

Lemma ratio_bounds : forall r : ratio, (0 <= r <= 1)%R.
Proof. intros [r Hr]. apply Hr. Qed.

(** Building rational ratios. *)
Lemma mk_ratio_proof : forall n m, 0 < m -> n <= m -> (0 <= INR n / INR m <= 1)%R.
Proof.
intros n m Hm Hn. apply le_INR in Hn. apply lt_0_INR in Hm. split.
+ apply Rdiv_le_0_compat; auto using pos_INR.
+ now apply Rdiv_le_1.
Qed.

(* Convenient notations.
   The first one is used to automatically provide the proofs, whereas the second one is used for display. *)
Definition mk_ratio n m Hm Hn : ratio := exist _ _ (mk_ratio_proof n m Hm Hn).
Notation "n '/r' m" := (mk_ratio n m ltac:(clear; abstract lia) ltac:(clear; abstract lia))
  (only parsing, at level 10).
Notation "n '/r' m" := (mk_ratio n m _ _) (at level 10, only printing).

(** 0 and 1 are ratios. *)
Definition ratio_0 : ratio.
Proof. refine (exist _ 0%R _). abstract lra. Defined.
Definition ratio_1 : ratio.
Proof. refine (exist _ 1%R _). abstract lra. Defined.

(** Addition between ratios *)
Definition add_ratio (r1 r2 : ratio) : ratio.
refine (if Rle_dec R1 (r1 + r2) then ratio_1
        else exist _ (r1 + r2)%R _).
Proof.
abstract (split; solve [ apply Rplus_le_le_0_compat; apply ratio_bounds
                       | now apply Rlt_le, Rnot_le_lt ]).
Defined.

Instance add_ratio_compat : Proper (equiv ==> equiv ==> equiv) add_ratio.
Proof. intros [] [] ? [] [] ?. unfold add_ratio. simpl in *. subst. destruct_match; reflexivity. Qed.

(** A strict ratio is a [ratio] that is neither [0] nor [1]. *)
Definition strict_ratio := {x : R | 0 < x < 1}%R.

Instance strict_ratio_Setoid : Setoid ratio := sig_Setoid _.
Instance strict_ratio_EqDec : EqDec strict_ratio_Setoid := @sig_EqDec _ _ _ _.

Definition proj_strict_ratio (x : strict_ratio) : ratio :=
  let '(exist _ v Hv) := x in
  exist _ v (conj (Rlt_le _ _ (proj1 Hv)) (Rlt_le _ _ (proj2 Hv))).

Instance proj_strict_ratio_compat : Proper (equiv ==> equiv) proj_strict_ratio.
Proof. intros [] [] Heq. apply Heq. Qed.

Coercion proj_strict_ratio : strict_ratio >-> ratio.

Lemma strict_ratio_bounds : forall r : strict_ratio, (0 < r < 1)%R.
Proof. intros [r Hr]. apply Hr. Qed.

Lemma mk_strict_ratio_proof : forall n m, 0 < n -> n < m -> (0 < INR n / INR m < 1)%R.
Proof.
intros n m Hm Hn. apply lt_INR in Hn. apply lt_0_INR in Hm. split.
+ apply Rdiv_lt_0_compat; eauto using Rlt_trans.
+ apply Rle_neq_lt.
  - apply Rdiv_le_1; lra.
  - intro Habs. eapply Rlt_not_eq; eauto; [].
    replace (INR n) with (INR n / INR m * INR m)%R by (field; lra).
    now rewrite Habs, Rmult_1_l.
Qed.

Definition mk_strict_ratio n m Hm Hn : strict_ratio := exist _ _ (mk_strict_ratio_proof n m Hm Hn).
Notation "n '/sr' m" := (mk_strict_ratio n m ltac:(clear; abstract lia) ltac:(clear; abstract lia))
  (only parsing, at level 10).
Notation "n '/sr' m" := (mk_strict_ratio n m _ _) (at level 10, only printing).

(** **  Trajectory  **)

(** Trajectories are paths inside the space. *)
(* FIXME: I should use typeclasses to avoid the explicit parameter T.
          Otherwise, path cannot be used as a target class for coercions. *)
Record path T `{Setoid T} := {
  path_f :> ratio -> T;
  path_compat :> Proper (equiv ==> equiv) path_f }.
Arguments path_f {T} {_} _ _.

Instance path_Setoid T {S : Setoid T} : Setoid (path T).
simple refine {| equiv := fun x y => path_f x == y |}; try apply fun_equiv; auto; [].
Proof. split.
+ intro. reflexivity.
+ intros ? ? ?. now symmetry.
+ intros ? ? ? ? ?. etransitivity; eauto.
Defined.

Instance path_full_compat {T} `(Setoid T): Proper (equiv ==> equiv ==> equiv) path_f.
Proof.
intros p p' Hp x y Hxy. transitivity (path_f p y).
- now apply path_compat.
- apply Hp.
Qed.

(** Given a function [f : T -> U] compatible with the space equivalences,
    we can lift paths on [T] into paths on [U]. *)
Definition lift_path {T U} `{Setoid T, Setoid U} (f : T -> U)
                     {Hf : Proper (equiv ==> equiv) f} (p : path T) : path U.
refine (Build_path _ _ (fun x => f (p x)) _).
Proof. intros x y Hxy. now apply Hf, path_compat. Defined.
Arguments lift_path T U _ _ f _ p /.

Instance lift_path_compat {T U} {HT : Setoid T} {HU : Setoid U} :
  forall f (Hf : Proper (equiv ==> equiv) f), Proper (equiv ==> equiv) (@lift_path T U HT HU f Hf).
Proof. repeat intro. simpl. auto. Qed.

Lemma lift_path_proof_irrelevant {T U} {HT : Setoid T} {HU : Setoid U} :
  forall f (Hf Hf' : Proper (equiv ==> equiv) f), @lift_path T U HT HU f Hf == @lift_path T U HT HU f Hf'.
Proof. now repeat intro. Qed.

Lemma lift_path_extensionality_compat {T U} {HT : Setoid T} {HU : Setoid U} :
  forall (f g : T -> U) (Hf : Proper (equiv ==> equiv) f) (Hg : Proper (equiv ==> equiv) g),
  (equiv ==> equiv)%signature f g ->
  (equiv ==> equiv)%signature (lift_path f) (lift_path g).
Proof. repeat intro. simpl. auto. Qed.


(************************************************************************)
(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2011     *)
(*   \VV/  **************************************************************)
(*    //   *      This file is distributed under the terms of the       *)
(*         *       GNU Lesser General Public License Version 2.1        *)
(************************************************************************)

(*i $Id: NewtonInt.v 14641 2011-11-06 11:59:10Z herbelin $ i*)

Require Import Rbase.
Require Import Rfunctions.
Require Import SeqSeries.
Require Import Rtrigo.
Require Import Ranalysis.
Open Local Scope R_scope.

(*******************************************)
(*            Newton's Integral            *)
(*******************************************)

Definition Newton_integrable (f:R -> R) (a b:R) : Type :=
  { g:R -> R | antiderivative f g a b \/ antiderivative f g b a }.

Definition NewtonInt (f:R -> R) (a b:R) (pr:Newton_integrable f a b) : R :=
  let (g,_) := pr in g b - g a.

(* If f is differentiable, then f' is Newton integrable (Tautology ?) *)
Lemma FTCN_step1 :
  forall (f:Differential) (a b:R),
    Newton_integrable (fun x:R => derive_pt f x (cond_diff f x)) a b.
Proof.
  intros f a b; unfold Newton_integrable in |- *; exists (d1 f);
    unfold antiderivative in |- *; intros; case (Rle_dec a b);
      intro;
        [ left; split; [ intros; exists (cond_diff f x); reflexivity | assumption ]
          | right; split;
            [ intros; exists (cond_diff f x); reflexivity | auto with real ] ].
Defined.

(* By definition, we have the Fondamental Theorem of Calculus *)
Lemma FTC_Newton :
  forall (f:Differential) (a b:R),
    NewtonInt (fun x:R => derive_pt f x (cond_diff f x)) a b
    (FTCN_step1 f a b) = f b - f a.
Proof.
  intros; unfold NewtonInt in |- *; reflexivity.
Qed.

(* $\int_a^a f$ exists forall a:R and f:R->R *)
Lemma NewtonInt_P1 : forall (f:R -> R) (a:R), Newton_integrable f a a.
Proof.
  intros f a; unfold Newton_integrable in |- *;
    exists (fct_cte (f a) * id)%F; left;
      unfold antiderivative in |- *; split.
  intros; assert (H1 : derivable_pt (fct_cte (f a) * id) x).
  apply derivable_pt_mult.
  apply derivable_pt_const.
  apply derivable_pt_id.
  exists H1; assert (H2 : x = a).
  elim H; intros; apply Rle_antisym; assumption.
  symmetry  in |- *; apply derive_pt_eq_0;
    replace (f x) with (0 * id x + fct_cte (f a) x * 1);
    [ apply (derivable_pt_lim_mult (fct_cte (f a)) id x);
      [ apply derivable_pt_lim_const | apply derivable_pt_lim_id ]
      | unfold id, fct_cte in |- *; rewrite H2; ring ].
  right; reflexivity.
Defined.

(* $\int_a^a f = 0$ *)
Lemma NewtonInt_P2 :
  forall (f:R -> R) (a:R), NewtonInt f a a (NewtonInt_P1 f a) = 0.
Proof.
  intros; unfold NewtonInt in |- *; simpl in |- *;
    unfold mult_fct, fct_cte, id in |- *; ring.
Qed.

(* If $\int_a^b f$ exists, then $\int_b^a f$ exists too *)
Lemma NewtonInt_P3 :
  forall (f:R -> R) (a b:R) (X:Newton_integrable f a b),
    Newton_integrable f b a.
Proof.
  unfold Newton_integrable in |- *; intros; elim X; intros g H;
    exists g; tauto.
Defined.

(* $\int_a^b f = -\int_b^a f$ *)
Lemma NewtonInt_P4 :
  forall (f:R -> R) (a b:R) (pr:Newton_integrable f a b),
    NewtonInt f a b pr = - NewtonInt f b a (NewtonInt_P3 f a b pr).
Proof.
  intros; unfold Newton_integrable in pr; elim pr; intros; elim p; intro.
  unfold NewtonInt in |- *;
    case
    (NewtonInt_P3 f a b
      (exist
        (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x
        p)).
  intros; elim o; intro.
  unfold antiderivative in H0; elim H0; intros; elim H2; intro.
  unfold antiderivative in H; elim H; intros;
    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)).
  rewrite H3; ring.
  assert (H1 := antiderivative_Ucte f x x0 a b H H0); elim H1; intros;
    unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
  assert (H3 : a <= a <= b).
  split; [ right; reflexivity | assumption ].
  assert (H4 : a <= b <= b).
  split; [ assumption | right; reflexivity ].
  assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring.
  unfold NewtonInt in |- *;
    case
    (NewtonInt_P3 f a b
      (exist
        (fun g:R -> R => antiderivative f g a b \/ antiderivative f g b a) x
        p)); intros; elim o; intro.
  assert (H1 := antiderivative_Ucte f x x0 b a H H0); elim H1; intros;
    unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
  assert (H3 : b <= a <= a).
  split; [ assumption | right; reflexivity ].
  assert (H4 : b <= b <= a).
  split; [ right; reflexivity | assumption ].
  assert (H5 := H2 _ H3); assert (H6 := H2 _ H4); rewrite H5; rewrite H6; ring.
  unfold antiderivative in H0; elim H0; intros; elim H2; intro.
  unfold antiderivative in H; elim H; intros;
    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3)).
  rewrite H3; ring.
Qed.

(* The set of Newton integrable functions is a vectorial space *)
Lemma NewtonInt_P5 :
  forall (f g:R -> R) (l a b:R),
    Newton_integrable f a b ->
    Newton_integrable g a b ->
    Newton_integrable (fun x:R => l * f x + g x) a b.
Proof.
  unfold Newton_integrable in |- *; intros f g l a b X X0;
    elim X; intros; elim X0; intros;
      exists (fun y:R => l * x y + x0 y).
  elim p; intro.
  elim p0; intro.
  left; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H;
    clear H; intros; elim H0; clear H0; intros H0 _.
  split.
  intros; elim (H _ H2); elim (H0 _ H2); intros.
  assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1).
  reg.
  exists H5; symmetry  in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity.
  assumption.
  unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro.
  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)).
  left; rewrite <- H5; unfold antiderivative in |- *; split.
  intros; elim H6; intros; assert (H9 : x1 = a).
  apply Rle_antisym; assumption.
  assert (H10 : a <= x1 <= b).
  split; right; [ symmetry  in |- *; assumption | rewrite <- H5; assumption ].
  assert (H11 : b <= x1 <= a).
  split; right; [ rewrite <- H5; symmetry  in |- *; assumption | assumption ].
  assert (H12 : derivable_pt x x1).
  unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H10); intros;
    eapply derive_pt_eq_1; symmetry  in |- *; apply H12.
  assert (H13 : derivable_pt x0 x1).
  unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H11); intros;
    eapply derive_pt_eq_1; symmetry  in |- *; apply H13.
  assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1).
  reg.
  exists H14; symmetry  in |- *; reg.
  assert (H15 : derive_pt x0 x1 H13 = g x1).
  elim (H1 _ H11); intros; rewrite H15; apply pr_nu.
  assert (H16 : derive_pt x x1 H12 = f x1).
  elim (H3 _ H10); intros; rewrite H16; apply pr_nu.
  rewrite H15; rewrite H16; ring.
  right; reflexivity.
  elim p0; intro.
  unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro.
  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)).
  left; rewrite H5; unfold antiderivative in |- *; split.
  intros; elim H6; intros; assert (H9 : x1 = a).
  apply Rle_antisym; assumption.
  assert (H10 : a <= x1 <= b).
  split; right; [ symmetry  in |- *; assumption | rewrite H5; assumption ].
  assert (H11 : b <= x1 <= a).
  split; right; [ rewrite H5; symmetry  in |- *; assumption | assumption ].
  assert (H12 : derivable_pt x x1).
  unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H11); intros;
    eapply derive_pt_eq_1; symmetry  in |- *; apply H12.
  assert (H13 : derivable_pt x0 x1).
  unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H10); intros;
    eapply derive_pt_eq_1; symmetry  in |- *; apply H13.
  assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1).
  reg.
  exists H14; symmetry  in |- *; reg.
  assert (H15 : derive_pt x0 x1 H13 = g x1).
  elim (H1 _ H10); intros; rewrite H15; apply pr_nu.
  assert (H16 : derive_pt x x1 H12 = f x1).
  elim (H3 _ H11); intros; rewrite H16; apply pr_nu.
  rewrite H15; rewrite H16; ring.
  right; reflexivity.
  right; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H;
    clear H; intros; elim H0; clear H0; intros H0 _; split.
  intros; elim (H _ H2); elim (H0 _ H2); intros.
  assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1).
  reg.
  exists H5; symmetry  in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity.
  assumption.
Defined.

(**********)
Lemma antiderivative_P1 :
  forall (f g F G:R -> R) (l a b:R),
    antiderivative f F a b ->
    antiderivative g G a b ->
    antiderivative (fun x:R => l * f x + g x) (fun x:R => l * F x + G x) a b.
Proof.
  unfold antiderivative in |- *; intros; elim H; elim H0; clear H H0; intros;
    split.
  intros; elim (H _ H3); elim (H1 _ H3); intros.
  assert (H6 : derivable_pt (fun x:R => l * F x + G x) x).
  reg.
  exists H6; symmetry  in |- *; reg; rewrite <- H4; rewrite <- H5; ring.
  assumption.
Qed.

(* $\int_a^b \lambda f + g = \lambda \int_a^b f + \int_a^b f *)
Lemma NewtonInt_P6 :
  forall (f g:R -> R) (l a b:R) (pr1:Newton_integrable f a b)
    (pr2:Newton_integrable g a b),
    NewtonInt (fun x:R => l * f x + g x) a b (NewtonInt_P5 f g l a b pr1 pr2) =
    l * NewtonInt f a b pr1 + NewtonInt g a b pr2.
Proof.
  intros f g l a b pr1 pr2; unfold NewtonInt in |- *;
    case (NewtonInt_P5 f g l a b pr1 pr2); intros; case pr1;
      intros; case pr2; intros; case (total_order_T a b);
        intro.
  elim s; intro.
  elim o; intro.
  elim o0; intro.
  elim o1; intro.
  assert (H2 := antiderivative_P1 f g x0 x1 l a b H0 H1);
    assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2);
      elim H3; intros; assert (H5 : a <= a <= b).
  split; [ right; reflexivity | left; assumption ].
  assert (H6 : a <= b <= b).
  split; [ left; assumption | right; reflexivity ].
  assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring.
  unfold antiderivative in H1; elim H1; intros;
    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 a0)).
  unfold antiderivative in H0; elim H0; intros;
    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
  unfold antiderivative in H; elim H; intros;
    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 a0)).
  rewrite b0; ring.
  elim o; intro.
  unfold antiderivative in H; elim H; intros;
    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r)).
  elim o0; intro.
  unfold antiderivative in H0; elim H0; intros;
    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)).
  elim o1; intro.
  unfold antiderivative in H1; elim H1; intros;
    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 r)).
  assert (H2 := antiderivative_P1 f g x0 x1 l b a H0 H1);
    assert (H3 := antiderivative_Ucte _ _ _ _ _ H H2);
      elim H3; intros; assert (H5 : b <= a <= a).
  split; [ left; assumption | right; reflexivity ].
  assert (H6 : b <= b <= a).
  split; [ right; reflexivity | left; assumption ].
  assert (H7 := H4 _ H5); assert (H8 := H4 _ H6); rewrite H7; rewrite H8; ring.
Qed.

Lemma antiderivative_P2 :
  forall (f F0 F1:R -> R) (a b c:R),
    antiderivative f F0 a b ->
    antiderivative f F1 b c ->
    antiderivative f
    (fun x:R =>
      match Rle_dec x b with
        | left _ => F0 x
        | right _ => F1 x + (F0 b - F1 b)
      end) a c.
Proof.
  unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0;
    clear H0; intros; split.
  2: apply Rle_trans with b; assumption.
  intros; elim H3; clear H3; intros; case (total_order_T x b); intro.
  elim s; intro.
  assert (H5 : a <= x <= b).
  split; [ assumption | left; assumption ].
  assert (H6 := H _ H5); elim H6; clear H6; intros;
    assert
      (H7 :
        derivable_pt_lim
        (fun x:R =>
          match Rle_dec x b with
            | left _ => F0 x
            | right _ => F1 x + (F0 b - F1 b)
          end) x (f x)).
  unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F0 x x0 = f x).
  symmetry  in |- *; assumption.
  assert (H8 := derive_pt_eq_1 F0 x (f x) x0 H7); unfold derivable_pt_lim in H8;
    intros; elim (H8 _ H9); intros; set (D := Rmin x1 (b - x)).
  assert (H11 : 0 < D).
  unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - x)); intro.
  apply (cond_pos x1).
  apply Rlt_Rminus; assumption.
  exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
  case (Rle_dec (x + h) b); intro.
  apply H10.
  assumption.
  apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ].
  elim n; left; apply Rlt_le_trans with (x + D).
  apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h).
  apply RRle_abs.
  apply H13.
  apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
    rewrite Rplus_0_l; rewrite Rplus_comm; unfold D in |- *;
      apply Rmin_r.
  elim n; left; assumption.
  assert
    (H8 :
      derivable_pt
      (fun x:R =>
        match Rle_dec x b with
          | left _ => F0 x
          | right _ => F1 x + (F0 b - F1 b)
        end) x).
  unfold derivable_pt in |- *; exists (f x); apply H7.
  exists H8; symmetry  in |- *; apply derive_pt_eq_0; apply H7.
  assert (H5 : a <= x <= b).
  split; [ assumption | right; assumption ].
  assert (H6 : b <= x <= c).
  split; [ right; symmetry  in |- *; assumption | assumption ].
  elim (H _ H5); elim (H0 _ H6); intros; assert (H9 : derive_pt F0 x x1 = f x).
  symmetry  in |- *; assumption.
  assert (H10 : derive_pt F1 x x0 = f x).
  symmetry  in |- *; assumption.
  assert (H11 := derive_pt_eq_1 F0 x (f x) x1 H9);
    assert (H12 := derive_pt_eq_1 F1 x (f x) x0 H10);
      assert
        (H13 :
          derivable_pt_lim
          (fun x:R =>
            match Rle_dec x b with
              | left _ => F0 x
              | right _ => F1 x + (F0 b - F1 b)
            end) x (f x)).
  unfold derivable_pt_lim in |- *; unfold derivable_pt_lim in H11, H12; intros;
    elim (H11 _ H13); elim (H12 _ H13); intros; set (D := Rmin x2 x3);
      assert (H16 : 0 < D).
  unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x2 x3); intro.
  apply (cond_pos x2).
  apply (cond_pos x3).
  exists (mkposreal _ H16); intros; case (Rle_dec x b); intro.
  case (Rle_dec (x + h) b); intro.
  apply H15.
  assumption.
  apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_r ].
  replace (F1 (x + h) + (F0 b - F1 b) - F0 x) with (F1 (x + h) - F1 x).
  apply H14.
  assumption.
  apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ].
  rewrite b0; ring.
  elim n; right; assumption.
  assert
    (H14 :
      derivable_pt
      (fun x:R =>
        match Rle_dec x b with
          | left _ => F0 x
          | right _ => F1 x + (F0 b - F1 b)
        end) x).
  unfold derivable_pt in |- *; exists (f x); apply H13.
  exists H14; symmetry  in |- *; apply derive_pt_eq_0; apply H13.
  assert (H5 : b <= x <= c).
  split; [ left; assumption | assumption ].
  assert (H6 := H0 _ H5); elim H6; clear H6; intros;
    assert
      (H7 :
        derivable_pt_lim
        (fun x:R =>
          match Rle_dec x b with
            | left _ => F0 x
            | right _ => F1 x + (F0 b - F1 b)
          end) x (f x)).
  unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F1 x x0 = f x).
  symmetry  in |- *; assumption.
  assert (H8 := derive_pt_eq_1 F1 x (f x) x0 H7); unfold derivable_pt_lim in H8;
    intros; elim (H8 _ H9); intros; set (D := Rmin x1 (x - b));
      assert (H11 : 0 < D).
  unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (x - b)); intro.
  apply (cond_pos x1).
  apply Rlt_Rminus; assumption.
  exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)).
  case (Rle_dec (x + h) b); intro.
  cut (b < x + h).
  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)).
  apply Rplus_lt_reg_r with (- h - b); replace (- h - b + b) with (- h);
    [ idtac | ring ]; replace (- h - b + (x + h)) with (x - b);
    [ idtac | ring ]; apply Rle_lt_trans with (Rabs h).
  rewrite <- Rabs_Ropp; apply RRle_abs.
  apply Rlt_le_trans with D.
  apply H13.
  unfold D in |- *; apply Rmin_r.
  replace (F1 (x + h) + (F0 b - F1 b) - (F1 x + (F0 b - F1 b))) with
  (F1 (x + h) - F1 x); [ idtac | ring ]; apply H10.
  assumption.
  apply Rlt_le_trans with D.
  assumption.
  unfold D in |- *; apply Rmin_l.
  assert
    (H8 :
      derivable_pt
      (fun x:R =>
        match Rle_dec x b with
          | left _ => F0 x
          | right _ => F1 x + (F0 b - F1 b)
        end) x).
  unfold derivable_pt in |- *; exists (f x); apply H7.
  exists H8; symmetry  in |- *; apply derive_pt_eq_0; apply H7.
Qed.

Lemma antiderivative_P3 :
  forall (f F0 F1:R -> R) (a b c:R),
    antiderivative f F0 a b ->
    antiderivative f F1 c b ->
    antiderivative f F1 c a \/ antiderivative f F0 a c.
Proof.
  intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0;
    intros; case (total_order_T a c); intro.
  elim s; intro.
  right; unfold antiderivative in |- *; split.
  intros; apply H1; elim H3; intros; split;
    [ assumption | apply Rle_trans with c; assumption ].
  left; assumption.
  right; unfold antiderivative in |- *; split.
  intros; apply H1; elim H3; intros; split;
    [ assumption | apply Rle_trans with c; assumption ].
  right; assumption.
  left; unfold antiderivative in |- *; split.
  intros; apply H; elim H3; intros; split;
    [ assumption | apply Rle_trans with a; assumption ].
  left; assumption.
Qed.

Lemma antiderivative_P4 :
  forall (f F0 F1:R -> R) (a b c:R),
    antiderivative f F0 a b ->
    antiderivative f F1 a c ->
    antiderivative f F1 b c \/ antiderivative f F0 c b.
Proof.
  intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0;
    intros; case (total_order_T c b); intro.
  elim s; intro.
  right; unfold antiderivative in |- *; split.
  intros; apply H1; elim H3; intros; split;
    [ apply Rle_trans with c; assumption | assumption ].
  left; assumption.
  right; unfold antiderivative in |- *; split.
  intros; apply H1; elim H3; intros; split;
    [ apply Rle_trans with c; assumption | assumption ].
  right; assumption.
  left; unfold antiderivative in |- *; split.
  intros; apply H; elim H3; intros; split;
    [ apply Rle_trans with b; assumption | assumption ].
  left; assumption.
Qed.

Lemma NewtonInt_P7 :
  forall (f:R -> R) (a b c:R),
    a < b ->
    b < c ->
    Newton_integrable f a b ->
    Newton_integrable f b c -> Newton_integrable f a c.
Proof.
  unfold Newton_integrable in |- *; intros f a b c Hab Hbc X X0; elim X;
    clear X; intros F0 H0; elim X0; clear X0; intros F1 H1;
      set
        (g :=
          fun x:R =>
            match Rle_dec x b with
              | left _ => F0 x
              | right _ => F1 x + (F0 b - F1 b)
            end); exists g; left; unfold g in |- *;
        apply antiderivative_P2.
  elim H0; intro.
  assumption.
  unfold antiderivative in H; elim H; clear H; intros;
    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hab)).
  elim H1; intro.
  assumption.
  unfold antiderivative in H; elim H; clear H; intros;
    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hbc)).
Qed.

Lemma NewtonInt_P8 :
  forall (f:R -> R) (a b c:R),
    Newton_integrable f a b ->
    Newton_integrable f b c -> Newton_integrable f a c.
Proof.
  intros.
  elim X; intros F0 H0.
  elim X0; intros F1 H1.
  case (total_order_T a b); intro.
  elim s; intro.
  case (total_order_T b c); intro.
  elim s0; intro.
(* a<b & b<c *)
  unfold Newton_integrable in |- *;
    exists
      (fun x:R =>
        match Rle_dec x b with
          | left _ => F0 x
          | right _ => F1 x + (F0 b - F1 b)
        end).
  elim H0; intro.
  elim H1; intro.
  left; apply antiderivative_P2; assumption.
  unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a1)).
  unfold antiderivative in H; elim H; clear H; intros _ H.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
(* a<b & b=c *)
  rewrite b0 in X; apply X.
(* a<b & b>c *)
  case (total_order_T a c); intro.
  elim s0; intro.
  unfold Newton_integrable in |- *; exists F0.
  left.
  elim H1; intro.
  unfold antiderivative in H; elim H; clear H; intros _ H.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
  elim H0; intro.
  assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H).
  elim H3; intro.
  unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)).
  assumption.
  unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
  rewrite b0; apply NewtonInt_P1.
  unfold Newton_integrable in |- *; exists F1.
  right.
  elim H1; intro.
  unfold antiderivative in H; elim H; clear H; intros _ H.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
  elim H0; intro.
  assert (H3 := antiderivative_P3 f F0 F1 a b c H2 H).
  elim H3; intro.
  assumption.
  unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)).
  unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
(* a=b *)
  rewrite b0; apply X0.
  case (total_order_T b c); intro.
  elim s; intro.
(* a>b & b<c *)
  case (total_order_T a c); intro.
  elim s0; intro.
  unfold Newton_integrable in |- *; exists F1.
  left.
  elim H1; intro.
(*****************)
  elim H0; intro.
  unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)).
  assert (H3 := antiderivative_P4 f F0 F1 b a c H2 H).
  elim H3; intro.
  assumption.
  unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 a1)).
  unfold antiderivative in H; elim H; clear H; intros _ H.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
  rewrite b0; apply NewtonInt_P1.
  unfold Newton_integrable in |- *; exists F0.
  right.
  elim H0; intro.
  unfold antiderivative in H; elim H; clear H; intros _ H.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
  elim H1; intro.
  assert (H3 := antiderivative_P4 f F0 F1 b a c H H2).
  elim H3; intro.
  unfold antiderivative in H4; elim H4; clear H4; intros _ H4.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 r0)).
  assumption.
  unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
(* a>b & b=c *)
  rewrite b0 in X; apply X.
(* a>b & b>c *)
  assert (X1 := NewtonInt_P3 f a b X).
  assert (X2 := NewtonInt_P3 f b c X0).
  apply NewtonInt_P3.
  apply NewtonInt_P7 with b; assumption.
Defined.

(* Chasles' relation *)
Lemma NewtonInt_P9 :
  forall (f:R -> R) (a b c:R) (pr1:Newton_integrable f a b)
    (pr2:Newton_integrable f b c),
    NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2) =
    NewtonInt f a b pr1 + NewtonInt f b c pr2.
Proof.
  intros; unfold NewtonInt in |- *.
  case (NewtonInt_P8 f a b c pr1 pr2); intros.
  case pr1; intros.
  case pr2; intros.
  case (total_order_T a b); intro.
  elim s; intro.
  case (total_order_T b c); intro.
  elim s0; intro.
(* a<b & b<c *)
  elim o0; intro.
  elim o1; intro.
  elim o; intro.
  assert (H2 := antiderivative_P2 f x0 x1 a b c H H0).
  assert
    (H3 :=
      antiderivative_Ucte f x
      (fun x:R =>
        match Rle_dec x b with
          | left _ => x0 x
          | right _ => x1 x + (x0 b - x1 b)
        end) a c H1 H2).
  elim H3; intros.
  assert (H5 : a <= a <= c).
  split; [ right; reflexivity | left; apply Rlt_trans with b; assumption ].
  assert (H6 : a <= c <= c).
  split; [ left; apply Rlt_trans with b; assumption | right; reflexivity ].
  rewrite (H4 _ H5); rewrite (H4 _ H6).
  case (Rle_dec a b); intro.
  case (Rle_dec c b); intro.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a1)).
  ring.
  elim n; left; assumption.
  unfold antiderivative in H1; elim H1; clear H1; intros _ H1.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ a0 a1))).
  unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a1)).
  unfold antiderivative in H; elim H; clear H; intros _ H.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
(* a<b & b=c *)
  rewrite <- b0.
  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r.
  rewrite <- b0 in o.
  elim o0; intro.
  elim o; intro.
  assert (H1 := antiderivative_Ucte f x x0 a b H0 H).
  elim H1; intros.
  rewrite (H2 b).
  rewrite (H2 a).
  ring.
  split; [ right; reflexivity | left; assumption ].
  split; [ left; assumption | right; reflexivity ].
  unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
  unfold antiderivative in H; elim H; clear H; intros _ H.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
(* a<b & b>c *)
  elim o1; intro.
  unfold antiderivative in H; elim H; clear H; intros _ H.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
  elim o0; intro.
  elim o; intro.
  assert (H2 := antiderivative_P2 f x x1 a c b H1 H).
  assert (H3 := antiderivative_Ucte _ _ _ a b H0 H2).
  elim H3; intros.
  rewrite (H4 a).
  rewrite (H4 b).
  case (Rle_dec b c); intro.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)).
  case (Rle_dec a c); intro.
  ring.
  elim n0; unfold antiderivative in H1; elim H1; intros; assumption.
  split; [ left; assumption | right; reflexivity ].
  split; [ right; reflexivity | left; assumption ].
  assert (H2 := antiderivative_P2 _ _ _ _ _ _ H1 H0).
  assert (H3 := antiderivative_Ucte _ _ _ c b H H2).
  elim H3; intros.
  rewrite (H4 c).
  rewrite (H4 b).
  case (Rle_dec b a); intro.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a0)).
  case (Rle_dec c a); intro.
  ring.
  elim n0; unfold antiderivative in H1; elim H1; intros; assumption.
  split; [ left; assumption | right; reflexivity ].
  split; [ right; reflexivity | left; assumption ].
  unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
(* a=b *)
  rewrite b0 in o; rewrite b0.
  elim o; intro.
  elim o1; intro.
  assert (H1 := antiderivative_Ucte _ _ _ b c H H0).
  elim H1; intros.
  assert (H3 : b <= c).
  unfold antiderivative in H; elim H; intros; assumption.
  rewrite (H2 b).
  rewrite (H2 c).
  ring.
  split; [ assumption | right; reflexivity ].
  split; [ right; reflexivity | assumption ].
  assert (H1 : b = c).
  unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym;
    assumption.
  rewrite H1; ring.
  elim o1; intro.
  assert (H1 : b = c).
  unfold antiderivative in H, H0; elim H; elim H0; intros; apply Rle_antisym;
    assumption.
  rewrite H1; ring.
  assert (H1 := antiderivative_Ucte _ _ _ c b H H0).
  elim H1; intros.
  assert (H3 : c <= b).
  unfold antiderivative in H; elim H; intros; assumption.
  rewrite (H2 c).
  rewrite (H2 b).
  ring.
  split; [ assumption | right; reflexivity ].
  split; [ right; reflexivity | assumption ].
(* a>b & b<c *)
  case (total_order_T b c); intro.
  elim s; intro.
  elim o0; intro.
  unfold antiderivative in H; elim H; clear H; intros _ H.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
  elim o1; intro.
  elim o; intro.
  assert (H2 := antiderivative_P2 _ _ _ _ _ _ H H1).
  assert (H3 := antiderivative_Ucte _ _ _ b c H0 H2).
  elim H3; intros.
  rewrite (H4 b).
  rewrite (H4 c).
  case (Rle_dec b a); intro.
  case (Rle_dec c a); intro.
  assert (H5 : a = c).
  unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption.
  rewrite H5; ring.
  ring.
  elim n; left; assumption.
  split; [ left; assumption | right; reflexivity ].
  split; [ right; reflexivity | left; assumption ].
  assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H1).
  assert (H3 := antiderivative_Ucte _ _ _ b a H H2).
  elim H3; intros.
  rewrite (H4 a).
  rewrite (H4 b).
  case (Rle_dec b c); intro.
  case (Rle_dec a c); intro.
  assert (H5 : a = c).
  unfold antiderivative in H1; elim H1; intros; apply Rle_antisym; assumption.
  rewrite H5; ring.
  ring.
  elim n; left; assumption.
  split; [ right; reflexivity | left; assumption ].
  split; [ left; assumption | right; reflexivity ].
  unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
(* a>b & b=c *)
  rewrite <- b0.
  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r.
  rewrite <- b0 in o.
  elim o0; intro.
  unfold antiderivative in H; elim H; clear H; intros _ H.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
  elim o; intro.
  unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)).
  assert (H1 := antiderivative_Ucte f x x0 b a H0 H).
  elim H1; intros.
  rewrite (H2 b).
  rewrite (H2 a).
  ring.
  split; [ left; assumption | right; reflexivity ].
  split; [ right; reflexivity | left; assumption ].
(* a>b & b>c *)
  elim o0; intro.
  unfold antiderivative in H; elim H; clear H; intros _ H.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
  elim o1; intro.
  unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r0)).
  elim o; intro.
  unfold antiderivative in H1; elim H1; clear H1; intros _ H1.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ r0 r))).
  assert (H2 := antiderivative_P2 _ _ _ _ _ _ H0 H).
  assert (H3 := antiderivative_Ucte _ _ _ c a H1 H2).
  elim H3; intros.
  assert (H5 : c <= a).
  unfold antiderivative in H1; elim H1; intros; assumption.
  rewrite (H4 c).
  rewrite (H4 a).
  case (Rle_dec a b); intro.
  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r1 r)).
  case (Rle_dec c b); intro.
  ring.
  elim n0; left; assumption.
  split; [ assumption | right; reflexivity ].
  split; [ right; reflexivity | assumption ].
Qed.


(*|
##########################################
Church numerals and universe inconsistency
##########################################

:Link: https://stackoverflow.com/q/55091525
|*)

(*|
Question
********

In the following code, the statement ``add'_commut`` is accepted by
Coq but ``add_commut`` is rejected because of a universe
inconsistency.
|*)

Set Universe Polymorphism.

Definition nat : Type := forall (X : Type), X -> (X -> X) -> X.

Definition succ (n : nat) : nat := fun X z s => s (n X z s).

Definition add' (m n : nat) : nat := fun X z s => m X (n X z s) s.

Definition nat_rec (z : nat) (s : nat -> nat) (n : nat) : nat := n nat z s.

Definition add (m n : nat) : nat := nat_rec n succ m.

Definition equal (A : Type) (a : A) : A -> Type :=
  fun a' => forall (P : A -> Type), P a -> P a'.

Lemma add'_commut (m n : nat) : equal nat (add' m n) (add' n m).
Admitted.

Fail Lemma add_commut (m n : nat) : equal nat (add m n) (add n m). (* .unfold .fails *)

(*| How to make it go through? |*)

(*|
Answer
******

Church numerals only work if you turn on impredicative ``Set``, by
putting ``-arg -impredicative-set`` into your ``_CoqProject`` file or
using ``-impredicative-set`` command line option. Then define ``nat``
as:
|*)

Fail Definition nat : Set := forall (X : Set), X -> (X -> X) -> X. (* .fails *)

(*|
Impredicative ``Set`` allows ``nat`` to have exactly the same type
``Set`` which it quantifies over. Without impredicativity, ``nat``
must have a higher universe level than what it quantifies over,
although the levels are hidden from you until you get an error like in
the question.

Note that impredicative ``Set`` is `incompatible
<https://github.com/coq/coq/wiki/The-Logic-of-Coq>`__ with classical
logic.
|*)