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

Require Export CoRN.ftc.NthDerivative.

Opaque Min Max.

Section Intervals.

(** printing realline %\ensuremath{\RR}% #(-∞,+∞)# *)
(** printing openl %\ensuremath{(\cdot,+\infty)}% #(⋅,+∞)# *)
(** printing openr %\ensuremath{(-\infty,\cdot)}% #(-∞,⋅)# *)
(** printing closel %\ensuremath{[\cdot,+\infty)}% #[⋅,+∞)# *)
(** printing closer %\ensuremath{(-\infty,\cdot]}% #(-∞,⋅]# *)
(** printing olor %\ensuremath{(\cdot,\cdot)}% #(⋅,⋅)# *)
(** printing clor %\ensuremath{[\cdot,\cdot)}% #[⋅,⋅)# *)
(** printing olcr %\ensuremath{(\cdot,\cdot]}% #(⋅,⋅]# *)
(** printing clcr %\ensuremath{[\cdot,\cdot]}% #[⋅,⋅]# *)

(**
* Generalized Intervals

At this stage we have enough material to begin generalizing our
concepts in preparation for the fundamental theorem of calculus and
the definition of the main (non-polynomial) functions of analysis.

In order to define functions via power series (or any other kind of
series) we need to formalize a notion of convergence more general than
the one we already have on compact intervals.  This is necessary for
practical reasons: we want to define a single exponential function
with domain [IR], not several exponential functions defined on compact
intervals which we prove to be the same wherever their domains
overlap.  In a similar way, we want to define indefinite integrals on
infinite domains and not only on compact intervals.

Unfortunately, proceeding in a way analogous to how we defined the
concept of global continuity will lead us nowhere; the concept turns
out to be to general, and the behaviour on too small domains
(typically intervals [[a,a']] where [a [=] a'] is neither
provably true nor provably false) will be unsatisfactory.

There is a special family of sets, however, where this problems can be
avoided: intervals.  Intervals have some nice properties that allow us
to prove good results, namely the facts that if [a] and [b] are
elements of an interval [I] then so are [Min(a,b)] and
[Max(a,b)] (which is in general not true) and also the
compact interval [[a,b]] is included in [I].  Furthermore, all
intervals are characterized by simple, well defined predicates, and
the nonempty and proper concepts become very easy to define.

** Definitions and Basic Results

We define an inductive type of intervals with nine constructors,
corresponding to the nine basic types of intervals.  The reason why so
many constructors are needed is that we do not have a notion of real
line, for many reasons which we will not discuss here.  Also it seems
simple to directly define finite intervals than to define then later
as intersections of infinite intervals, as it would only mess things
up.

The compact interval which we will define here is obviously the same
that we have been working with all the way through; why, then, the
different formulation?  The reason is simple: if we had worked with
intervals from the beginning we would have had case definitions at
every spot, and our lemmas and proofs would have been very awkward.
Also, it seems more natural to characterize a compact interval by two
real numbers (and a proof) than as a particular case of a more general
concept which doesn't have an intuitive interpretation.  Finally, the
definitions we will make here will have the elegant consequence that
from this point on we can work with any kind of intervals in exactly
the same way.
*)

Inductive interval : Type :=
  | realline         : interval
  | openl      : IR -> interval
  | openr      : IR -> interval
  | closel     : IR -> interval
  | closer     : IR -> interval
  | olor : IR -> IR -> interval
  | olcr : IR -> IR -> interval
  | clor : IR -> IR -> interval
  | clcr : IR -> IR -> interval.

(**
To each interval a predicate (set) is assigned by the following map:
*)

Definition iprop (I : interval) (x : IR) : CProp :=
  match I with
  | realline => True
  | openr b  => x [<] b
  | openl a  => a [<] x
  | closer b => x [<=] b
  | closel a => a [<=] x
  | olor a b => a [<] x and x [<] b
  | olcr a b => a [<] x and x [<=] b
  | clor a b => a [<=] x and x [<] b
  | clcr a b => a [<=] x and x [<=] b
  end.

(* begin hide *)
Coercion iprop : interval >-> Funclass.
(* end hide *)

(**
This map is made into a coercion, so that intervals
%\emph{%#<i>#are%}%#</i># really subsets of reals.

We now define what it means for an interval to be nonvoid, proper,
finite and compact in the obvious way.
*)

Definition nonvoid (I : interval) : CProp :=
  match I with
  | realline => True
  | openr b  => True
  | openl a  => True
  | closer b => True
  | closel a => True
  | olor a b => a [<] b
  | olcr a b => a [<] b
  | clor a b => a [<] b
  | clcr a b => a [<=] b
  end.

Definition proper (I : interval) : CProp :=
  match I with
  | realline => True
  | openr b  => True
  | openl a  => True
  | closer b => True
  | closel a => True
  | olor a b => a [<] b
  | olcr a b => a [<] b
  | clor a b => a [<] b
  | clcr a b => a [<] b
  end.

Definition finite (I : interval) : CProp :=
  match I with
  | realline => False
  | openr b  => False
  | openl a  => False
  | closer b => False
  | closel a => False
  | olor a b => True
  | olcr a b => True
  | clor a b => True
  | clcr a b => True
  end.

Definition compact_ (I : interval) : CProp :=
  match I with
  | realline => False
  | openr b  => False
  | openl a  => False
  | closer b => False
  | closel a => False
  | olor a b => False
  | olcr a b => False
  | clor a b => False
  | clcr a b => a [<=] b
  end.

(** Finite intervals have a left end and a right end. *)

Definition left_end (I : interval) : finite I -> IR.
Proof.
 intro.
 destruct  I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; rename X into H.
         inversion H.
        inversion H.
       inversion H.
      inversion H.
     inversion H.
    apply c.
   apply c.
  apply c.
 apply c.
Defined.

Definition right_end (I : interval) : finite I -> IR.
Proof.
 intro.
 destruct  I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; rename X into H.
         inversion H.
        inversion H.
       inversion H.
      inversion H.
     inversion H.
    apply c0.
   apply c0.
  apply c0.
 apply c0.
Defined.

(**
Some trivia: compact intervals are finite; proper intervals are nonvoid; an interval is nonvoid iff it contains some point.
*)

Lemma compact_finite : forall I : interval, compact_ I -> finite I.
 intros; induction  I as [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; auto.
Qed.

Lemma proper_nonvoid : forall I : interval, proper I -> nonvoid I.
Proof.
 intro.
 elim I; simpl in |- *; intros; auto.
 apply less_leEq; auto.
Qed.

Lemma nonvoid_point : forall I : interval, nonvoid I -> {x : IR | I x}.
Proof.
 intro.
 destruct  I as [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try rename X into H.
         exists ZeroR; auto.
        exists (c[+][1]); apply less_plusOne.
       exists (c[-][1]); apply shift_minus_less; apply less_plusOne.
      exists c; apply leEq_reflexive.
     exists c; apply leEq_reflexive.
    exists (c[+] (c0[-]c) [/]TwoNZ); split.
     astepl (c[+][0]); apply plus_resp_less_lft.
     apply div_resp_pos.
      apply pos_two.
     apply shift_less_minus; astepl c; auto.
    rstepr (c[+] (c0[-]c)).
    apply plus_resp_less_lft.
    apply pos_div_two'.
    apply shift_less_minus; astepl c; auto.
   exists c0; split; auto; apply leEq_reflexive.
  exists c; split; auto; apply leEq_reflexive.
 exists c; split; [ apply leEq_reflexive | auto ].
Qed.

Lemma nonvoid_char : forall (I : interval) (x : IR), I x -> nonvoid I.
Proof.
 intro; induction I; simpl in |- *; intros x H; auto; inversion_clear H.
    apply less_transitive_unfolded with x; auto.
   apply less_leEq_trans with x; auto.
  apply leEq_less_trans with x; auto.
 apply leEq_transitive with x; auto.
Qed.

(**
For practical reasons it helps to define left end and right end of compact intervals.
*)

Definition Lend I (H : compact_ I) := left_end I (compact_finite I H).

Definition Rend I (H : compact_ I) := right_end I (compact_finite I H).

(** In a compact interval, the left end is always less than or equal
to the right end.
*)

Lemma Lend_leEq_Rend : forall I cI, Lend I cI [<=] Rend I cI.
Proof.
 intro; elim I; simpl in |- *; intros; try inversion cI; auto.
Qed.

(**
Some nice characterizations of inclusion:
*)

Lemma compact_included : forall a b Hab (I : interval),
 I a -> I b -> included (compact a b Hab) I.
Proof.
 induction I; red in |- *; simpl in |- *; intros X X0 x X1;
   try inversion_clear X; try inversion_clear X0; try inversion_clear X1.
         auto.
        apply less_leEq_trans with a; auto.
       apply leEq_less_trans with b; auto.
      apply leEq_transitive with a; auto.
     apply leEq_transitive with b; auto.
    split; [ apply less_leEq_trans with a | apply leEq_less_trans with b ]; auto.
   split; [ apply less_leEq_trans with a | apply leEq_transitive with b ]; auto.
  split; [ apply leEq_transitive with a | apply leEq_less_trans with b ]; auto.
 split; [ apply leEq_transitive with a | apply leEq_transitive with b ]; auto.
Qed.

(** This lemma is almost same as [compact_included] above, except
    that it gets rid of the hypothesis [Hab : a [<=] b] *)
Lemma interval_convex:
  forall (a b : IR) (I : interval),
    I a -> I b -> included (clcr a b) I.
Proof.
  intros ? ? ? Ha Hb. unfold included. intros x Hab.
  simpl in Hab. destruct Hab as [Hab Habr].
  destruct I; simpl in Ha, Hb; simpl; try (split; destruct Ha, Hb);
    eauto using leEq_less_trans, leEq_reflexive,
                less_leEq_trans, leEq_transitive.
Qed.

(** Classically, this is a trivial consequence of [interval_convex].
    However, a constructive proof seems to require a little more work*)
Lemma interval_Min:
  forall {a b : IR} {I : interval},
    I a -> I b -> I (Min a b).
Proof.
  intros ? ? ? Ha Hb.
  destruct I; simpl in Ha, Hb; simpl; try (split; destruct Ha, Hb);
    eauto using leEq_less_trans, leEq_reflexive,
                 leEq_transitive,
                Min_leEq_lft, less_Min, leEq_Min.
Qed.

Lemma interval_Max:
  forall {a b : IR} {I : interval},
    I a -> I b -> I (Max a b).
Proof.
  intros ? ? ? Ha Hb.
  destruct I; simpl in Ha, Hb; simpl; try (split; destruct Ha, Hb);
  eauto using less_leEq_trans, leEq_reflexive,
                leEq_transitive,
                lft_leEq_Max, Max_less, Max_leEq.
Qed.

Lemma included_interval' : forall (I : interval) x y z w, I x -> I y -> I z -> I w ->
 forall H, included (compact (Min x z) (Max y w) H) I.
Proof.
 intros I x y z w; induction I; simpl in |- *; intros X X0 X1 X2 H; red in |- *; intros t Ht;
   inversion_clear Ht; simpl in |- *; try inversion_clear X;
     try inversion_clear X0; try inversion_clear X1; try inversion_clear X2; try split.
            apply less_leEq_trans with (Min x z); try apply less_Min; auto.
           apply leEq_less_trans with (Max y w); try apply Max_less; auto.
          apply leEq_transitive with (Min x z); try apply leEq_Min; auto.
         apply leEq_transitive with (Max y w); try apply Max_leEq; auto.
        apply less_leEq_trans with (Min x z); try apply less_Min; auto.
       apply leEq_less_trans with (Max y w); try apply Max_less; auto.
      apply less_leEq_trans with (Min x z); try apply less_Min; auto.
     apply leEq_transitive with (Max y w); try apply Max_leEq; auto.
    apply leEq_transitive with (Min x z); try apply leEq_Min; auto.
   apply leEq_less_trans with (Max y w); try apply Max_less; auto.
  apply leEq_transitive with (Min x z); try apply leEq_Min; auto.
 apply leEq_transitive with (Max y w); try apply Max_leEq; auto.
Qed.

Lemma included_interval : forall (I : interval) x y, I x -> I y ->
 forall H, included (compact (Min x y) (Max x y) H) I.
Proof.
 intros; apply included_interval'; auto.
Qed.

(**
A weirder inclusion result.
*)

Lemma included3_interval : forall (I : interval) x y z Hxyz, I x -> I y -> I z ->
 included (compact (Min (Min x y) z) (Max (Max x y) z) Hxyz) I.
Proof.
 intros I x y z Hxyz H H0 H1.
 apply included_interval'; auto.
  apply (included_interval I x y H H0 (Min_leEq_Max _ _)).
  apply compact_inc_lft.
 apply (included_interval I x y H H0 (Min_leEq_Max _ _)).
 apply compact_inc_rht.
Qed.

(**
Finally, all intervals are characterized by well defined predicates.
*)

Lemma iprop_wd : forall I : interval, pred_wd _ I.
Proof.
 induction I; unfold iprop in |- *; red in |- *; intros x y X X0;
   try inversion_clear X; try inversion X0.
         auto.
        astepr x; auto.
       astepl x; auto.
      astepr x; auto.
     astepl x; auto.
    split.
     astepr x; auto.
    astepl x; auto.
   split.
    astepr x; auto.
   astepl x; auto.
  split.
   astepr x; auto.
  astepl x; auto.
 split.
  astepr x; auto.
 astepl x; auto.
Qed.

End Intervals.

Arguments Lend [I].
Arguments Rend [I].

Section Compact_Constructions.

Section Single_Compact_Interval.

(**
** Constructions with Compact Intervals

Several important constructions are now discussed.

We begin by defining the compact interval [[x,x]].

%\begin{convention}% Let [P:IR->CProp] be well defined, and [x:IR]
such that [P(x)] holds.
%\end{convention}%
*)

Variable P : IR -> CProp.
Hypothesis wdP : pred_wd IR P.
Variable x : IR.

Hypothesis Hx : P x.

Definition compact_single := Compact (leEq_reflexive _ x).

(**
This interval contains [x] and only (elements equal to) [x]; furthermore, for every (well-defined) [P], if $x\in P$#x∈P# then $[x,x]\subseteq P$#[x,x]⊆P#.
*)

Lemma compact_single_prop : compact_single x.
Proof.
 split; apply leEq_reflexive.
Qed.

Lemma compact_single_pt : forall y : IR, compact_single y -> x [=] y.
Proof.
 intros y H.
 inversion_clear H; apply leEq_imp_eq; auto.
Qed.

Lemma compact_single_inc : included compact_single P.
Proof.
 red in |- *; intros.
 apply wdP with x.
  auto.
 apply compact_single_pt; auto.
Qed.

End Single_Compact_Interval.

(**
The special case of intervals is worth singling out, as one of the hypothesis becomes a theorem.
*)

Definition compact_single_iprop I := compact_single_inc _ (iprop_wd I).

(**
Now for more interesting and important results.

Let [I] be a proper interval and [x] be a point of [I].  Then there is
a proper compact interval [[a,b]] such that $x\in[a,b]\subseteq
I$#x∈[a,b]⊆I#.
*)

Section Proper_Compact_with_One_or_Two_Points.

(* begin hide *)
Let cip1' : forall c x : IR, c [<=] x -> x[-] (x[-]c) [/]TwoNZ [<=] x.
Proof.
 intros.
 astepr (x[-][0]).
 unfold cg_minus at 1 3 in |- *; apply plus_resp_leEq_lft.
 apply inv_resp_leEq; apply shift_leEq_div.
  apply pos_two.
 apply shift_leEq_minus; rstepl c; auto.
Qed.

Let cip1'' : forall c x : IR, c [<] x -> x[-] (x[-]c) [/]TwoNZ [<] x.
Proof.
 intros.
 astepr (x[-][0]).
 unfold cg_minus at 1 3 in |- *; apply plus_resp_less_lft.
 apply inv_resp_less; apply shift_less_div.
  apply pos_two.
 apply shift_less_minus; rstepl c; auto.
Qed.

Let cip1''' : forall c0 x : IR, x [<=] c0 -> x [<=] x[+] (c0[-]x) [/]TwoNZ.
Proof.
 intros.
 astepl (x[+][0]).
 apply plus_resp_leEq_lft.
 apply shift_leEq_div.
  apply pos_two.
 apply shift_leEq_minus; rstepl x; auto.
Qed.

Let cip1'''' : forall c0 x : IR, x [<] c0 -> x [<] x[+] (c0[-]x) [/]TwoNZ.
Proof.
 intros.
 astepl (x[+][0]).
 apply plus_resp_less_lft.
 apply shift_less_div.
  apply pos_two.
 apply shift_less_minus; rstepl x; auto.
Qed.

Let cip2 :
  forall c x x0 : IR, c [<=] x -> x[-] (x[-]c) [/]TwoNZ [<=] x0 -> c [<=] x0.
Proof.
 intros.
 apply leEq_transitive with (c[+] (x[-]c) [/]TwoNZ).
  astepl (c[+][0]); apply plus_resp_leEq_lft.
  apply shift_leEq_div.
   apply pos_two.
  apply shift_leEq_minus; rstepl c; auto.
 eapply leEq_wdl.
  apply H0.
 rational.
Qed.

Let cip2' : forall c x x0 : IR, c [<] x -> x[-] (x[-]c) [/]TwoNZ [<=] x0 -> c [<] x0.
Proof.
 intros c x x0 H H0.
 apply less_leEq_trans with (c[+] (x[-]c) [/]TwoNZ).
  astepl (c[+][0]); apply plus_resp_less_lft.
  apply shift_less_div.
   apply pos_two.
  apply shift_less_minus; rstepl c; auto.
 eapply leEq_wdl.
  apply H0.
 rational.
Qed.

Let cip2'' :
  forall c x x0 : IR, c [<=] x -> x[-] (x[-]c) [/]TwoNZ [<] x0 -> c [<] x0.
Proof.
 intros c x x0 H H0.
 apply leEq_less_trans with (c[+] (x[-]c) [/]TwoNZ).
  astepl (c[+][0]); apply plus_resp_leEq_lft.
  apply shift_leEq_div.
   apply pos_two.
  apply shift_leEq_minus; rstepl c; auto.
 eapply less_wdl.
  apply H0.
 rational.
Qed.

Let cip2''' :
  forall c x x0 : IR, c [<] x -> x[-] (x[-]c) [/]TwoNZ [<] x0 -> c [<] x0.
Proof.
 intros c x x0 H H0.
 apply cip2'' with x.
  apply less_leEq; auto.
 auto.
Qed.

Let cip3 :
  forall c0 x x0 : IR, x [<=] c0 -> x0 [<=] x[+] (c0[-]x) [/]TwoNZ -> x0 [<=] c0.
Proof.
 intros c0 x x0 H H0.
 eapply leEq_transitive.
  apply H0.
 rstepl (c0[-] (c0[-]x) [/]TwoNZ).
 astepr (c0[-][0]); unfold cg_minus at 1 3 in |- *; apply plus_resp_leEq_lft.
 apply inv_resp_leEq.
 apply shift_leEq_div.
  apply pos_two.
 apply shift_leEq_minus; rstepl x; auto.
Qed.

Let cip3' :
  forall c0 x x0 : IR, x [<] c0 -> x0 [<=] x[+] (c0[-]x) [/]TwoNZ -> x0 [<] c0.
Proof.
 intros c0 x x0 H H0.
 eapply leEq_less_trans.
  apply H0.
 rstepl (c0[-] (c0[-]x) [/]TwoNZ).
 astepr (c0[-][0]); unfold cg_minus at 1 3 in |- *; apply plus_resp_less_lft.
 apply inv_resp_less.
 apply shift_less_div.
  apply pos_two.
 apply shift_less_minus; rstepl x; auto.
Qed.

Let cip3'' :
  forall c0 x x0 : IR, x [<=] c0 -> x0 [<] x[+] (c0[-]x) [/]TwoNZ -> x0 [<] c0.
Proof.
 intros c0 x x0 H H0.
 eapply less_leEq_trans.
  apply H0.
 rstepl (c0[-] (c0[-]x) [/]TwoNZ).
 astepr (c0[-][0]); unfold cg_minus at 1 3 in |- *; apply plus_resp_leEq_lft.
 apply inv_resp_leEq.
 apply shift_leEq_div.
  apply pos_two.
 apply shift_leEq_minus; rstepl x; auto.
Qed.

Let cip3''' :
  forall c0 x x0 : IR, x [<] c0 -> x0 [<] x[+] (c0[-]x) [/]TwoNZ -> x0 [<] c0.
Proof.
 intros c0 x x0 H H0.
 apply cip3'' with x; try apply less_leEq; auto.
Qed.
(* end hide *)

Definition compact_in_interval I (pI : proper I) x (Hx : I x) : interval.
Proof.
 intros; destruct  I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros.
         apply (clcr x (x[+][1])).
        apply (clcr x (x[+][1])).
       apply (clcr (x[-][1]) x).
      apply (clcr x (x[+][1])).
     apply (clcr (x[-][1]) x).
    apply (clcr (x[-] (x[-]c) [/]TwoNZ) (x[+] (c0[-]x) [/]TwoNZ)).
   apply (clcr (x[-] (x[-]c) [/]TwoNZ) (x[+] (c0[-]x) [/]TwoNZ)).
  apply (clcr (x[-] (x[-]c) [/]TwoNZ) (x[+] (c0[-]x) [/]TwoNZ)).
 apply (clcr c c0).
Defined.

Lemma compact_compact_in_interval : forall I pI x Hx,
 compact_ (compact_in_interval I pI x Hx).
Proof.
 intro.
 elim I; simpl in |- *; intros; try inversion_clear Hx; try apply ts; apply less_leEq.
         apply less_plusOne.
        apply less_plusOne.
       apply shift_minus_less; apply less_plusOne.
      apply less_plusOne.
     apply shift_minus_less; apply less_plusOne.
    eapply less_transitive_unfolded; [ apply cip1'' | apply cip1'''' ]; auto.
   eapply less_leEq_trans; [ apply cip1'' | apply cip1''' ]; auto.
  eapply leEq_less_trans; [ apply cip1' | apply cip1'''' ]; auto.
 auto.
Qed.

Lemma proper_compact_in_interval : forall I pI x Hx,
 proper (compact_in_interval I pI x Hx).
Proof.
 intro.
 elim I; simpl in |- *; intros; try inversion_clear Hx.
         apply less_plusOne.
        apply less_plusOne.
       apply shift_minus_less; apply less_plusOne.
      apply less_plusOne.
     apply shift_minus_less; apply less_plusOne.
    eapply less_transitive_unfolded; [ apply cip1'' | apply cip1'''' ]; auto.
   eapply less_leEq_trans; [ apply cip1'' | apply cip1''' ]; auto.
  eapply leEq_less_trans; [ apply cip1' | apply cip1'''' ]; auto.
 auto.
Qed.

Lemma proper_compact_in_interval' : forall I pI x Hx
 (H : compact_ (compact_in_interval I pI x Hx)), Lend H [<] Rend H.
Proof.
 do 4 intro.
 cut (proper (compact_in_interval I pI x Hx)).
  2: apply proper_compact_in_interval.
 elim (compact_in_interval I pI x Hx); intros; try inversion H.
 simpl in |- *; simpl in H; auto.
Qed.

Lemma included_compact_in_interval : forall I pI x Hx,
 included (compact_in_interval I pI x Hx) I.
Proof.
 induction I; simpl in |- *; intros X x X0; try inversion_clear Hx; red in |- *;
   simpl in |- *; intros x0 X1; try inversion_clear X; try inversion_clear X0;
     try inversion_clear X1; auto.
       apply less_leEq_trans with x; auto.
      apply leEq_less_trans with x; auto.
     apply leEq_transitive with x; auto.
    apply leEq_transitive with x; auto.
   split.
    apply cip2' with x; auto.
   apply cip3' with x; auto.
  split.
   apply cip2' with x; auto.
  apply cip3 with x; auto.
 split.
  apply cip2 with x; auto.
 apply cip3' with x; auto.
Qed.

Lemma iprop_compact_in_interval : forall I pI x Hx, compact_in_interval I pI x Hx x.
Proof.
 intro.
 elim I; simpl in |- *; intros; try inversion_clear Hx; split; auto; try apply leEq_reflexive.
         apply less_leEq; apply less_plusOne.
        apply less_leEq; apply less_plusOne.
       apply less_leEq; apply shift_minus_less; apply less_plusOne.
      apply less_leEq; apply less_plusOne.
     apply less_leEq; apply shift_minus_less; apply less_plusOne.
    apply less_leEq; apply cip1''; auto.
   apply less_leEq; apply cip1''''; auto.
  apply less_leEq; apply cip1''; auto.
 apply less_leEq; apply cip1''''; auto.
Qed.

Lemma iprop_compact_in_interval' : forall I pI x Hx
 (H : compact_ (compact_in_interval I pI x Hx)) H', compact (Lend H) (Rend H) H' x.
Proof.
 do 4 intro.
 cut (compact_in_interval I pI x Hx x).
  2: apply iprop_compact_in_interval.
 elim (compact_in_interval I pI x Hx); intros; try inversion H.
 simpl in |- *; auto.
Qed.

Lemma iprop_compact_in_interval_inc1 : forall I pI x Hx
 (H : compact_ (compact_in_interval I pI x Hx)) H',
 included (compact (Lend H) (Rend H) H') (compact_in_interval I pI x Hx).
Proof.
 do 4 intro.
 elim (compact_in_interval I pI x Hx); intros; try inversion H.
 unfold compact in |- *; simpl in |- *; Included.
Qed.

Lemma iprop_compact_in_interval_inc2 : forall I pI x Hx
 (H : compact_ (compact_in_interval I pI x Hx)) H',
 included (compact_in_interval I pI x Hx) (compact (Lend H) (Rend H) H').
Proof.
 do 4 intro.
 elim (compact_in_interval I pI x Hx); intros; try inversion H.
 unfold compact in |- *; simpl in |- *; Included.
Qed.

(**
If [x [=] y] then the construction yields the same interval whether we
use [x] or [y] in its definition.  This property is required at some
stage, which is why we formalized this result as a functional
definition rather than as an existential formula.
*)

Lemma compact_in_interval_wd1 : forall I pI x Hx y Hy
 (H : compact_ (compact_in_interval I pI x Hx))
 (H' : compact_ (compact_in_interval I pI y Hy)),
 x [=] y -> Lend H [=] Lend H'.
Proof.
 intro I; elim I; simpl in |- *; intros; algebra.
Qed.

Lemma compact_in_interval_wd2 : forall I pI x Hx y Hy
 (H : compact_ (compact_in_interval I pI x Hx))
 (H' : compact_ (compact_in_interval I pI y Hy)),
 x [=] y -> Rend H [=] Rend H'.
Proof.
 intro I; elim I; simpl in |- *; intros; algebra.
Qed.

(**
We can make an analogous construction for two points.
*)

Definition compact_in_interval2 I (pI : proper I) x y : I x -> I y -> interval.
Proof.
 intros.
 set (z1 := Min x y) in *.
 set (z2 := Max x y) in *.
 destruct  I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros.
         apply (clcr z1 (z2[+][1])).
        apply (clcr z1 (z2[+][1])).
       apply (clcr (z1[-][1]) z2).
      apply (clcr z1 (z2[+][1])).
     apply (clcr (z1[-][1]) z2).
    apply (clcr (z1[-] (z1[-]c) [/]TwoNZ) (z2[+] (c0[-]z2) [/]TwoNZ)).
   apply (clcr (z1[-] (z1[-]c) [/]TwoNZ) (z2[+] (c0[-]z2) [/]TwoNZ)).
  apply (clcr (z1[-] (z1[-]c) [/]TwoNZ) (z2[+] (c0[-]z2) [/]TwoNZ)).
 apply (clcr c c0).
Defined.

Lemma compact_compact_in_interval2 : forall I pI x y Hx Hy,
 compact_ (compact_in_interval2 I pI x y Hx Hy).
Proof.
 intro.
 elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy;
   try apply ts; apply less_leEq.
         apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ].
        apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ].
       apply shift_minus_less; apply leEq_less_trans with (Max x y);
         [ apply Min_leEq_Max | apply less_plusOne ].
      apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ].
     apply shift_minus_less; apply leEq_less_trans with (Max x y);
       [ apply Min_leEq_Max | apply less_plusOne ].
    eapply less_transitive_unfolded; [ apply cip1''
      | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ];
        try apply less_Min; try apply Max_less; auto.
   eapply less_leEq_trans; [ apply cip1''
     | eapply leEq_transitive; [ apply Min_leEq_Max | apply cip1''' ] ];
       try apply less_Min; try apply Max_leEq; auto.
  eapply leEq_less_trans; [ apply cip1'
    | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ];
      try apply leEq_Min; try apply Max_less; auto.
 auto.
Qed.

Lemma proper_compact_in_interval2 : forall I pI x y Hx Hy,
 proper (compact_in_interval2 I pI x y Hx Hy).
Proof.
 intro.
 elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy.
         apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ].
        apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ].
       apply shift_minus_less; apply leEq_less_trans with (Max x y);
         [ apply Min_leEq_Max | apply less_plusOne ].
      apply leEq_less_trans with (Max x y); [ apply Min_leEq_Max | apply less_plusOne ].
     apply shift_minus_less; apply leEq_less_trans with (Max x y);
       [ apply Min_leEq_Max | apply less_plusOne ].
    eapply less_transitive_unfolded; [ apply cip1''
      | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ];
        try apply less_Min; try apply Max_less; auto.
   eapply less_leEq_trans; [ apply cip1''
     | eapply leEq_transitive; [ apply Min_leEq_Max | apply cip1''' ] ];
       try apply less_Min; try apply Max_leEq; auto.
  eapply leEq_less_trans; [ apply cip1'
    | eapply leEq_less_trans; [ apply Min_leEq_Max | apply cip1'''' ] ];
      try apply leEq_Min; try apply Max_less; auto.
 auto.
Qed.

Lemma proper_compact_in_interval2' : forall I pI x y Hx Hy H,
 Lend (I:=compact_in_interval2 I pI x y Hx Hy) H [<]
   Rend (I:=compact_in_interval2 I pI x y Hx Hy) H.
Proof.
 do 6 intro.
 cut (proper (compact_in_interval2 I pI x y Hx Hy)).
  2: apply proper_compact_in_interval2.
 elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H.
 simpl in |- *; simpl in H; auto.
Qed.

Lemma included_compact_in_interval2 : forall I pI x y Hx Hy,
 included (compact_in_interval2 I pI x y Hx Hy) I.
Proof.
 induction I; simpl in |- *; intros; try inversion_clear Hx as (H,H0);
   try inversion_clear Hy as (H1,H2); red in |- *; simpl in |- *;
     intros x0 X; try inversion_clear X; auto.
       apply less_leEq_trans with (Min x y); try apply less_Min; auto.
      apply leEq_less_trans with (Max x y); try apply Max_less; auto.
     apply leEq_transitive with (Min x y); try apply leEq_Min; auto.
    apply leEq_transitive with (Max x y); try apply Max_leEq; auto.
   split.
    apply cip2' with (Min x y); try apply less_Min; auto.
   apply cip3' with (Max x y); try apply Max_less; auto.
  split.
   apply cip2' with (Min x y); try apply less_Min; auto.
  apply cip3 with (Max x y); try apply Max_leEq; auto.
 split.
  apply cip2 with (Min x y); try apply leEq_Min; auto.
 apply cip3' with (Max x y); try apply Max_less; auto.
Qed.

Lemma iprop_compact_in_interval2x : forall I pI x y Hx Hy,
 compact_in_interval2 I pI x y Hx Hy x.
Proof.
 intro.
 elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy;
   split; auto; try apply Min_leEq_lft; try apply lft_leEq_Max.
           apply less_leEq; apply leEq_less_trans with (Max x y); [ apply lft_leEq_Max | apply less_plusOne ].
          apply less_leEq; apply leEq_less_trans with (Max x y); [ apply lft_leEq_Max | apply less_plusOne ].
         apply less_leEq; apply shift_minus_less; apply leEq_less_trans with x;
           [ apply Min_leEq_lft | apply less_plusOne ].
        apply less_leEq; apply leEq_less_trans with (Max x y); [ apply lft_leEq_Max | apply less_plusOne ].
       apply less_leEq; apply shift_minus_less; apply leEq_less_trans with x;
         [ apply Min_leEq_lft | apply less_plusOne ].
      apply less_leEq; eapply less_leEq_trans; [ apply cip1'' | apply Min_leEq_lft ]; try apply less_Min;
        auto.
     apply less_leEq; apply leEq_less_trans with (Max x y);
       [ apply lft_leEq_Max | apply cip1'''' ]; try apply Max_less; auto.
    apply less_leEq; eapply less_leEq_trans; [ apply cip1'' | apply Min_leEq_lft ]; try apply less_Min;
      auto.
   apply leEq_transitive with (Max x y); [ apply lft_leEq_Max | apply cip1''' ];
     try apply Max_leEq; auto.
  eapply leEq_transitive; [ apply cip1' | apply Min_leEq_lft ]; try apply leEq_Min; auto.
 apply less_leEq; apply leEq_less_trans with (Max x y);
   [ apply lft_leEq_Max | apply cip1'''' ]; try apply Max_less; auto.
Qed.

Lemma iprop_compact_in_interval2y : forall I pI x y Hx Hy,
 compact_in_interval2 I pI x y Hx Hy y.
Proof.
 intro.
 elim I; simpl in |- *; intros; try inversion_clear Hx; try inversion_clear Hy;
   split; auto; try apply Min_leEq_rht; try apply rht_leEq_Max.
           apply less_leEq; apply leEq_less_trans with (Max x y); [ apply rht_leEq_Max | apply less_plusOne ].
          apply less_leEq; apply leEq_less_trans with (Max x y); [ apply rht_leEq_Max | apply less_plusOne ].
         apply less_leEq; apply shift_minus_less; apply leEq_less_trans with y;
           [ apply Min_leEq_rht | apply less_plusOne ].
        apply less_leEq; apply leEq_less_trans with (Max x y); [ apply rht_leEq_Max | apply less_plusOne ].
       apply less_leEq; apply shift_minus_less; apply leEq_less_trans with y;
         [ apply Min_leEq_rht | apply less_plusOne ].
      apply less_leEq; eapply less_leEq_trans; [ apply cip1'' | apply Min_leEq_rht ]; try apply less_Min;
        auto.
     apply less_leEq; apply leEq_less_trans with (Max x y);
       [ apply rht_leEq_Max | apply cip1'''' ]; try apply Max_less; auto.
    apply less_leEq; eapply less_leEq_trans; [ apply cip1'' | apply Min_leEq_rht ]; try apply less_Min;
      auto.
   apply leEq_transitive with (Max x y); [ apply rht_leEq_Max | apply cip1''' ];
     try apply Max_leEq; auto.
  eapply leEq_transitive; [ apply cip1' | apply Min_leEq_rht ]; try apply leEq_Min; auto.
 apply less_leEq; apply leEq_less_trans with (Max x y);
   [ apply rht_leEq_Max | apply cip1'''' ]; try apply Max_less; auto.
Qed.

Lemma iprop_compact_in_interval2x' : forall I pI x y Hx Hy
 (H : compact_ (compact_in_interval2 I pI x y Hx Hy)) H',
 compact (Lend H) (Rend H) H' x.
Proof.
 do 6 intro.
 cut (compact_in_interval2 I pI x y Hx Hy x).
  2: apply iprop_compact_in_interval2x.
 elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H.
 simpl in |- *; auto.
Qed.

Lemma iprop_compact_in_interval2y' : forall I pI x y Hx Hy
 (H : compact_ (compact_in_interval2 I pI x y Hx Hy)) H',
 compact (Lend H) (Rend H) H' y.
Proof.
 do 6 intro.
 cut (compact_in_interval2 I pI x y Hx Hy y).
  2: apply iprop_compact_in_interval2y.
 elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H.
 simpl in |- *; auto.
Qed.

Lemma iprop_compact_in_interval2_inc1 : forall I pI x y Hx Hy
 (H : compact_ (compact_in_interval2 I pI x y Hx Hy)) H',
 included (compact (Lend H) (Rend H) H') (compact_in_interval2 I pI x y Hx Hy).
Proof.
 do 6 intro.
 elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H.
 unfold compact in |- *; unfold iprop in |- *; simpl in |- *; Included.
Qed.

Lemma iprop_compact_in_interval2_inc2 : forall I pI x y Hx Hy
 (H : compact_ (compact_in_interval2 I pI x y Hx Hy)) H',
 included (compact_in_interval2 I pI x y Hx Hy) (compact (Lend H) (Rend H) H').
Proof.
 do 6 intro.
 elim (compact_in_interval2 I pI x y Hx Hy); intros; try inversion H.
 unfold compact in |- *; unfold iprop in |- *; simpl in |- *; Included.
Qed.

Lemma compact_in_interval_x_lft : forall I pI x y Hx Hy H H',
 Lend (I:=compact_in_interval2 I pI x y Hx Hy) H [<=]
   Lend (I:=compact_in_interval I pI x Hx) H'.
Proof.
 intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply minus_resp_leEq;
   try apply Min_leEq_lft; try apply leEq_reflexive;
     (rstepl (c[+] (Min x y[-]c) [/]TwoNZ); rstepr (c[+] (x[-]c) [/]TwoNZ);
       apply plus_resp_leEq_lft; apply div_resp_leEq;
         [ apply pos_two | apply minus_resp_leEq; apply Min_leEq_lft ]).
Qed.

Lemma compact_in_interval_y_lft : forall I pI x y Hx Hy H H',
 Lend (I:=compact_in_interval2 I pI x y Hx Hy) H [<=]
   Lend (I:=compact_in_interval I pI y Hy) H'.
Proof.
 intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply minus_resp_leEq;
   try apply Min_leEq_rht; try apply leEq_reflexive;
     (rstepl (c[+] (Min x y[-]c) [/]TwoNZ); rstepr (c[+] (y[-]c) [/]TwoNZ);
       apply plus_resp_leEq_lft; apply div_resp_leEq;
         [ apply pos_two | apply minus_resp_leEq; apply Min_leEq_rht ]).
Qed.

Lemma compact_in_interval_x_rht : forall I pI x y Hx Hy H H',
 Rend (I:=compact_in_interval I pI x Hx) H [<=]
   Rend (I:=compact_in_interval2 I pI x y Hx Hy) H'.
Proof.
 intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply plus_resp_leEq;
   try apply lft_leEq_Max; try apply leEq_reflexive;
     (rstepl (c0[-] (c0[-]x) [/]TwoNZ); rstepr (c0[-] (c0[-]Max x y) [/]TwoNZ);
       unfold cg_minus in |- *; apply plus_resp_leEq_lft; apply inv_resp_leEq; apply div_resp_leEq;
         [ apply pos_two | apply plus_resp_leEq_lft; apply inv_resp_leEq; apply lft_leEq_Max ]).
Qed.

Lemma compact_in_interval_y_rht : forall I pI x y Hx Hy H H',
 Rend (I:=compact_in_interval I pI y Hy) H [<=]
   Rend (I:=compact_in_interval2 I pI x y Hx Hy) H'.
Proof.
 intros [| c| c| c| c| c c0| c c0| c c0| c c0]; simpl in |- *; intros; try apply plus_resp_leEq;
   try apply rht_leEq_Max; try apply leEq_reflexive;
     (rstepl (c0[-] (c0[-]y) [/]TwoNZ); rstepr (c0[-] (c0[-]Max x y) [/]TwoNZ);
       unfold cg_minus in |- *; apply plus_resp_leEq_lft; apply inv_resp_leEq; apply div_resp_leEq;
         [ apply pos_two | apply plus_resp_leEq_lft; apply inv_resp_leEq; apply rht_leEq_Max ]).
Qed.

End Proper_Compact_with_One_or_Two_Points.

(**
Compact intervals are exactly compact intervals(!).
*)

Lemma interval_compact_inc : forall I (cI : compact_ I) H,
 included I (compact (Lend cI) (Rend cI) H).
Proof.
 intros [| c| c| c| c| c c0| c c0| c c0| c c0];intros; try inversion cI.
 generalize c c0 cI H; clear H cI c0 c.
 simpl in |- *; intros a b Hab Hab'.
 intros x H.
 simpl in H.
 inversion_clear H; split; auto.
Qed.

Lemma compact_interval_inc : forall I (cI : compact_ I) H,
 included (compact (Lend cI) (Rend cI) H) I.
Proof.
 intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI.
 generalize c c0 cI H; clear H cI c0 c.
 simpl in |- *; intros a b Hab.
 intros H x H0.
 inversion_clear H0; split; auto.
Qed.

(**
A generalization of the previous results: if $[a,b]\subseteq J$#[a,b]⊆J#
and [J] is proper, then we can find a proper interval [[a',b']] such that
$[a,b]\subseteq[a',b']\subseteq J$#[a,b]⊆[a',b']⊆J#.
*)

Lemma compact_proper_in_interval : forall (J : interval) a b Hab,
 included (compact a b Hab) J -> proper J -> {a' : IR | {b' : IR | {Hab' : _ |
 included (compact a' b' (less_leEq _ _ _ Hab')) J |
   included (Compact Hab) (Compact (less_leEq _ _ _ Hab'))}}}.
Proof.
 intros J a b Hab H H0.
 exists (Lend (compact_compact_in_interval2 J H0 a b (H _ (compact_inc_lft _ _ Hab))
   (H _ (compact_inc_rht _ _ Hab)))).
 exists (Rend (compact_compact_in_interval2 J H0 a b (H _ (compact_inc_lft _ _ Hab))
   (H _ (compact_inc_rht _ _ Hab)))).
 exists (proper_compact_in_interval2' _ _ _ _ _ _
   (compact_compact_in_interval2 J H0 a b (H _ (compact_inc_lft _ _ Hab))
     (H _ (compact_inc_rht _ _ Hab)))).
  eapply included_trans.
   apply compact_interval_inc.
  apply included_compact_in_interval2.
 apply included_compact.
  apply iprop_compact_in_interval2x'.
 apply iprop_compact_in_interval2y'.
Qed.

End Compact_Constructions.

Section Functions.

(**
** Properties of Functions in Intervals

We now define notions of continuity, differentiability and so on on
arbitrary intervals.  As expected, a function [F] has property [P] in
the (proper) interval [I] iff it has property [P] in every compact
interval included in [I].  We can formalize this in a nice way using
previously defined concepts.

%\begin{convention}% Let [n:nat] and [I:interval].
%\end{convention}%
*)

Variable n : nat.
Variable I : interval.

Definition Continuous F := included I (Dom F) and (forall a b (Hab : a [<=] b),
 included (Compact Hab) I -> Continuous_I Hab F).

Definition Derivative (pI : proper I) F G := included I (Dom F) and included I (Dom G) and (forall a b Hab,
 included (Compact (less_leEq _ a b Hab)) I -> Derivative_I Hab F G).

Definition Diffble (pI : proper I) F := included I (Dom F) and (forall a b Hab,
 included (Compact (less_leEq _ a b Hab)) I -> Diffble_I Hab F).

Definition Derivative_n (pI : proper I) F G := included I (Dom F) and included I (Dom G) and
 (forall a b Hab, included (Compact (less_leEq _ a b Hab)) I -> Derivative_I_n Hab n F G).

Definition Diffble_n (pI : proper I) F := included I (Dom F) and (forall a b Hab,
 included (Compact (less_leEq _ a b Hab)) I -> Diffble_I_n Hab n F).

End Functions.

Section Reflexivity_Properties.

(**
In the case of compact intervals, this definitions collapse to the old ones.
*)

Lemma Continuous_Int :
 forall (I : interval) (cI : compact_ I) H (F : PartIR),
 Continuous_I (a:=Lend cI) (b:=Rend cI) H F -> Continuous I F.
Proof.
 intros I cI H F H0.
 cut (included I (compact (Lend cI) (Rend cI) H)).
  2: apply interval_compact_inc; auto.
 cut (included (compact (Lend cI) (Rend cI) H) I).
  2: apply compact_interval_inc; auto.
 generalize cI H H0; clear H0 H cI.
 destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI.
 generalize c c0 cI H H0 X X0; clear X0 X H0 H cI c0 c.
 simpl in |- *; intros a b Hab Hab' contF inc1 inc2.
 split.
  apply included_trans with (Compact Hab'); Included.
 intros.
 apply included_imp_contin with (Hab := Hab'); Included.
Qed.

Lemma Int_Continuous :
 forall (I : interval) (cI : compact_ I) H (F : PartIR),
 Continuous I F -> Continuous_I (a:=Lend cI) (b:=Rend cI) H F.
Proof.
 intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI.
 generalize c c0 cI H F X; clear X F H cI c0 c.
 simpl in |- *; intros a b Hab Hab' F contF.
 inversion_clear contF.
 Contin.
Qed.

Lemma Derivative_Int :
 forall (I : interval) (cI : compact_ I) (pI : proper I) H (F F' : PartIR),
 Derivative_I (a:=Lend cI) (b:=Rend cI) H F F' -> Derivative I pI F F'.
Proof.
 do 4 intro.
 cut (included I (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H))).
  2: apply interval_compact_inc; auto.
 cut (included (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H)) I).
  2: apply compact_interval_inc; auto.
 generalize cI pI H; clear H cI pI.
 destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI.
 generalize c c0 cI pI H X X0 F F' X1; clear X1 F' F X0 X H pI cI c0 c.
 simpl in |- *; intros a b Hab Hnonv Hab' inc1 inc2 F F' derF.
 split.
  apply included_trans with (Compact (less_leEq _ _ _ Hab')); Included.
 split.
  apply included_trans with (Compact (less_leEq _ _ _ Hab')); Included.
 intros c d Hcd' Hinc.
 apply included_imp_deriv with (Hab := Hab'); Included.
Qed.

Lemma Int_Derivative :
 forall (I : interval) (cI : compact_ I) (pI : proper I) H (F F' : PartIR),
 Derivative I pI F F' -> Derivative_I (a:=Lend cI) (b:=Rend cI) H F F'.
Proof.
 intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI.
 generalize c c0 cI pI H F F' X; clear X F' F H pI cI c0 c.
 simpl in |- *; intros a b Hab Hnonv Hab' F F' derF.
 elim derF; intros H H0.
 elim H0; intros H1 H2.
 Included.
Qed.

Lemma Diffble_Int :
 forall (I : interval) (cI : compact_ I) (pI : proper I) H (F : PartIR),
 Diffble_I (a:=Lend cI) (b:=Rend cI) H F -> Diffble I pI F.
Proof.
 do 4 intro.
 cut (included I (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H))).
  2: apply interval_compact_inc; auto.
 cut (included (compact (Lend cI) (Rend cI) (less_leEq _ _ _ H)) I).
  2: apply compact_interval_inc; auto.
 generalize cI pI H; clear H pI cI.
 destruct I as [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI.
 generalize c c0 cI pI H X X0 F X1; clear X1 F X0 X H pI cI c0 c.
 simpl in |- *; intros a b Hab Hnonv Hab' inc1 inc2 F diffF.
 red in |- *; simpl in |- *.
 split.
  apply included_trans with (Compact (less_leEq _ _ _ Hab')); Included.
 intros c d Hcd' Hinc.
 apply included_imp_diffble with (Hab := Hab'); auto.
Qed.

Lemma Int_Diffble :
 forall (I : interval) (cI : compact_ I) (pI : proper I) H (F : PartIR),
 Diffble I pI F -> Diffble_I (a:=Lend cI) (b:=Rend cI) H F.
Proof.
 intros [| c| c| c| c| c c0| c c0| c c0| c c0]; intros; try inversion cI.
 generalize c c0 cI pI H F X; clear X F H pI cI c0 c.
 simpl in |- *; intros a b Hab Hnonv Hab' F diffF.
 inversion_clear diffF.
 Included.
Qed.

End Reflexivity_Properties.

Section Lemmas.

(**
Interestingly, inclusion and equality in an interval are also characterizable in a similar way:
*)

Lemma included_imp_inc : forall (J : interval) P,
 (forall a b Hab, included (compact a b Hab) J -> included (compact a b Hab) P) -> included J P.
Proof.
 intros J P H x H0.
 apply (H _ _ (leEq_reflexive _ _) (compact_single_iprop J x H0)).
 apply compact_inc_lft.
Qed.

Lemma included_Feq'' : forall I F G, proper I -> (forall a b Hab (Hab':=(less_leEq _ a b Hab)),
 included (Compact Hab') I -> Feq (Compact Hab') F G) -> Feq I F G.
Proof.
 intros I F G H H0.
 apply eq_imp_Feq.
   intros x H1.
   elim (compact_proper_in_interval I x x (leEq_reflexive _ x)); Included.
    2: exact (compact_single_iprop I x H1).
   intros a Ha.
   elim Ha; clear Ha.
   intros b Hb.
   elim Hb; clear Hb.
   intros Hab H2 H3.
   elim (H0 _ _ _ H2); intros.
   apply a0; apply H3; apply compact_single_prop.
  intros x H1.
  elim (compact_proper_in_interval I x x (leEq_reflexive _ x)); Included.
   2: exact (compact_single_iprop I x H1).
  intros a Ha.
  elim Ha; clear Ha.
  intros b Hb.
  elim Hb; clear Hb.
  intros Hab H2 H3.
  elim (H0 _ _ _ H2); intros.
  inversion_clear b0.
  apply X; apply H3; apply compact_single_prop.
 intros x H1 Hx Hx'.
 elim (compact_proper_in_interval I x x (leEq_reflexive _ x)); Included.
  2: exact (compact_single_iprop I x H1).
 intros a Ha.
 elim Ha; clear Ha.
 intros b Hb.
 elim Hb; clear Hb.
 intros Hab H2 H3.
 elim (H0 _ _ _ H2); intros.
 inversion_clear b0.
 apply H4; apply H3; apply compact_single_prop.
Qed.

Lemma included_Feq' : forall (I : interval) F G,
 (forall a b Hab, included (compact a b Hab) I -> Feq (Compact Hab) F G) -> Feq I F G.
Proof.
 intros I F G H.
 apply eq_imp_Feq.
   intros x H0.
   elim (H x x (leEq_reflexive _ x) (compact_single_iprop I x H0)); intros.
   apply a; apply compact_single_prop.
  intros x H0.
  elim (H x x (leEq_reflexive _ x) (compact_single_iprop I x H0)); intros.
  inversion_clear b.
  apply X; apply compact_single_prop.
 intros x H0 Hx Hx'.
 elim (H x x (leEq_reflexive _ x) (compact_single_iprop I x H0)); intros.
 inversion_clear b.
 apply H1; apply compact_single_prop.
Qed.

End Lemmas.

#[global]
Hint Resolve included_interval included_interval' included3_interval
  compact_single_inc compact_single_iprop included_compact_in_interval
  iprop_compact_in_interval_inc1 iprop_compact_in_interval_inc2
  included_compact_in_interval2 iprop_compact_in_interval2_inc1
  iprop_compact_in_interval2_inc2 interval_compact_inc compact_interval_inc
  iprop_wd: included.


Set Implicit Arguments.
Require Import LibLN.
Require Import Full_ott.
Implicit Types x : var.

(* Syntax *)

Notation "{ k ~> u } t" := (open_trm_wrt_trm_rec k u t) (at level 67).
Notation "t ^^ u" := (open_trm_wrt_trm t u) (at level 67).
Notation "t ^ x" := (open_trm_wrt_trm t (trm_var_f x)).

Definition body t :=
  exists L, forall x, x \notin L -> lc_trm (t ^ x).

Definition relation := trm -> trm -> Prop.

Notation "t --> t'" := (reduct t t') (at level 67).

(* Typing *)

Implicit Types E : env.

Scheme sub_induct := Induction for sub Sort Prop
  with wf_induct := Induction for wf Sort Prop.

Lemma sub_sub' : forall A (G:env) (e1 e2 B:trm),
  sub G e1 e2 A ->
  sub G A B trm_star ->
  sub G e1 e2 B.
Proof.
  intros. eauto 2.
Qed.

(* infrastructure *)
Definition fv := fv_trm.
Definition subst z u t := subst_trm u z t.

Notation "[ z ~> u ] t" := (subst z u t) (at level 68).

Fixpoint close_var_rec (k : nat) (z : var) (t : trm) {struct t} : trm :=
  match t with
  | trm_var_b i        => trm_var_b i
  | trm_var_f x        => If x = z then (trm_var_b k) else (trm_var_f x)
  | trm_star          => trm_star
  | trm_top           => trm_top
  | trm_app t1 t2     => trm_app (close_var_rec k z t1) (close_var_rec k z t2)
  | trm_abs t0 t1 t2  => trm_abs (close_var_rec k z t0) (close_var_rec k z t1) (close_var_rec (S k) z t2)
  | trm_prod t0 t1 t2 => trm_prod (close_var_rec k z t0) (close_var_rec k z t1) (close_var_rec (S k) z t2)
  | trm_castup t1 t2  => trm_castup (close_var_rec k z t1) (close_var_rec k z t2)
  | trm_castdn t1     => trm_castdn (close_var_rec k z t1)
  | trm_anno t1 t2    => trm_anno (close_var_rec k z t1) (close_var_rec k z t2)
  end.

Definition close_var z t := close_var_rec 0 z t.

Definition contains_terms E :=
  forall x T U, binds x (bind_sub T U) E -> lc_trm T /\ lc_trm U.

Definition red_regular (R : relation) :=
  forall t t', R t t' -> lc_trm t /\ lc_trm t'.

Ltac gather_vars :=
  let A := gather_vars_with (fun x : vars => x) in
  let B := gather_vars_with (fun x : var => \{x}) in
  let C := gather_vars_with (fun x : trm => fv x) in
  let D := gather_vars_with (fun x : env => dom x) in
  constr:(A \u B \u C \u D).

Ltac pick_fresh X :=
  let L := gather_vars in (pick_fresh_gen L X).

Tactic Notation "apply_fresh" constr(T) "as" ident(x) :=
  apply_fresh_base T gather_vars x.

Tactic Notation "apply_fresh" "*" constr(T) "as" ident(x) :=
  apply_fresh T as x; autos*.

Ltac exists_fresh :=
  let L := gather_vars_with (fun x : vars => x) in exists L.

Lemma open_rec_term_core :forall e j v i u, i <> j ->
  {j ~> v}e = {i ~> u}({j ~> v}e) -> e = {i ~> u}e.
Proof.
  induction e; introv Neq Equ;
  simpl in *; inversion* Equ; f_equal*.
  case_nat*. case_nat*.
Qed.

Lemma open_rec_term : forall t u,
  lc_trm t -> forall k, t = {k ~> u}t.
Proof.
  induction 1; intros; simpl; f_equal*.
  unfolds open_trm_wrt_trm. pick_fresh x.
   apply* (@open_rec_term_core e2 0 (trm_var_f x)).
  unfolds open_trm_wrt_trm. pick_fresh x.
   apply* (@open_rec_term_core B 0 (trm_var_f x)).
Qed.

Lemma subst_fresh : forall x t u,
  x \notin fv t -> [x ~> u] t = t.
Proof.
  intros. induction t; simpls; fequals*.
  case_var*.
Qed.

Lemma subst_open : forall x u t1 t2, lc_trm u ->
  [x ~> u] (t1 ^^ t2) = ([x ~> u]t1) ^^ ([x ~> u]t2).
Proof.
  intros. unfold open_trm_wrt_trm. generalize 0.
  induction t1; intros; simpl; f_equal*.
  case_nat*. case_var*. apply* open_rec_term.
Qed.

Lemma subst_open_var : forall x y u e, y <> x -> lc_trm u ->
  ([x ~> u]e) ^ y = [x ~> u] (e ^ y).
Proof.
  introv Neq Wu. rewrite* subst_open.
  simpl. case_var*.
Qed.

Lemma subst_intro : forall x t u,
  x \notin (fv t) -> lc_trm u ->
  t ^^ u = [x ~> u](t ^ x).
Proof.
  introv Fr Wu. rewrite* subst_open.
  rewrite* subst_fresh. simpl. case_var*.
Qed.

Ltac cross :=
  rewrite subst_open_var; try cross.

Tactic Notation "cross" "*" :=
  cross; autos*.

Lemma subst_term : forall t z u,
  lc_trm u -> lc_trm t -> lc_trm ([z ~> u]t).
Proof.
  induction 2; simple*.
  case_var*.
  apply_fresh* lc_trm_abs as y. rewrite* subst_open_var.
  apply_fresh* lc_trm_prod as y. rewrite* subst_open_var.
Qed.

Lemma open_term : forall t u,
  body t -> lc_trm u -> lc_trm (t ^^ u).
Proof.
  intros. destruct H. pick_fresh y.
  rewrite* (@subst_intro y). apply* subst_term.
Qed.

Hint Resolve subst_term open_term.

Lemma lc_trm_abs0 : forall t1 t2 t0,
  lc_trm (trm_abs t0 t1 t2) -> lc_trm t0.
Proof.
  intros. inversion* H.
Qed.

Lemma lc_trm_abs1 : forall t0 t2 t1,
  lc_trm (trm_abs t0 t1 t2) -> lc_trm t1.
Proof.
  intros. inversion* H.
Qed.

Lemma body_abs2 : forall t0 t1 t2,
  lc_trm (trm_abs t0 t1 t2) -> body t2.
Proof.
  intros. unfold body. inversion* H.
Qed.

Lemma lc_trm_prod0 : forall t1 t2 t0,
  lc_trm (trm_prod t0 t1 t2) -> lc_trm t0.
Proof.
  intros. inversion* H.
Qed.

Lemma lc_trm_prod1 : forall t0 t2 t1,
  lc_trm (trm_prod t0 t1 t2) -> lc_trm t1.
Proof.
  intros. inversion* H.
Qed.

Lemma body_prod2 : forall t0 t1 t2,
  lc_trm (trm_prod t0 t1 t2) -> body t2.
Proof.
  intros. unfold body. inversion* H.
Qed.

Hint Extern 1 (lc_trm ?t0) =>
  match goal with
  | H: lc_trm (trm_abs t0 ?t1 ?t2) |- _ => apply (@lc_trm_abs0 t1 t2)
  | H: lc_trm (trm_prod t0 ?t1 ?t2) |- _ => apply (@lc_trm_prod0 t1 t2)
  end.

Hint Extern 1 (lc_trm ?t1) =>
  match goal with
  | H: lc_trm (trm_abs ?t0 t1 ?t2) |- _ => apply (@lc_trm_abs1 t0 t2)
  | H: lc_trm (trm_prod ?t0 t1 ?t2) |- _ => apply (@lc_trm_prod1 t0 t2)
  end.

Hint Extern 3 (body ?t) =>
  match goal with
  | H: context [trm_abs ?t0 ?t1 t] |- _ => apply (@body_abs2 t0 t1)
  | H: context [trm_prod ?t0 ?t1 t] |- _ => apply (@body_prod2 t0 t1)
  end.

Hint Extern 1 (body ?t) =>
  match goal with
  | H: context [t ^ _] |- _ =>
      let x := fresh in let Fr := fresh in
      let P := fresh in
      let L := gather_vars in exists L; intros x Fr;
      lets P: H x __; [ notin_solve
                      | try destructs P ]
  end.

Lemma lc_trm_abs_prove : forall t0 t1 t2,
  lc_trm t0 -> lc_trm t1 -> body t2 -> lc_trm (trm_abs t0 t1 t2).
Proof.
  intros. apply_fresh* lc_trm_abs as x.
Qed.

Lemma lc_trm_prod_prove : forall t0 t1 t2,
  lc_trm t0 -> lc_trm t1 -> body t2 -> lc_trm (trm_prod t0 t1 t2).
Proof.
  intros. apply_fresh* lc_trm_prod as x.
Qed.

Hint Resolve lc_trm_abs_prove lc_trm_prod_prove.

Lemma body_prove : forall L t,
  (forall x, x \notin L -> lc_trm (t ^ x)) -> body t.
Proof.
  intros. exists* L.
Qed.

Hint Extern 1 (body ?t) =>
  match goal with
  | H: forall _, _ \notin ?L -> lc_trm (t ^ _)  |- _ =>
    apply (@body_prove L)
  end.

Lemma body_subst : forall x t u,
  lc_trm u -> body t -> body ([x ~> u]t).
Proof.
  introv. intros Wu [L Bt].
  exists (\{x} \u L). intros y Fr. cross*.
Qed.

Hint Resolve body_subst.

Lemma open_var_inj : forall x t1 t2,
  x \notin (fv t1) -> x \notin (fv t2) ->
  (t1 ^ x = t2 ^ x) -> (t1 = t2).
Proof.
  intros x t1. unfold open_trm_wrt_trm. generalize 0.
  induction t1; intro k; destruct t2; simpl; intros; inversion H1;
  try solve [ f_equal*
  | do 2 try case_nat; inversions* H1; try notin_false ].
Qed.

Lemma close_var_rec_open : forall x y z t1 i j,
  i <> j -> y <> x -> y \notin (fv t1) ->
    {i ~> trm_var_f y} ({j ~> trm_var_f z} (close_var_rec j x t1) )
  = {j ~> trm_var_f z} (close_var_rec j x ({i ~> trm_var_f y}t1) ).
Proof.
  induction t1; simpl; intros; try solve [ f_equal* ].
  do 2 (case_nat; simpl); try solve [ case_var* | case_nat* ].
  case_var*. simpl. case_nat*.
Qed.

Lemma close_var_fresh : forall x t,
  x \notin fv (close_var x t).
Proof.
  introv. unfold close_var. generalize 0.
  induction t; intros k; simpls; notin_simpl; auto.
  case_var; simple*.
Qed.

Lemma close_var_body : forall x t,
  lc_trm t -> body (close_var x t).
Proof.
  introv W. exists \{x}. intros y Fr.
  unfold open_trm_wrt_trm, close_var. generalize 0. gen y.
  induction W; intros y Fr k; simpls; try solve [autos*].
  case_var; simple*. case_nat*.
  apply_fresh* lc_trm_abs as z.
   unfolds open_trm_wrt_trm. rewrite* close_var_rec_open.
  apply_fresh* lc_trm_prod as z.
   unfolds open_trm_wrt_trm. rewrite* close_var_rec_open.
Qed.

Lemma close_var_open : forall x t,
  lc_trm t -> t = (close_var x t) ^ x.
Proof.
  introv W. unfold close_var, open_trm_wrt_trm. generalize 0.
  induction W; intros k; simpls; f_equal*.
  case_var*. simpl. case_nat*.
  let L := gather_vars in match goal with |- _ = ?t =>
    destruct (var_fresh (L \u fv t)) as [y Fr] end.
  apply* (@open_var_inj y).
  unfolds open_trm_wrt_trm. rewrite* close_var_rec_open.
  let L := gather_vars in match goal with |- _ = ?t =>
    destruct (var_fresh (L \u fv t)) as [y Fr] end.
  apply* (@open_var_inj y).
  unfolds open_trm_wrt_trm. rewrite* close_var_rec_open.
Qed.

Lemma close_var_spec : forall t x, lc_trm t ->
  exists u, t = u ^ x /\ body u /\ x \notin (fv u).
Proof.
  intros. exists (close_var x t). splits 3.
  apply* close_var_open.
  apply* close_var_body.
  apply* close_var_fresh.
Qed.

Lemma ivalue_is_term : forall t, ivalue t -> lc_trm t.
Proof.
  intros_all. induction* H.
Qed.

Lemma value_is_term : forall t, value t -> lc_trm t.
Proof.
  intros_all. induction* H.
  apply* ivalue_is_term.
Qed.

Hint Extern 1 (lc_trm ?t) => match goal with
  | H: ivalue t |- _ => apply (ivalue_is_term H)
  | H: value t |- _ => apply (value_is_term H) end.

Lemma red_regular_reduct : red_regular reduct.
Proof.
  intros_all. induction* H.
Qed.

Hint Extern 1 (lc_trm ?t) => match goal with
  | H: reduct t _ |- _ => apply (proj1 (red_regular_reduct H))
  | H: reduct _ t |- _ => apply (proj2 (red_regular_reduct H))
  end.

Hint Extern 1 (lc_trm (trm_abs ([?x ~> ?u]?t0) ([?x ~> ?u]?t1) ([?x ~> ?u]?t2))) =>
  match goal with H: lc_trm (trm_abs t0 t1 t2) |- _ =>
  unsimpl ([x ~> u](trm_abs t0 t1 t2)) end.

Hint Extern 1 (lc_trm (trm_prod ([?x ~> ?u]?t0) ([?x ~> ?u]?t1) ([?x ~> ?u]?t2))) =>
  match goal with H: lc_trm (trm_prod t0 t1 t2) |- _ =>
  unsimpl ([x ~> u](trm_prod t0 t1 t2)) end.

Lemma regular_sub : forall G e1 e2 A,
  sub G e1 e2 A ->
  (wf G /\ ok G /\ contains_terms G /\ lc_trm e1 /\ lc_trm e2 /\ lc_trm A).
Proof.
  apply sub_induct with
  (P0 := fun E (_ : wf E) => ok E /\ contains_terms E);
    unfolds contains_terms; intros; splits*.
  destruct H as [? ?].
  destructs~ (H0 _ e A b).
  intros. false* binds_empty_inv.
  intros. destruct (binds_push_inv H1) as [[? ?]|[? ?]].
    inversion H3. subst*.
    destruct H0 as (? & ? & HH & ?). apply* HH.
Qed.

Hint Extern 1 (lc_trm ?t) => match goal with
  | H: sub _ t _ _ |- _ => apply (proj31 (proj44 (regular_sub H)))
  | H: sub _ _ t _ |- _ => apply (proj32 (proj44 (regular_sub H)))
  | H: sub _ _ _ t |- _ => apply (proj33 (proj44 (regular_sub H)))
  end.

Lemma ok_from_wf : forall G, wf G -> ok G.
Proof.
  induction 1. auto. autos* (regular_sub H0).
Qed.

Hint Extern 1 (ok ?E) => match goal with
  | H: wf E |- _ => apply (ok_from_wf H)
  end.

Hint Extern 1 (wf ?E) => match goal with
  | H: sub E _ _ _ |- _ => apply (proj1 (regular_sub H))
  end.

Lemma wf_push_inv : forall G x A B,
  wf (G & x ~ bind_sub A B) -> wf G /\ lc_trm A /\ lc_trm B.
Proof.
  introv W. inversions W.
  false (empty_push_inv H0).
  destruct (eq_push_inv H) as [? [? ?]]. inversion H3.
  subst~.
  destruct (eq_push_inv H) as [? [? ?]]. inversion H4.
  subst~.
Qed.

Lemma lc_trm_from_binds_in_wf : forall x E T U,
  wf E -> binds x (bind_sub T U) E -> lc_trm T /\ lc_trm U.
Proof.
  introv W Has. gen E. induction E using env_ind; intros.
  false* binds_empty_inv.
  induction v.
  destruct (wf_push_inv W).
  destruct (binds_push_inv Has) as [[? ?] | [? ?]].
  inversion H2. subst*.
  apply* IHE.
Qed.

Lemma lc_trm_from_binds_in_wf_left : forall x E T U,
  wf E -> binds x (bind_sub T U) E -> lc_trm T.
Proof.
  intros. destruct~ (lc_trm_from_binds_in_wf H H0).
Qed.

Lemma lc_trm_from_binds_in_wf_right : forall x E T U,
  wf E -> binds x (bind_sub T U) E -> lc_trm U.
Proof.
  intros. destruct~ (lc_trm_from_binds_in_wf H H0).
Qed.

Hint Extern 1 (lc_trm ?t) => match goal with
  | H: binds ?x (bind_sub t ?t2) ?E |- _ => apply (@lc_trm_from_binds_in_wf_left x E)
  | H: binds ?x (bind_sub ?t2 t) ?E |- _ => apply (@lc_trm_from_binds_in_wf_right x E)
  end.

Lemma wf_left : forall E F : env,
  wf (E & F) -> wf E.
Proof.
  intros. induction F using env_ind.
  rewrite~ concat_empty_r in H.
  rewrite concat_assoc in H.
   inversions H. false (empty_push_inv H1).
   destruct (eq_push_inv H0) as [? [? ?]]. subst~.
Qed.

Implicit Arguments wf_left [E F].

Lemma fv_open_var : forall y x t,
  x <> y -> x \notin fv (t ^ y) -> x \notin fv t.
Proof.
  introv Neq. unfold open_trm_wrt_trm. generalize 0.
  induction t; simpl; intros; try notin_solve; autos*.
Qed.

Lemma fresh_false : forall G x (v:binding),
  x # G & x ~ v -> False.
Proof.
  intros. simpl_dom.
  destruct (notin_union x \{x} (dom G)) as [H1 _].
  lets: H1 H.
  destruct H0 as [H3 _].
  apply* notin_same.
Qed.

Lemma and_simpl : forall (A : Prop),
    A -> A /\ A.
Proof.
  intros. auto.
Qed.

Lemma fv_open_term : forall A B x,
  x \notin fv A -> x \notin fv B ->
  x \notin fv (A ^^ B).
Proof.
  intros A. unfold open_trm_wrt_trm. generalize 0.
  induction A; simpl; intros; try (notin_simpl); autos*.
  case_nat~.
Qed.

Lemma fv_close_var : forall y x t,
  x <> y -> x \notin fv t -> x \notin fv (t ^ y).
Proof.
  introv Neq. unfold open_trm_wrt_trm. generalize 0.
  induction t; simpl; intros; try notin_solve; try autos*.
  case_nat~. simpl. auto.
Qed.

Lemma sub_fresh : forall G A B C x,
  sub G A B C -> x # G -> (x \notin fv A) /\ (x \notin fv B).
Proof.
  introv Typ.
  induction Typ; simpls; intros; try (apply and_simpl).
  auto.
  rewrite notin_singleton. intro. subst. applys binds_fresh_inv H0 H1.
  split.
    rewrite notin_singleton. intro. subst. applys binds_fresh_inv H H0.
    apply* IHTyp.
  splits*.
  auto.
  destruct (IHTyp1 H3).
  destruct (IHTyp2 H3).
  split; notin_simpl; auto.
  pick_fresh y. apply* (@fv_open_var y).
  destruct (H0 y). auto. auto. auto.
  pick_fresh y. apply* (@fv_open_var y).
  destruct (H0 y). auto. auto. auto.
  splits*.
  destruct (IHTyp1 H3).
  destruct (IHTyp2 H3).
  split; notin_simpl; auto.
  pick_fresh y. apply* (@fv_open_var y).
  destruct (H0 y). auto. auto. auto.
  pick_fresh y. apply* (@fv_open_var y).
  destruct (H2 y). auto. auto. auto.
  splits*.
  splits*.
  auto.
Qed.

Lemma notin_fv_from_wf : forall E F x U T,
  wf (E & x ~ bind_sub U T & F) -> x \notin fv T.
Proof.
  intros.
  lets W: (wf_left H). inversions W.
  false (empty_push_inv H1).
  destruct (eq_push_inv H0) as [? [? ?]]. inversion H5. subst~.
  apply* sub_fresh.
Qed.

Lemma notin_fv_from_binds_right : forall x y T U E,
  wf E -> binds y (bind_sub T U) E -> x # E -> x \notin fv U.
Proof.
  induction E using env_ind; intros.
  false* binds_empty_inv.
  induction v.
  destruct (wf_push_inv H).
    destruct (binds_push_inv H0) as [[? ?] | [? ?]].
    inversion H5. subst. inversions H. false* (empty_push_inv H6).
     destruct (eq_push_inv H4) as [? [? ?]].  inversion H9. subst~.
     apply* sub_fresh.
    autos*.
Qed.

Lemma notin_fv_from_binds : forall x y T U E,
  wf E -> binds y (bind_sub T U) E -> x # E -> x \notin fv T /\ x \notin fv U.
Proof.
  induction E using env_ind; intros.
  false* binds_empty_inv.
  induction v.
  destruct (wf_push_inv H).
    destruct (binds_push_inv H0) as [[? ?] | [? ?]].
    inversion H5. subst. inversions H. false* (empty_push_inv H6).
     destruct (eq_push_inv H4) as [? [? ?]].  inversion H9. subst~.
     split; apply* sub_fresh.
    autos*.
Qed.

Lemma notin_fv_from_binds' : forall E F x V1 V2 y U1 U2,
  wf (E & x ~ bind_sub V1 V2 & F) ->
  binds y (bind_sub U1 U2) E ->
  x \notin fv U1 /\ x \notin fv U2.
Proof.
  intros. lets W: (wf_left H). inversions keep W.
  false (empty_push_inv H2).
  destruct (eq_push_inv H1) as [? [? ?]]. inversion H5. subst~.
  lets W': (wf_left W). apply* notin_fv_from_binds.
Qed.

Lemma notin_fv_from_binds'_left : forall E F x V y U1 U2,
  wf (E & x ~ V & F) ->
  binds y (bind_sub U1 U2) E ->
  x \notin fv U1.
Proof.
  intros. induction V.
  destruct~ (notin_fv_from_binds' H H0).
Qed.

Lemma notin_fv_from_binds'_right : forall E F x V y U1 U2,
  wf (E & x ~ V & F) ->
  binds y (bind_sub U1 U2) E ->
  x \notin fv U2.
Proof.
  intros. induction V.
  destruct~ (notin_fv_from_binds' H H0).
Qed.

Hint Extern 1 (?x \notin fv ?V) =>
  match goal with H: wf (?E & x ~ (bind_sub ?U V) & ?F) |- _ =>
    apply (@notin_fv_from_wf E F) end.

Hint Extern 1 (?x \notin fv ?U) =>
  match goal with H: wf (?E & x ~ ?V & ?F), B: binds ?y (bind_sub U ?U') ?E |- _ =>
    apply (@notin_fv_from_binds'_left E F x V y) end.

Hint Extern 1 (?x \notin fv ?U) =>
  match goal with H: wf (?E & x ~ ?V & ?F), B: binds ?y (bind_sub ?U' U) ?E |- _ =>
    apply (@notin_fv_from_binds'_right E F x V y) end.


Require Export prosa.model.task.concept.

(** In this module, we provide basic definitions concerning the job
    arrivals of a given task. *)

Section TaskArrivals.

  (** Consider any type of job associated with any type of tasks. *)
  Context {Job : JobType}.
  Context {Task : TaskType}.
  Context `{JobTask Job Task}.

  (** Consider any job arrival sequence ...  *)
  Variable arr_seq : arrival_sequence Job.

  (** ... and any task. *)
  Variable tsk : Task.

  (** First, we construct the list of jobs of task [tsk] that arrive
      in a given half-open interval <<[t1, t2)>>. *)
  Definition task_arrivals_between (t1 t2 : instant) :=
    [seq j <- arrivals_between arr_seq t1 t2 | job_task j == tsk].

  (** Based on that, we define the list of jobs of task [tsk] that
      arrive up to and including time [t], ...*)
  Definition task_arrivals_up_to (t : instant) := task_arrivals_between 0 t.+1.

  (** ...and the list of jobs of task [tsk] that arrive strictly
      before time [t], ... *)
  Definition task_arrivals_before (t : instant) := task_arrivals_between 0 t.

  (** ... and also count the number of job arrivals. *)
  Definition number_of_task_arrivals (t1 t2 : instant) :=
    size (task_arrivals_between t1 t2).

End TaskArrivals.


(* Submitted by David Nowak *)

(* Simpler to forbid the definition of n as a global than to write it
   S.n to keep n accessible... *)

Section S.
Variable n : nat.
Fail Inductive P : Set :=
    n : P.