(* 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.Continuity.
Require Export CoRN.ftc.PartInterval.

Section Definitions.

(**
* Sequences of Functions

In this file we define some more operators on functions, namely
sequences and limits.  These concepts are defined only for continuous
functions.

%\begin{convention}% Throughout this section:
 - [a] and [b] will be real numbers and the interval [[a,b]]
will be denoted by [I];
 - [f, g] and [h] will denote sequences of continuous functions;
 - [F, G] and [H] will denote continuous functions.

%\end{convention}%

** Definitions

A sequence of functions is simply an object of type [nat->PartIR].
However, we will be interested mostly in convergent and Cauchy
sequences.  Several definitions of these concepts will be formalized;
they mirror the several different ways in which a Cauchy sequence can
be defined.  For a discussion on the different notions of convergent
see Bishop 1967.
*)

Variables a b : IR.
Hypothesis Hab : a [<=] b.
(* begin hide *)
Let I := Compact Hab.
(* end hide *)

Variable f : nat -> PartIR.
Variable F : PartIR.

Hypothesis contf : forall n : nat, Continuous_I Hab (f n).
Hypothesis contF : Continuous_I Hab F.

(* begin hide *)
Let incf (n : nat) := contin_imp_inc _ _ _ _ (contf n).
Let incF := contin_imp_inc _ _ _ _ contF.
(* end hide *)

Definition Cauchy_fun_seq := forall e, [0] [<] e -> {N : nat | forall m n, N <= m -> N <= n ->
 forall x Hx, AbsIR (f m x (incf m x Hx) [-]f n x (incf n x Hx)) [<=] e}.

Definition conv_fun_seq' := forall e, [0] [<] e -> {N : nat | forall n, N <= n ->
 forall x Hx, AbsIR (f n x (incf n x Hx) [-]F x (incF x Hx)) [<=] e}.

Definition conv_norm_fun_seq := forall k, {N : nat | forall n, N <= n ->
 Norm_Funct (Continuous_I_minus _ _ _ _ _ (contf n) contF) [<=] one_div_succ k}.

Definition Cauchy_fun_seq1 := forall k, {N : nat | forall m n, N <= m -> N <= n ->
 Norm_Funct (Continuous_I_minus _ _ _ _ _ (contf m) (contf n)) [<=] one_div_succ k}.

Definition Cauchy_fun_seq' := forall k, {N : nat | forall m n, N <= m -> N <= n ->
  forall x Hx, AbsIR (Part _ _ (incf m x Hx) [-]Part _ _ (incf n x Hx)) [<=] one_div_succ k}.

Definition Cauchy_fun_seq2 := forall e, [0] [<] e -> {N : nat | forall m, N <= m ->
  forall x Hx, AbsIR (Part _ _ (incf m x Hx) [-]Part _ _ (incf N x Hx)) [<=] e}.

(**
These definitions are all shown to be equivalent.
*)

Lemma Cauchy_fun_seq_seq' : Cauchy_fun_seq -> Cauchy_fun_seq'.
Proof.
 intro H.
 red in |- *; red in H.
 intro.
 exact (H (one_div_succ k) (one_div_succ_pos _ k)).
Qed.

Lemma Cauchy_fun_seq'_seq : Cauchy_fun_seq' -> Cauchy_fun_seq.
Proof.
 intro H.
 red in |- *; red in H.
 intros e He.
 elim (Archimedes ([1][/] e[//]pos_ap_zero _ _ He)).
 intros i Hei.
 cut ([0] [<] nring (R:=IR) i).
  intro Hi.
  elim (H i).
  intros N HN; exists N.
  intros.
  apply leEq_transitive with (one_div_succ (R:=IR) i).
   apply HN; assumption.
  unfold one_div_succ in |- *.
  rstepr ([1][/] _[//]recip_ap_zero _ _ (pos_ap_zero _ _ He)).
  unfold Snring in |- *.
  apply recip_resp_leEq.
   apply recip_resp_pos; assumption.
  apply less_leEq; apply leEq_less_trans with (nring (R:=IR) i).
   assumption.
  simpl in |- *; apply less_plusOne.
 apply less_leEq_trans with ([1][/] e[//]pos_ap_zero _ _ He).
  apply recip_resp_pos; assumption.
 assumption.
Qed.

Lemma conv_Cauchy_fun_seq' : conv_fun_seq' -> Cauchy_fun_seq.
Proof.
 intro H.
 red in |- *; red in H.
 intros e He.
 elim (H _ (pos_div_two _ _ He)).
 intros N HN.
 exists N; intros.
 apply leEq_wdl with (AbsIR (f m x (incf m x Hx) [-]F x (incF x Hx) [+]
   (F x (incF x Hx) [-]f n x (incf n x Hx)))).
  2: apply AbsIR_wd; rational.
 eapply leEq_transitive.
  apply triangle_IR.
 rstepr (e [/]TwoNZ[+]e [/]TwoNZ).
 apply plus_resp_leEq_both.
  apply HN; assumption.
 eapply leEq_wdl.
  2: apply AbsIR_minus.
 apply HN; assumption.
Qed.

Lemma Cauchy_fun_seq_seq2 : Cauchy_fun_seq -> Cauchy_fun_seq2.
Proof.
 intro H.
 red in |- *; red in H.
 intros e H0.
 elim (H e H0); intros N HN; exists N.
 intros; apply HN; auto with arith.
Qed.

Lemma Cauchy_fun_seq2_seq : Cauchy_fun_seq2 -> Cauchy_fun_seq.
Proof.
 intro H.
 red in |- *; red in H.
 intros e H0.
 elim (H _ (pos_div_two _ _ H0)); intros N HN; exists N; intros.
 apply leEq_wdl with (AbsIR (Part _ _ (incf m x Hx) [-]Part _ _ (incf N x Hx) [-]
   (Part _ _ (incf n x Hx) [-]Part _ _ (incf N x Hx)))).
  2: apply AbsIR_wd; rational.
 eapply leEq_transitive.
  apply triangle_IR_minus.
 rstepr (e [/]TwoNZ[+]e [/]TwoNZ).
 apply plus_resp_leEq_both; apply HN; auto with arith.
Qed.

Lemma conv_fun_seq'_norm : conv_fun_seq' -> conv_norm_fun_seq.
Proof.
 intro H.
 red in |- *; red in H.
 intro.
 elim (H (one_div_succ k) (one_div_succ_pos _ k)).
 intros N HN.
 exists N.
 intros.
 apply leEq_Norm_Funct.
 fold I in |- *; intros x H1 Hx.
 eapply leEq_wdl.
  apply (HN n H0 x H1).
 apply AbsIR_wd; simpl in |- *; rational.
Qed.

Lemma conv_fun_norm_seq : conv_norm_fun_seq -> conv_fun_seq'.
Proof.
 intro H.
 red in |- *; red in H.
 intros e He.
 elim (Archimedes ([1][/] _[//]pos_ap_zero _ _ He)).
 intros k Hk.
 elim (H k); clear H.
 intros N HN.
 exists N.
 intros.
 cut (Dom (f n{-}F) x). intro H0.
  apply leEq_wdl with (AbsIR ((f n{-}F) x H0)).
   eapply leEq_transitive.
    2: apply leEq_transitive with (one_div_succ (R:=IR) k).
     2: apply HN with (n := n); assumption.
    apply norm_bnd_AbsIR; assumption.
   unfold one_div_succ in |- *.
   unfold Snring in |- *.
   apply less_leEq; apply swap_div with (pos_ap_zero _ _ He).
     apply pos_nring_S.
    assumption.
   eapply leEq_less_trans.
    apply Hk.
   simpl in |- *; apply less_plusOne.
  apply AbsIR_wd; simpl in |- *; rational.
 split.
  apply incf; assumption.
 apply incF; assumption.
Qed.

Lemma Cauchy_fun_seq1_seq' : Cauchy_fun_seq1 -> Cauchy_fun_seq'.
Proof.
 intro H.
 red in |- *; red in H.
 intro.
 elim (H k); clear H; intros N HN.
 exists N; intros.
 eapply leEq_transitive.
  2: apply HN with (m := m) (n := n); assumption.
 cut (Dom (f m{-}f n) x). intro H1.
  apply leEq_wdl with (AbsIR (Part _ _ H1)).
   apply norm_bnd_AbsIR; assumption.
  apply AbsIR_wd; simpl in |- *; rational.
 split; simpl in |- *; apply incf; assumption.
Qed.

Lemma Cauchy_fun_seq'_seq1 : Cauchy_fun_seq' -> Cauchy_fun_seq1.
Proof.
 intro H.
 red in |- *; red in H.
 intro.
 elim (H k); clear H; intros N HN.
 exists N; intros.
 apply leEq_Norm_Funct.
 intros x H1 Hx.
 eapply leEq_wdl.
  apply (HN m n H H0 x H1).
 apply AbsIR_wd; simpl in |- *; rational.
Qed.

Lemma Cauchy_fun_seq_seq1 : Cauchy_fun_seq -> Cauchy_fun_seq1.
Proof.
 intro.
 apply Cauchy_fun_seq'_seq1.
 apply Cauchy_fun_seq_seq'.
 assumption.
Qed.

Lemma Cauchy_fun_seq1_seq : Cauchy_fun_seq1 -> Cauchy_fun_seq.
Proof.
 intro.
 apply Cauchy_fun_seq'_seq.
 apply Cauchy_fun_seq1_seq'.
 assumption.
Qed.

(**
A Cauchy sequence of functions is pointwise a Cauchy sequence.
*)

Lemma Cauchy_fun_real : Cauchy_fun_seq -> forall x Hx,
 Cauchy_prop (fun n => Part _ _ (incf n x Hx)).
Proof.
 intros H x Hx.
 red in |- *; red in H.
 intros e He.
 elim (H _ He); clear H; intros N HN.
 exists N.
 intros.
 apply AbsIR_imp_AbsSmall.
 apply HN.
  assumption.
 apply le_n.
Qed.

End Definitions.

Section More_Definitions.

Variables a b : IR.
Hypothesis Hab : a [<=] b.
(* begin hide *)
Let I := Compact Hab.
(* end hide *)

Variable f : nat -> PartIR.
Hypothesis contf : forall n : nat, Continuous_I Hab (f n).

(**
We can also say that [f] is simply convergent if it converges to some
continuous function.  Notice that we do not quantify directly over
partial functions, for reasons which were already explained.
*)

Definition conv_fun_seq := {f' : CSetoid_fun (subset (Compact Hab)) IR |
 {contf' : Continuous_I Hab (PartInt f') |
  conv_fun_seq' a b Hab f (PartInt f') contf contf'}}.

(**
It is useful to extract the limit as a partial function:
*)

(* begin show *)
Hypothesis H : Cauchy_fun_seq _ _ _ f contf.
(* end show *)

Definition Cauchy_fun_seq_Lim : PartIR.
Proof.
 apply Build_PartFunct with (pfpfun := fun x Hx => Lim (Build_CauchySeq _ (fun n : nat =>
   Part _ _ (contin_imp_inc _ _ _ _ (contf n) x Hx)) (Cauchy_fun_real _ _ _ _ contf H x Hx))).
  unfold I in |- *; apply compact_wd.
 intros x y Hx Hy H0.
 elim (Lim_strext _ _ H0).
 intros n Hn.
 simpl in Hn.
 exact (pfstrx _ _ _ _ _ _ Hn).
Defined.

End More_Definitions.

Section Irrelevance_of_Proofs.

(**
** Irrelevance of Proofs

This section contains a number of technical results stating mainly that being a Cauchy sequence or converging to some limit is a property of the sequence itself and independent of the proofs we supply of its continuity or the continuity of its limit.
*)

Variables a b : IR.
Hypothesis Hab : a [<=] b.
(* begin hide *)
Let I := Compact Hab.
(* end hide *)

Variable f : nat -> PartIR.
(* begin show *)
Hypotheses contf contf0 : forall n : nat, Continuous_I Hab (f n).
(* end show *)

Variable F : PartIR.
(* begin show *)
Hypotheses contF contF0 : Continuous_I Hab F.
(* end show *)

Lemma conv_fun_seq'_wd : conv_fun_seq' _ _ _ _ _ contf contF ->
 conv_fun_seq' _ _ _ _ _ contf0 contF0.
Proof.
 intros H e H0.
 elim (H e H0); intros N HN.
 exists N; intros.
 eapply leEq_wdl.
  apply (HN n H1 x Hx).
 apply AbsIR_wd; rational.
Qed.

Lemma Cauchy_fun_seq'_wd : Cauchy_fun_seq' _ _ _ _ contf ->
 Cauchy_fun_seq' _ _ _ _ contf0.
Proof.
 intros H k.
 elim (H k); intros N HN.
 exists N; intros.
 eapply leEq_wdl.
  apply (HN m n H0 H1 x Hx).
 apply AbsIR_wd; rational.
Qed.

Lemma Cauchy_fun_seq2_wd : Cauchy_fun_seq2 _ _ _ _ contf ->
 Cauchy_fun_seq2 _ _ _ _ contf0.
Proof.
 intros H e H0.
 elim (H e H0); intros N HN.
 exists N; intros.
 eapply leEq_wdl.
  apply (HN m H1 x Hx).
 apply AbsIR_wd; rational.
Qed.

Lemma conv_norm_fun_seq_wd : conv_norm_fun_seq _ _ _ _ _ contf contF ->
 conv_norm_fun_seq _ _ _ _ _ contf0 contF0.
Proof.
 intros H k.
 elim (H k); intros N HN.
 exists N; intros.
 eapply leEq_wdl.
  apply (HN n H0).
 apply Norm_Funct_wd.
 apply Feq_reflexive; Included.
Qed.

Lemma Cauchy_fun_seq1_wd : Cauchy_fun_seq1 _ _ _ _ contf ->
 Cauchy_fun_seq1 _ _ _ _ contf0.
Proof.
 intros H k.
 elim (H k); intros N HN.
 exists N; intros.
 eapply leEq_wdl.
  apply (HN m n H0 H1).
 apply Norm_Funct_wd.
 apply Feq_reflexive; Included.
Qed.

End Irrelevance_of_Proofs.

Section More_Proof_Irrelevance.

Lemma conv_fun_seq_wd : forall a b Hab f contf contf0,
 conv_fun_seq a b Hab f contf -> conv_fun_seq a b Hab f contf0.
Proof.
 intros a b Hab f contf contf0 H.
 elim H; intros f' Hf'.
 exists f'.
 elim Hf'; intros contf' H0.
 exists contf'.
 eapply conv_fun_seq'_wd.
 apply H0.
Qed.

End More_Proof_Irrelevance.

Section More_Properties.

(**
** Other Properties

Still more technical details---a convergent sequence converges to its
limit; the limit is a continuous function; and convergence is well
defined with respect to functional equality in the interval [[a,b]].
*)

Variables a b : IR.
Hypothesis Hab : a [<=] b.
(* begin hide *)
Let I := Compact Hab.
(* end hide *)

Variables f g : nat -> PartIR.
(* begin show *)
Hypotheses contf contf0 : forall n, Continuous_I Hab (f n).
Hypotheses contg contg0 : forall n, Continuous_I Hab (g n).
(* end show *)

Lemma Cauchy_conv_fun_seq' : forall H contf',
 conv_fun_seq' _ _ _ _ (Cauchy_fun_seq_Lim _ _ _ f contf H) contf contf'.
Proof.
 intros H contf' e H0.
 elim (H e H0).
 intros N HN.
 exists N.
 intros.
 set (incf := fun n : nat => contin_imp_inc _ _ _ _ (contf n)) in *.
 set (incf' := contin_imp_inc _ _ _ _ contf') in *.
 apply leEq_wdl with (AbsIR (Lim (Cauchy_const (f n x (incf n x Hx))) [-]
   Part (Cauchy_fun_seq_Lim _ _ _ _ _ H) x (incf' x Hx))).
  2: apply AbsIR_wd; apply cg_minus_wd.
   2: apply eq_symmetric_unfolded; apply Lim_const.
  2: algebra.
 simpl in |- *.
 apply leEq_wdl with (AbsIR (Lim (Build_CauchySeq IR _
   (Cauchy_minus (Cauchy_const (Part _ _ (incf n x Hx))) (Build_CauchySeq _ _
     (Cauchy_fun_real _ _ _ _ _ H x (incf' x Hx))))))).
  2: apply AbsIR_wd; apply Lim_minus.
 eapply leEq_wdl.
  2: apply Lim_abs.
 simpl in |- *.
 apply str_seq_leEq_so_Lim_leEq.
 exists N; intros.
 simpl in |- *.
 eapply leEq_wdl.
  apply (HN n i H1 H2 x Hx).
 apply AbsIR_wd; rational.
Qed.

Variables F G : PartIR.
(* begin show *)
Hypotheses contF contF0 : Continuous_I Hab F.
Hypotheses contG contG0 : Continuous_I Hab G.
(* end show *)

Lemma conv_fun_seq'_wdl : (forall n, Feq I (f n) (g n)) ->
 conv_fun_seq' _ _ _ _ _ contf contF -> conv_fun_seq' _ _ _ _ _ contg contF0.
Proof.
 intros H H0 e H1.
 elim (H0 e H1); intros N HN.
 exists N; intros.
 eapply leEq_wdl.
  apply (HN n H2 x Hx).
 apply AbsIR_wd; apply cg_minus_wd.
  elim (H n); intros Haux inc.
  inversion_clear inc.
  auto.
 algebra.
Qed.

Lemma conv_fun_seq'_wdr : Feq I F G ->
 conv_fun_seq' _ _ _ _ _ contf contF -> conv_fun_seq' _ _ _ _ _ contf0 contG.
Proof.
 intros H H0 e H1.
 elim (H0 e H1); intros N HN.
 exists N; intros.
 eapply leEq_wdl.
  apply (HN n H2 x Hx).
 apply AbsIR_wd; apply cg_minus_wd.
  algebra.
 elim H; intros Haux inc.
 inversion_clear inc.
 auto.
Qed.

Lemma conv_fun_seq'_wdl' : (forall n, Feq I (f n) (g n)) ->
 conv_fun_seq' _ _ _ _ _ contf contF -> conv_fun_seq' _ _ _ _ _ contg contF.
Proof.
 intros H H0 e H1.
 elim (H0 e H1); intros N HN.
 exists N; intros.
 eapply leEq_wdl.
  apply (HN n H2 x Hx).
 apply AbsIR_wd; apply cg_minus_wd.
  elim (H n); intros Haux inc.
  inversion_clear inc.
  auto.
 algebra.
Qed.

Lemma conv_fun_seq'_wdr' : Feq I F G ->
 conv_fun_seq' _ _ _ _ _ contf contF -> conv_fun_seq' _ _ _ _ _ contf contG.
Proof.
 intros H H0 e H1.
 elim (H0 e H1); intros N HN.
 exists N; intros.
 eapply leEq_wdl.
  apply (HN n H2 x Hx).
 apply AbsIR_wd; apply cg_minus_wd.
  algebra.
 elim H; intros Haux inc.
 inversion_clear inc.
 auto.
Qed.

Lemma Cauchy_fun_seq_wd : (forall n, Feq I (f n) (g n)) ->
 Cauchy_fun_seq _ _ _ _ contf -> Cauchy_fun_seq _ _ _ _ contg.
Proof.
 intros H H0 e H1.
 elim (H0 e H1); clear H0; intros N HN.
 exists N; intros.
 eapply leEq_wdl.
  apply (HN m n H0 H2 x Hx).
 elim (H n); intros.
 inversion_clear b0.
 elim (H m); intros.
 inversion_clear b0.
 apply AbsIR_wd; algebra.
Qed.

Lemma Cauchy_cont_Lim : forall H : Cauchy_fun_seq a b Hab f contf,
 Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ contf H).
Proof.
 intros.
 split.
  Included.
 intros e He.
 elim (H _ (pos_div_three _ _ He)); intros N HN.
 elim (contf N); intros incf contf'.
 elim (contf' _ (pos_div_three _ _ He)).
 intros d H0 H1.
 exists d.
  assumption.
 intros x y H2 H3 Hx Hy H4.
 cut (forall x y z w : IR, AbsIR (x[-]w) [=] AbsIR (x[-]y[+] (y[-]z) [+] (z[-]w))); intros.
  2: apply AbsIR_wd; rational.
 eapply leEq_wdl.
  2: apply eq_symmetric_unfolded;
    apply H5 with (y := Part _ _ (incf x H2)) (z := Part _ _ (incf y H3)).
 rstepr (e [/]ThreeNZ[+]e [/]ThreeNZ[+]e [/]ThreeNZ).
 eapply leEq_transitive.
  apply triangle_IR.
 apply plus_resp_leEq_both.
  eapply leEq_transitive.
   apply triangle_IR.
  apply plus_resp_leEq_both.
   apply leEq_wdl with (AbsIR (Part _ _ Hx[-]Lim (Cauchy_const (Part _ _ (incf x H2))))).
    2: apply AbsIR_wd; apply cg_minus_wd.
     2: algebra.
    2: apply eq_symmetric_unfolded; apply Lim_const.
   simpl in |- *.
   apply leEq_wdl with (AbsIR (Lim (Build_CauchySeq IR _ (Cauchy_minus
     (Build_CauchySeq _ _ (Cauchy_fun_real _ _ _ _ _ H x Hx)) (Cauchy_const (Part _ _ (incf x H2))))))).
    2: apply AbsIR_wd; apply Lim_minus.
   eapply leEq_wdl.
    2: apply Lim_abs.
   simpl in |- *.
   apply str_seq_leEq_so_Lim_leEq.
   exists N; intros.
   simpl in |- *.
   eapply leEq_wdl.
    apply (HN i N) with (x := x) (Hx := Hx); auto with arith.
   apply AbsIR_wd; rational.
  apply H1; assumption.
 apply leEq_wdl with (AbsIR (Lim (Cauchy_const (Part _ _ (incf y H3))) [-]
   Part (Cauchy_fun_seq_Lim _ _ _ _ _ H) y Hy)).
  2: apply AbsIR_wd; apply cg_minus_wd.
   2: apply eq_symmetric_unfolded; apply Lim_const.
  2: algebra.
 simpl in |- *.
 apply leEq_wdl with (AbsIR (Lim (Build_CauchySeq IR _
   (Cauchy_minus (Cauchy_const (Part _ _ (incf y H3)))
     (Build_CauchySeq _ _ (Cauchy_fun_real _ _ _ _ _ H y Hy)))))).
  2: apply AbsIR_wd; apply Lim_minus.
 eapply leEq_wdl.
  2: apply Lim_abs.
 simpl in |- *.
 apply str_seq_leEq_so_Lim_leEq.
 exists N; intros.
 simpl in |- *.
 eapply leEq_wdl.
  apply (HN N i) with (x := y) (Hx := Hy); auto.
 apply AbsIR_wd; rational.
Qed.

Lemma Cauchy_conv_fun_seq : Cauchy_fun_seq _ _ _ _ contf ->
 conv_fun_seq _ _ _ _ contf.
Proof.
 intro H.
 cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ H)). intro H0.
  exists (IntPartIR (contin_imp_inc _ _ _ _ H0)).
  cut (Continuous_I Hab (PartInt (IntPartIR (contin_imp_inc _ _ _ _ H0)))).
   2: eapply Continuous_I_wd.
    3: apply Cauchy_cont_Lim with (H := H).
   2: FEQ.
   2: simpl in |- *; apply Lim_wd'; intros; algebra.
   intro H2; exists H2.
   intros e H1.
   elim (Cauchy_conv_fun_seq' H H0 e H1); intros N HN.
   exists N; intros.
   eapply leEq_wdl.
    apply (HN n H3 x Hx).
   apply AbsIR_wd; apply cg_minus_wd.
    algebra.
   simpl in |- *; apply Lim_wd'; intros; simpl in |- *; rational.
  simpl in |- *; algebra.
 simpl in |- *; apply Cauchy_cont_Lim.
Qed.

Lemma conv_Cauchy_fun_seq : conv_fun_seq _ _ _ _ contf ->
 Cauchy_fun_seq _ _ _ _ contf.
Proof.
 intro H.
 elim H; intros ff Hff.
 inversion_clear Hff.
 apply conv_Cauchy_fun_seq' with (PartInt ff) x.
 unfold I in |- *; eapply conv_fun_seq'_wd.
 apply X.
Qed.

(**
More interesting is the fact that a convergent sequence of functions converges pointwise as a sequence of real numbers.
*)

Lemma fun_conv_imp_seq_conv : conv_fun_seq' _ _ _ _ _ contf contF -> forall x,
 Compact Hab x -> forall Hxf HxF, Cauchy_Lim_prop2 (fun n => f n x (Hxf n)) (F x HxF).
Proof.
 intros H x H0 Hxf HxF eps H1.
 elim (H eps H1).
 intros N HN.
 exists N; intros.
 apply AbsIR_imp_AbsSmall.
 eapply leEq_wdl.
  apply (HN m H2 x H0).
 apply AbsIR_wd; algebra.
Qed.

(**
And a sequence of real numbers converges iff the corresponding sequence of constant functions converges to the corresponding constant function.
*)

Lemma seq_conv_imp_fun_conv : forall x y, Cauchy_Lim_prop2 x y ->
 forall Hf HF, conv_fun_seq' a b Hab (fun n => [-C-] (x n)) [-C-]y Hf HF.
Proof.
 intros x y H Hf HF e H0.
 elim (H e H0); intros N HN.
 exists N; intros; simpl in |- *.
 apply AbsSmall_imp_AbsIR.
 auto.
Qed.

End More_Properties.

#[global]
Hint Resolve Cauchy_cont_Lim: continuous.

Section Algebraic_Properties.

(**
** Algebraic Properties

We now study how convergence is affected by algebraic operations, and some algebraic properties of the limit function.
*)

Variables a b : IR.
Hypothesis Hab : a [<=] b.
(* begin hide *)
Let I := Compact Hab.
(* end hide *)

Variables f g : nat -> PartIR.
Hypothesis contf : forall n, Continuous_I Hab (f n).
Hypothesis contg : forall n, Continuous_I Hab (g n).

(**
First, the limit function is unique.
*)

Lemma FLim_unique : forall F G HF HG, conv_fun_seq' a b Hab f F contf HF ->
 conv_fun_seq' a b Hab f G contf HG -> Feq (Compact Hab) F G.
Proof.
 intros F G HF HG H H0.
 cut (Cauchy_fun_seq _ _ Hab _ contf). intro H1.
  apply Feq_transitive with (Cauchy_fun_seq_Lim _ _ _ _ _ H1).
   FEQ.
   simpl in |- *.
   apply Limits_unique.
   simpl in |- *.
   eapply fun_conv_imp_seq_conv with (Hab := Hab) (Hxf := fun n : nat =>
     contin_imp_inc _ _ Hab _ (contf n) x Hx'); auto.
   apply H.
  apply Feq_symmetric.
  FEQ.
  simpl in |- *.
  apply Limits_unique.
  simpl in |- *.
  eapply fun_conv_imp_seq_conv with (Hab := Hab) (Hxf := fun n : nat =>
    contin_imp_inc _ _ Hab _ (contf n) x Hx'); auto.
  apply H0.
 apply conv_Cauchy_fun_seq' with F HF; auto.
Qed.

(** Constant sequences (not sequences of constant functions!) always converge.
*)

Lemma fun_Lim_seq_const : forall H contH contH',
 conv_fun_seq' a b Hab (fun n => H) H contH contH'.
Proof.
 exists 0; intros.
 eapply leEq_wdl.
  2: eapply eq_transitive_unfolded.
   2: apply eq_symmetric_unfolded; apply AbsIRz_isz.
  apply less_leEq; assumption.
 apply AbsIR_wd; rational.
Qed.

Lemma fun_Cauchy_prop_const : forall H (contH:Continuous_I Hab H),
 Cauchy_fun_seq a b Hab (fun n => H) (fun n => contH).
Proof.
 intros.
 apply conv_Cauchy_fun_seq' with H contH.
 apply fun_Lim_seq_const.
Qed.

(**
We now prove that if two sequences converge than their sum (difference, product) also converge to the sum (difference, product) of their limits.
*)

Variables F G : PartIR.
Hypothesis contF : Continuous_I Hab F.
Hypothesis contG : Continuous_I Hab G.

(* begin show *)
Hypothesis convF : conv_fun_seq' a b Hab f F contf contF.
Hypothesis convG : conv_fun_seq' a b Hab g G contg contG.
(* end show *)

(* begin hide *)
Let incf (n : nat) := contin_imp_inc _ _ _ _ (contf n).
Let incg (n : nat) := contin_imp_inc _ _ _ _ (contg n).
Let incF := contin_imp_inc _ _ _ _ contF.
Let incG := contin_imp_inc _ _ _ _ contG.
(* end hide *)

Lemma fun_Lim_seq_plus' : forall H H',
 conv_fun_seq' a b Hab (fun n => f n{+}g n) (F{+}G) H H'.
Proof.
 intros H H' e H0.
 elim (convF _ (pos_div_two _ _ H0)); intros Nf HNf.
 elim (convG _ (pos_div_two _ _ H0)); intros Ng HNg.
 cut (Nf <= max Nf Ng); [ intro | apply le_max_l ].
 cut (Ng <= max Nf Ng); [ intro | apply le_max_r ].
 exists (max Nf Ng); intros.
 apply leEq_wdl with (AbsIR (Part _ _ (incf n x Hx) [+]Part _ _ (incg n x Hx) [-]
   (Part _ _ (incF x Hx) [+]Part _ _ (incG x Hx)))).
  2: apply AbsIR_wd; simpl in |- *; algebra.
 apply leEq_wdl with (AbsIR (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx) [+]
   (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)))).
  2: apply AbsIR_wd; simpl in |- *; rational.
 rstepr (e [/]TwoNZ[+]e [/]TwoNZ).
 eapply leEq_transitive.
  apply triangle_IR.
 apply plus_resp_leEq_both.
  unfold incf in |- *; apply HNf; apply le_trans with (max Nf Ng); auto.
 unfold incg in |- *; apply HNg; apply le_trans with (max Nf Ng); auto.
Qed.

Lemma fun_Lim_seq_minus' : forall H H',
 conv_fun_seq' a b Hab (fun n => f n{-}g n) (F{-}G) H H'.
Proof.
 intros H H' e H0.
 elim (convF _ (pos_div_two _ _ H0)); intros Nf HNf.
 elim (convG _ (pos_div_two _ _ H0)); intros Ng HNg.
 cut (Nf <= max Nf Ng); [ intro | apply le_max_l ].
 cut (Ng <= max Nf Ng); [ intro | apply le_max_r ].
 exists (max Nf Ng); intros.
 apply leEq_wdl with (AbsIR (Part _ _ (incf n x Hx) [-]Part _ _ (incg n x Hx) [-]
   (Part _ _ (incF x Hx) [-]Part _ _ (incG x Hx)))).
  2: apply AbsIR_wd; simpl in |- *; algebra.
 apply leEq_wdl with (AbsIR (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx) [-]
   (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)))).
  2: apply AbsIR_wd; simpl in |- *; rational.
 rstepr (e [/]TwoNZ[+]e [/]TwoNZ).
 eapply leEq_transitive.
  apply triangle_IR_minus.
 apply plus_resp_leEq_both.
  unfold incf in |- *; apply HNf; apply le_trans with (max Nf Ng); auto.
 unfold incg in |- *; apply HNg; apply le_trans with (max Nf Ng); auto.
Qed.

Lemma fun_Lim_seq_mult' : forall H H',
 conv_fun_seq' a b Hab (fun n => f n{*}g n) (F{*}G) H H'.
Proof.
 intros.
 set (nF := Norm_Funct contF) in *.
 set (nG := Norm_Funct contG) in *.
 red in |- *; intros.
 set (ee := Min e [1]) in *.
 cut ([0] [<] ee); intros.
  set (eg := ee [/]ThreeNZ[/] _[//]max_one_ap_zero nF) in *.
  set (ef := ee [/]ThreeNZ[/] _[//]max_one_ap_zero nG) in *.
  cut ([0] [<] eg).
   intro Heg.
   cut ([0] [<] ef).
    intro Hef.
    elim (convF _ Hef); intros NF HNF; clear convF.
    elim (convG _ Heg); intros NG HNG; clear convG.
    cut (NF <= max NF NG); [ intro | apply le_max_l ].
    cut (NG <= max NF NG); [ intro | apply le_max_r ].
    exists (max NF NG); intros.
    apply leEq_transitive with ee.
     2: unfold ee in |- *; apply Min_leEq_lft.
    apply leEq_wdl with (AbsIR (Part _ _ (incf n x Hx) [*]Part _ _ (incg n x Hx) [-]
      Part _ _ (incF x Hx) [*]Part _ _ (incG x Hx))).
     2: apply AbsIR_wd; simpl in |- *; algebra.
    apply leEq_wdl with (AbsIR (Part _ _ (incF x Hx) [*]
      (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)) [+]
        (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx)) [*]
          (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx)) [+] Part _ _ (incG x Hx) [*]
            (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx)))).
     2: apply AbsIR_wd; simpl in |- *; rational.
    rstepr (ee [/]ThreeNZ[+]ee [/]ThreeNZ[+]ee [/]ThreeNZ).
    eapply leEq_transitive.
     apply triangle_IR.
    apply plus_resp_leEq_both.
     eapply leEq_transitive.
      apply triangle_IR.
     apply plus_resp_leEq_both.
      eapply leEq_wdl.
       2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult.
      apply leEq_transitive with (Max nF [1][*]AbsIR (Part _ _ (incg n x Hx) [-]Part _ _ (incG x Hx))).
       apply mult_resp_leEq_rht.
        apply leEq_transitive with nF.
         unfold nF in |- *; apply norm_bnd_AbsIR; assumption.
        apply lft_leEq_Max.
       apply AbsIR_nonneg.
      eapply shift_mult_leEq'.
       apply pos_max_one.
      unfold eg in HNG; unfold incg in |- *; apply HNG; apply le_trans with (max NF NG); auto.
     eapply leEq_wdl.
      2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult.
     apply leEq_transitive with (ee [/]ThreeNZ[*]ee [/]ThreeNZ).
      2: astepr (ee [/]ThreeNZ[*][1]); apply mult_resp_leEq_lft.
       apply mult_resp_leEq_both; try apply AbsIR_nonneg.
        eapply leEq_transitive.
         unfold incf in |- *; apply HNF; apply le_trans with (max NF NG); auto.
        unfold ef in |- *.
        apply shift_div_leEq.
         apply pos_max_one.
        astepl (ee [/]ThreeNZ[*][1]); apply mult_resp_leEq_lft.
         apply rht_leEq_Max.
        apply less_leEq; apply shift_less_div; astepl ZeroR; [ apply pos_three | assumption ].
       eapply leEq_transitive.
        unfold incg in |- *; apply HNG; apply le_trans with (max NF NG); auto.
       unfold eg in |- *.
       apply shift_div_leEq.
        apply pos_max_one.
       astepl (ee [/]ThreeNZ[*][1]); apply mult_resp_leEq_lft.
        apply rht_leEq_Max.
       apply less_leEq; apply shift_less_div; astepl ZeroR; [ apply pos_three | assumption ].
      apply shift_div_leEq.
       apply pos_three.
      astepr (Three:IR).
      unfold ee in |- *; apply leEq_transitive with OneR.
       apply Min_leEq_rht.
      apply less_leEq; apply one_less_three.
     apply less_leEq; apply shift_less_div.
      apply pos_three.
     astepl ZeroR; assumption.
    eapply leEq_wdl.
     2: apply eq_symmetric_unfolded; apply AbsIR_resp_mult.
    apply leEq_transitive with (Max nG [1][*]AbsIR (Part _ _ (incf n x Hx) [-]Part _ _ (incF x Hx))).
     apply mult_resp_leEq_rht.
      apply leEq_transitive with nG.
       unfold nG in |- *; apply norm_bnd_AbsIR; assumption.
      apply lft_leEq_Max.
     apply AbsIR_nonneg.
    eapply shift_mult_leEq'.
     apply pos_max_one.
    unfold ef in HNF; unfold incf in |- *; apply HNF; apply le_trans with (max NF NG); auto.
   unfold ef in |- *.
   apply div_resp_pos.
    apply pos_max_one.
   apply shift_less_div; astepl ZeroR; [ apply pos_three | assumption ].
  unfold eg in |- *.
  apply div_resp_pos.
   apply pos_max_one.
  apply shift_less_div; astepl ZeroR; [ apply pos_three | assumption ].
 unfold ee in |- *; apply less_Min.
  assumption.
 apply pos_one.
Qed.

End Algebraic_Properties.

Section More_Algebraic_Properties.

Variables a b : IR.
Hypothesis Hab : a [<=] b.
(* begin hide *)
Let I := Compact Hab.
(* end hide *)

Variables f g : nat -> PartIR.
Hypothesis contf : forall n : nat, Continuous_I Hab (f n).
Hypothesis contg : forall n : nat, Continuous_I Hab (g n).

(**
The same is true if we don't make the limits explicit.
*)

(* begin hide *)
Hypothesis Hf : Cauchy_fun_seq _ _ _ _ contf.
Hypothesis Hg : Cauchy_fun_seq _ _ _ _ contg.
(* end hide *)

Lemma fun_Lim_seq_plus : forall H H', conv_fun_seq' a b Hab (fun n => f n{+}g n)
 (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{+}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H H'.
Proof.
 intros H H' e H0.
 set (F := Cauchy_fun_seq_Lim _ _ _ _ _ Hf) in *.
 cut (Continuous_I Hab F). intro H1.
  2: unfold F in |- *; apply Cauchy_cont_Lim.
 cut (conv_fun_seq' _ _ _ _ _ contf H1).
  2: unfold F in |- *; apply Cauchy_conv_fun_seq'; assumption.
 intro Hf'.
 set (G := Cauchy_fun_seq_Lim _ _ _ _ _ Hg) in *.
 cut (Continuous_I Hab G). intro H2.
  2: unfold G in |- *; apply Cauchy_cont_Lim.
 cut (conv_fun_seq' _ _ _ _ _ contg H2).
  2: unfold G in |- *; apply Cauchy_conv_fun_seq'; assumption.
 intro Hg'.
 apply fun_Lim_seq_plus' with contf contg H1 H2; auto.
Qed.

Lemma fun_Cauchy_prop_plus : forall H, Cauchy_fun_seq a b Hab (fun n => f n{+}g n) H.
Proof.
 intro.
 cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{+}Cauchy_fun_seq_Lim _ _ _ _ _ Hg));
   [ intro H0 | Contin ].
 apply conv_Cauchy_fun_seq'
   with (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{+}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H0.
 apply fun_Lim_seq_plus.
Qed.

Lemma fun_Lim_seq_minus : forall H H', conv_fun_seq' a b Hab (fun n => f n{-}g n)
 (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{-}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H H'.
Proof.
 intros.
 set (F := Cauchy_fun_seq_Lim _ _ _ _ _ Hf) in *.
 cut (Continuous_I Hab F). intro H0.
  2: unfold F in |- *; apply Cauchy_cont_Lim.
 cut (conv_fun_seq' _ _ _ _ _ contf H0).
  2: unfold F in |- *; apply Cauchy_conv_fun_seq'; assumption.
 intro Hf'.
 set (G := Cauchy_fun_seq_Lim _ _ _ _ _ Hg) in *.
 cut (Continuous_I Hab G). intro H1.
  2: unfold G in |- *; apply Cauchy_cont_Lim.
 cut (conv_fun_seq' _ _ _ _ _ contg H1).
  2: unfold G in |- *; apply Cauchy_conv_fun_seq'; assumption.
 intro Hg'.
 apply fun_Lim_seq_minus' with contf contg H0 H1; auto.
Qed.

Lemma fun_Cauchy_prop_minus : forall H, Cauchy_fun_seq a b Hab (fun n => f n{-}g n) H.
Proof.
 intro.
 cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{-}Cauchy_fun_seq_Lim _ _ _ _ _ Hg));
   [ intro H0 | Contin ].
 apply conv_Cauchy_fun_seq'
   with (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{-}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H0.
 apply fun_Lim_seq_minus.
Qed.

Lemma fun_Lim_seq_mult : forall H H', conv_fun_seq' a b Hab (fun n => f n{*}g n)
 (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{*}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H H'.
Proof.
 intros.
 set (F := Cauchy_fun_seq_Lim _ _ _ _ _ Hf) in *.
 cut (Continuous_I Hab F); [ intro H0 | unfold F in |- *; Contin ].
 cut (conv_fun_seq' _ _ _ _ _ contf H0).
  2: unfold F in |- *; apply Cauchy_conv_fun_seq'; assumption.
 intro convF.
 set (G := Cauchy_fun_seq_Lim _ _ _ _ _ Hg) in *.
 cut (Continuous_I Hab G); [ intro H1 | unfold G in |- *; Contin ].
 cut (conv_fun_seq' _ _ _ _ _ contg H1).
  2: unfold G in |- *; apply Cauchy_conv_fun_seq'; assumption.
 intro convG.
 cut (Continuous_I Hab F); [ intro HF' | unfold F, I in |- *; apply Cauchy_cont_Lim; assumption ].
 cut (Continuous_I Hab G); [ intro HG' | unfold G, I in |- *; apply Cauchy_cont_Lim; assumption ].
 apply fun_Lim_seq_mult' with contf contg H0 H1; auto.
Qed.

Lemma fun_Cauchy_prop_mult : forall H, Cauchy_fun_seq a b Hab (fun n => f n{*}g n) H.
Proof.
 intro H.
 cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{*}Cauchy_fun_seq_Lim _ _ _ _ _ Hg));
   [ intro H0 | Contin ].
 apply conv_Cauchy_fun_seq'
   with (Cauchy_fun_seq_Lim _ _ _ _ _ Hf{*}Cauchy_fun_seq_Lim _ _ _ _ _ Hg) H0.
 apply fun_Lim_seq_mult.
Qed.

End More_Algebraic_Properties.

Section Still_More_Algebraic_Properties.

Variables a b : IR.
Hypothesis Hab : a [<=] b.
(* begin hide *)
Let I := Compact Hab.
(* end hide *)

Variable f : nat -> PartIR.
Hypothesis contf : forall n, Continuous_I Hab (f n).
Hypothesis Hf : Cauchy_fun_seq _ _ _ _ contf.

(**
As a corollary, we get the analogous property for the sequence of algebraic inverse functions.
*)

Lemma fun_Lim_seq_inv : forall H H', conv_fun_seq' a b Hab
 (fun n => {--} (f n)) {--} (Cauchy_fun_seq_Lim _ _ _ _ _ Hf) H H'.
Proof.
 intros.
 cut (forall n : nat, Continuous_I Hab ( [-C-][0]{-}f n)). intro H0.
  unfold I in |- *; eapply conv_fun_seq'_wdl with (fun n : nat => [-C-][0]{-}f n) H0 H'.
   intro H1; FEQ; try (apply contin_imp_inc; apply contf).
  cut (Continuous_I Hab (Cauchy_fun_seq_Lim _ _ _ _ _ (fun_Cauchy_prop_const a b Hab [-C-][0]
    (Continuous_I_const _ _ _ _)) {-} Cauchy_fun_seq_Lim _ _ _ _ _ Hf)).
   intros H1.
   apply conv_fun_seq'_wdr with H0 (Cauchy_fun_seq_Lim _ _ _ _ _
     (fun_Cauchy_prop_const a b Hab [-C-][0] (Continuous_I_const _ _ _ _)) {-}
       Cauchy_fun_seq_Lim _ _ _ _ _ Hf) H1.
    apply eq_imp_Feq.
      Included.
     Included.
    intros; simpl in |- *.
    astepr ([0][-]Lim (Build_CauchySeq _ _ (Cauchy_fun_real _ _ _ _ contf Hf x Hx'))).
    apply cg_minus_wd.
     eapply eq_transitive_unfolded.
      2: apply eq_symmetric_unfolded; apply Lim_const.
     apply Lim_wd'; intros; simpl in |- *; algebra.
    apply Lim_wd'; intros; simpl in |- *; rational.
   apply fun_Lim_seq_minus with (f := fun n : nat => [-C-][0]:PartIR).
  Contin.
 Contin.
Qed.

Lemma fun_Cauchy_prop_inv : forall H, Cauchy_fun_seq a b Hab (fun n => {--} (f n)) H.
Proof.
 intro.
 cut (Continuous_I Hab {--} (Cauchy_fun_seq_Lim _ _ _ _ _ Hf)); [ intro H0 | Contin ].
 apply conv_Cauchy_fun_seq' with ( {--} (Cauchy_fun_seq_Lim _ _ _ _ _ Hf)) H0.
 apply fun_Lim_seq_inv.
Qed.

End Still_More_Algebraic_Properties.

#[global]
Hint Resolve Continuous_I_Sum Continuous_I_Sumx Continuous_I_Sum0: continuous.


From Coq Require Import FSets.FMapPositive.
From Velus Require Import Common.
From Velus Require Import Operators.
From Velus Require Import Clocks.
From Velus Require Import IndexedStreams.
From Velus Require Import CoreExpr.CESyntax.
From Velus Require Import CoreExpr.CEClocking.
From Velus Require Import CoreExpr.CESemantics.
From Coq Require Import List.

(** * Link (static) clocking predicates to (dynamic) semantic model *)

(**

These results confirm the correctness of the clocking predicates wrt the
semantics. In particular, they are useful for relating static invariants to
dynamic properties. They hold essentially due to the "additional" clocking
constraints in the NLustre semantic model.

 *)

Module Type CECLOCKINGSEMANTICS
       (Import Ids   : IDS)
       (Import Op    : OPERATORS)
       (Import OpAux : OPERATORS_AUX   Op)
       (Import CESyn : CESYNTAX        Op)
       (Import Str   : INDEXEDSTREAMS  Op OpAux)
       (Import CESem : CESEMANTICS Ids Op OpAux CESyn     Str)
       (Import CEClo : CECLOCKING  Ids Op       CESyn).

  Section ClockMatchInstant.

    Variables
      (vars: list (ident * clock))
      (base: bool)
      (R: env)
      (Hcm: sem_clocked_vars_instant base R vars).

    Lemma clock_match_instant_exp:
      forall le ck,
        wc_exp vars le ck ->
        forall v,
          sem_exp_instant base R le v ->
          (sem_exp_instant base R le absent
           /\ sem_clock_instant base R ck false)
          \/
          ((exists c, sem_exp_instant base R le (present c))
           /\ sem_clock_instant base R ck true).
    Proof.
      induction le; inversion_clear 1.
      - intros.
        destruct base; [right|left]; eauto using sem_exp_instant, sem_clock_instant.
      - inversion_clear 1.
        eapply Forall_forall in Hcm; eauto.
        destruct v.
        + left; split; eauto using sem_exp_instant.
          apply Hcm; auto.
        + right; split; eauto using sem_exp_instant.
          apply Hcm; eauto.
      - inversion_clear 1; eapply Forall_forall in Hcm; eauto.
        + right; split; eauto using sem_exp_instant.
          econstructor; eauto.
          apply Hcm; eauto.
        + left; split; eauto using sem_exp_instant.
          eapply Son_abs2; eauto.
          apply Hcm; eauto.
        + left; split; eauto using sem_exp_instant.
          econstructor; eauto.
          apply Hcm; auto.
      - inversion_clear 1.
        + right; split; eauto using sem_exp_instant.
          edestruct IHle as [(?&?)|(?&?)]; eauto.
          now assert (present c = absent) by sem_det.
        + left; split; eauto using sem_exp_instant.
          edestruct IHle as [(?&?)|((c&?)&?)]; eauto.
          now assert (present c = absent) by sem_det.
      - inversion_clear 1.
        + right; split; eauto using sem_exp_instant.
          edestruct IHle1 as [(?&?)|(?&?)]; eauto.
          now assert (present c1 = absent) by sem_det.
        + left; split; eauto using sem_exp_instant.
          edestruct IHle1 as [(?&?)|((c&?)&?)]; eauto.
          now assert (present c = absent) by sem_det.
    Qed.

    Corollary clock_match_instant_exp_contradiction:
      forall le ck b v,
        wc_exp vars le ck ->
        sem_exp_instant base R le v ->
        sem_clock_instant base R ck b ->
        (b = true <-> v <> absent).
    Proof.
      intros le ck b v WC Hle Hck.
      eapply clock_match_instant_exp in WC as [(Hle' & Hck')|((v' & Hle') & Hck')];
        eauto.
      - apply sem_clock_instant_det with (1:=Hck) in Hck'.
        apply sem_exp_instant_det with (1:=Hle) in Hle'.
        subst; intuition.
      - apply sem_clock_instant_det with (1:=Hck) in Hck'.
        apply sem_exp_instant_det with (1:=Hle) in Hle'.
        subst; intuition; discriminate.
    Qed.

    Lemma clock_match_instant_cexp:
      forall ce ck,
        wc_cexp vars ce ck ->
        forall v,
          sem_cexp_instant base R ce v ->
          (sem_cexp_instant base R ce absent
           /\ sem_clock_instant base R ck false)
          \/
          ((exists c, sem_cexp_instant base R ce (present c))
           /\ sem_clock_instant base R ck true).
    Proof.
      induction ce.
      - repeat inversion_clear 1.
        + repeat match goal with
                 | WC: wc_cexp _ _ _, SL: sem_cexp_instant _ _ _ _ |- _ =>
                   destruct (IHce1 _ WC _ SL) as [(Hv & Hc)|((?c & Hv) & Hc)]
                 | HA: sem_cexp_instant _ _ _ absent,
                   HP: sem_cexp_instant _ _ _ (present ?cv) |- _ =>
                   now assert (present cv = absent) by sem_det
                 end.
          right; split; eauto using sem_cexp_instant. inv Hc; auto.
        + repeat match goal with
                 | WC: wc_cexp _ _ _, SL: sem_cexp_instant _ _ _ _ |- _ =>
                   destruct (IHce2 _ WC _ SL) as [(Hv & Hc)|((?c & Hv) & Hc)]
                 | HA: sem_cexp_instant _ _ _ absent,
                   HP: sem_cexp_instant _ _ _ (present ?cv) |- _ =>
                   now assert (present cv = absent) by sem_det
                 end.
          right; split; eauto using sem_cexp_instant. inv Hc; auto.
        + repeat match goal with
                 | WC: wc_cexp _ _ _, SL: sem_cexp_instant _ _ _ _ |- _ =>
                   destruct (IHce1 _ WC _ SL) as [(Hv & Hc)|((?c & Hv) & Hc)]
                 | HA: sem_cexp_instant _ _ _ absent,
                   HP: sem_cexp_instant _ _ _ (present ?cv) |- _ =>
                   now assert (present cv = absent) by sem_det
                 end.
          left; split; eauto using sem_cexp_instant.
          inv Hc; auto. now assert (present c = absent) by sem_det.
      - repeat inversion_clear 1; [right|left];
          repeat match goal with
                 | WC: wc_cexp _ _ _, SL: sem_cexp_instant _ _ _ _ |- _ =>
                   destruct (IHce1 _ WC _ SL) as [(Hv1 & Hc1)|((?c & Hv1) & Hc1)]
                 | WC: wc_cexp _ _ _, SL: sem_cexp_instant _ _ _ _ |- _ =>
                   destruct (IHce2 _ WC _ SL) as [(Hv2 & Hc2)|((?c & Hv2) & Hc2)]
                 | HA: sem_cexp_instant _ _ _ absent,
                   HP: sem_cexp_instant _ _ _ (present ?cv) |- _ =>
                   now assert (present cv = absent) by sem_det
                 | Hc: sem_exp_instant _ _ _ (present ?c),
                   Ht: sem_cexp_instant _ _ _ (present ?ct),
                   Hf: sem_cexp_instant _ _ _ (present ?cf),
                   Hv: val_to_bool ?c = Some ?b |- _ =>
                   apply (Site_eq _ _ _ _ _ _ _ _ _ Hc Ht Hf) in Hv;
                     destruct b
                 end; eauto using sem_cexp_instant.
      - inversion_clear 1 as [| |? ? Hwc].
        inversion_clear 1.
        eapply clock_match_instant_exp in Hwc; eauto.
        destruct Hwc as [(Hv & Hc)|((?c & Hv) & Hc)]; [left|right];
          eauto using sem_cexp_instant.
    Qed.

  End ClockMatchInstant.

  Section ClockMatch.

    Variables
      (vars: list (ident * clock))
      (bk: stream bool)
      (H: history)
      (Hcm: sem_clocked_vars bk H vars).

    Lemma clock_match_exp:
      forall le ck,
        wc_exp vars le ck ->
        forall n v,
          sem_exp_instant (bk n) (H n) le v ->
          (sem_exp_instant (bk n) (H n) le absent
           /\ sem_clock_instant (bk n) (H n) ck false)
          \/
          ((exists c, sem_exp_instant (bk n) (H n) le (present c))
           /\ sem_clock_instant (bk n) (H n) ck true).
    Proof.
      intros; eapply clock_match_instant_exp with (vars := vars); eauto.
    Qed.

    Corollary clock_match_exp_contradiction:
      forall le ck b v,
        wc_exp vars le ck ->
        forall n,
          sem_exp_instant (bk n) (H n) le v ->
          sem_clock_instant (bk n) (H n) ck b ->
          (b = true <-> v <> absent).
    Proof.
      intros.
      eapply clock_match_instant_exp_contradiction with (vars := vars); eauto.
    Qed.

    Lemma clock_match_cexp:
      forall ce ck,
        wc_cexp vars ce ck ->
        forall n v,
          sem_cexp_instant (bk n) (H n) ce v ->
          (sem_cexp_instant (bk n) (H n) ce absent
           /\ sem_clock_instant (bk n) (H n) ck false)
          \/
          ((exists c, sem_cexp_instant (bk n) (H n) ce (present c))
           /\ sem_clock_instant (bk n) (H n) ck true).
    Proof.
      intros; eapply clock_match_instant_cexp with (vars := vars); eauto.
    Qed.

  End ClockMatch.

 (* Transfer named streams defined within the body of a node ([R']) out into
     the environment where the node is instantiated ([R]). *)
  Lemma sem_var_instant_transfer_out_instant:
    forall (xin : list (ident * (type * clock)))
      (xout : list (ident * (type * clock)))
      R R' les ys sub base lss yss,
      NoDupMembers (xin ++ xout) ->
      Forall2 (fun xtc le => SameVar (sub (fst xtc)) le) xin les ->
      Forall2 (fun xtc  y => sub (fst xtc) = Some y) xout ys ->
      sem_vars_instant R' (map fst xin) lss ->
      sem_vars_instant R' (map fst xout) yss ->
      sem_exps_instant base R les lss ->
      sem_vars_instant R ys yss ->
      forall x y ys,
        InMembers x (xin ++ xout) ->
        sub x = Some y ->
        sem_var_instant R' x ys ->
        sem_var_instant R y ys.
  Proof.
    intros * Hndup Hsv Hos Hxin Hxout Hles Hys * Hin Hsub Hxv.
    apply InMembers_app in Hin as [Hin|Hout].
    - clear Hxout Hys Hos.
      apply NoDupMembers_app_InMembers with (2:=Hin) in Hndup.
      apply InMembers_In in Hin as ((xty & xck) & Hin).
      unfold sem_exps_instant in Hles.
      unfold sem_vars_instant in Hxin.
      rewrite Forall2_map_1 in Hxin.
      rewrite Forall2_swap_args in Hles.
      apply Forall2_trans_ex with (1:=Hxin) in Hles. clear Hxin.
      rewrite Forall2_swap_args in Hsv.
      apply Forall2_trans_ex with (1:=Hles) in Hsv. clear Hles.
      apply Forall2_same in Hsv.
      eapply Forall_forall in Hsv
        as (le & Hle & (ls & Hlsin & Hxls & Hlels) & Hsveq); eauto.
      simpl in *.
      rewrite Hsub in Hsveq; inv Hsveq.
      inversion_clear Hlels.
      apply sem_var_instant_det with (1:=Hxv) in Hxls.
      now rewrite Hxls in *.
    - clear Hsv Hxin Hles.
      apply InMembers_In in Hout as ((xty & xck) & Hout).
      unfold sem_vars_instant in Hxout, Hys.
      rewrite Forall2_map_1 in Hxout.
      rewrite Forall2_swap_args in Hys.
      apply Forall2_trans_ex with (1:=Hxout) in Hys. clear Hxout.
      rewrite Forall2_swap_args in Hos.
      apply Forall2_trans_ex with (1:=Hys) in Hos. clear Hys.
      apply Forall2_same in Hos.
      eapply Forall_forall in Hos
        as (z & Hz & (v & Hvin & Hv & Hzv) & Hsub'); eauto.
      simpl in *.
      rewrite Hsub in Hsub'; inversion_clear Hsub'.
      apply sem_var_instant_det with (1:=Hxv) in Hv.
      now rewrite Hv in *.
  Qed.

  Corollary sem_var_instant_transfer_out:
    forall (xin : list (ident * (type * clock)))
      (xout : list (ident * (type * clock)))
      H H' les ys sub bk lss yss,
      NoDupMembers (xin ++ xout) ->
      Forall2 (fun xtc le => SameVar (sub (fst xtc)) le) xin les ->
      Forall2 (fun xtc  y => sub (fst xtc) = Some y) xout ys ->
      sem_vars H' (map fst xin) lss ->
      sem_vars H' (map fst xout) yss ->
      sem_exps bk H les lss ->
      sem_vars H ys yss ->
      forall x y ys,
        InMembers x (xin ++ xout) ->
        sub x = Some y ->
        forall n,
          sem_var_instant (H' n) x ys ->
          sem_var_instant (H  n) y ys.
  Proof.
    intros; eapply sem_var_instant_transfer_out_instant; eauto.
  Qed.

  (* Using the transfer of named streams, also transfer clocks from
     the interface. *)
  Lemma sem_clock_instant_transfer_out_instant:
    forall vars ck sub base base' R R' xck yck v,
      instck ck sub xck = Some yck ->
      sem_clock_instant base R ck base' ->
      wc_clock vars xck ->
      sem_clock_instant base' R' xck v ->
      (forall x y ys,
          InMembers x vars ->
          sub x = Some y ->
          sem_var_instant R' x ys ->
          sem_var_instant R y ys) ->
      sem_clock_instant base R yck v.
  Proof.
    intros * Hinst Hcks Hwc Hsem Hxv.
    revert xck ck yck v Hinst Hcks Hwc Hsem.
    induction xck; simpl in *.
    - inversion 1; inversion 3; now subst.
    - intros ck yck v Hinst Hcks Hwc Hsem.
      destruct (instck ck sub xck) eqn:Hi; try discriminate.
      destruct (sub i) eqn:Hsi; try discriminate.
      inv Hinst. inversion_clear Hwc as [|???? Hin].
      apply In_InMembers in Hin.
      inv Hsem; eauto using sem_clock_instant.
  Qed.

  Corollary sem_clock_instant_transfer_out:
    forall vars ck sub bk bk' (H: history) H' xck yck v n,
      instck ck sub xck = Some yck ->
      sem_clock_instant (bk n) (H n) ck (bk' n) ->
      wc_clock vars xck ->
      sem_clock_instant (bk' n) (H' n) xck v ->
      (forall x y ys,
          InMembers x vars ->
          sub x = Some y ->
          sem_var_instant (H' n) x ys ->
          sem_var_instant (H  n) y ys) ->
      sem_clock_instant (bk n) (H n) yck v.
  Proof.
    intros; eapply sem_clock_instant_transfer_out_instant; eauto.
  Qed.

  (* Transfer interface variable values onto interface clocks between
     an external environment ([Hn]) and an internal one ([Hn']). *)
  Lemma clock_vars_to_sem_clock_instant:
    forall vars bkn Hn Hn' ss,
      Forall2 (fun xtc => sem_var_instant Hn (fst xtc)) vars ss ->
      Forall2 (fun xtc => sem_var_instant Hn' (fst xtc)) vars ss ->
      wc_env (idck vars) ->
      forall x (xty: type) xck v,
        In (x, (xty, xck)) vars ->
        sem_clock_instant bkn Hn xck v ->
        sem_clock_instant bkn Hn' xck v.
  Proof.
    intros vars bkn Hn Hn' ss HHn HHn' WCenv x xty xck v Hin Hsi.
    assert (exists xty, In (x, (xty, xck)) vars) as Hin' by eauto.
    apply In_idck_exists in Hin'.
    apply wc_env_var with (2:=Hin') in WCenv.
    clear Hin Hin' xty.
    apply Forall2_Forall2 with (1:=HHn') in HHn. clear HHn'.
    revert v Hsi. induction xck.
    - inversion_clear 1; eauto using sem_clock_instant.
    - inversion_clear WCenv as [|? ? ? WCx Hin].
      specialize (IHxck WCx).
      apply In_idck_exists in Hin as (xty & Hin).
      apply Forall2_in_left with (2:=Hin) in HHn.
      destruct HHn as (s & Hsin & Hv' & Hv).
      inversion_clear 1.
      + econstructor; eauto.
        assert (s = present c) as Hsc by (eapply sem_var_instant_det; eauto).
        now subst.
      + econstructor; eauto.
        assert (s = absent) as Hsc by (eapply sem_var_instant_det; eauto).
        now subst.
      + eapply Son_abs2; eauto.
        assert (s = present c) as Hsc by (eapply sem_var_instant_det; eauto).
        now subst.
  Qed.

End CECLOCKINGSEMANTICS.

Module CEClockingSemanticsFun
       (Import Ids   : IDS)
       (Import Op    : OPERATORS)
       (Import OpAux : OPERATORS_AUX   Op)
       (Import CESyn : CESYNTAX        Op)
       (Import Str   : INDEXEDSTREAMS  Op OpAux)
       (Import CESem : CESEMANTICS Ids Op OpAux CESyn     Str)
       (Import CEClo : CECLOCKING  Ids Op       CESyn)
<: CECLOCKINGSEMANTICS Ids Op OpAux CESyn Str CESem CEClo.
  Include CECLOCKINGSEMANTICS Ids Op OpAux CESyn Str CESem CEClo.
End CEClockingSemanticsFun.


(* begin hide *)
From Coq Require Import
     Classes.Morphisms
     Classes.RelationClasses
     Lists.List
     Relations
     Logic.ProofIrrelevance.

From Heapster2 Require Import
     Permissions.
(* end hide *)

Section SPred.
  Context (config : Type).
  Context (spred1 spred2 : config -> Prop).
  (* spred1 is a subset of spred2 *)
  Context (Hspred: forall x, spred1 x -> spred2 x).

  Definition lift1 (p : {x | spred2 x} -> Prop) : {x | spred1 x} -> Prop.
    intros []. apply p. econstructor. apply Hspred. apply s.
  Defined.
  Definition lift2 (p : relation {x | spred2 x}) :
    relation {x | spred1 x}.
    intros [] []. apply p.
    - econstructor. apply Hspred. apply s.
    - econstructor. apply Hspred. apply s0.
  Defined.

  Program Definition restrict (p : @perm { x | spred2 x }) : @perm { x | spred1 x } :=
    {|
      rely := lift2 (rely p);
      guar := lift2 (guar p);
      pre := lift1 (pre p);
    |}.
  Next Obligation.
    constructor; repeat intro.
    - destruct x. cbn. reflexivity.
    - destruct x, y, z. cbn. etransitivity; eauto.
  Qed.
  Next Obligation.
    constructor; repeat intro.
    - destruct x. cbn. reflexivity.
    - destruct x, y, z. cbn. etransitivity; eauto.
  Qed.
  Next Obligation.
    cbn. respects.
  Qed.

  (* smaller perm has smaller config type *)
  (* Definition hlte_perm1 (p : @perm { x | spred1 x }) (q : @perm { x | spred2 x }) : Prop := *)
  (*   lte_perm p (restrict q). *)

  (* smaller perm has bigger config type *)
  Definition hlte_perm2 (p : @perm { x | spred2 x }) (q : @perm { x | spred1 x }) : Prop :=
    lte_perm (restrict p) q.

  (* Program Definition Restrict (P : @Perms { x | spred2 x }) : @Perms { x | spred1 x } := *)
  (*   {| *)
  (*     in_Perms (p : @perm { x | spred1 x }) := *)
  (*     (* p' <= p, but p' has the bigger config type *) *)
  (*     exists (p' : @perm { x | spred2 x }), hlte_perm2 p' p /\ p' ∈ P; *)
  (*   |}. *)
  (* Next Obligation. *)
  (*   exists H. split; auto. unfold hlte_perm2 in *. etransitivity; eauto. *)
  (* Qed. *)

  (* Definition hlte_Perms1 (P : @Perms { x | spred1 x }) (Q : @Perms { x | spred2 x }) : Prop := *)
  (*   lte_Perms P (Restrict Q). *)

  (* Definition hlte_Perms2 (P : @Perms { x | spred2 x }) (Q : @Perms { x | spred1 x }) : Prop := *)
  (*   lte_Perms (Restrict P) Q. *)

End SPred.

(*
Section SPred2.
  Context (config specConfig : Type).
  Context (spred1 spred1' : config -> Prop).
  Context (spred2 spred2' : specConfig -> Prop).
  (* spred1 is a subset of spred1' *)
  Context (Hspred1: forall x, spred1 x -> spred1' x).
  Context (Hspred2: forall x, spred2 x -> spred2' x).

  Definition lift21 (p : {x | spred1' x} * {x | spred2' x} -> Prop) :
    {x | spred1 x} * {x | spred2 x} -> Prop.
    intros [[] []]. apply p. split.
    - econstructor. apply Hspred1. apply s.
    - econstructor. apply Hspred2. apply s0.
  Defined.
  Definition lift22 (p : relation ({x | spred1' x} * {x | spred2' x})) :
    relation ({x | spred1 x} * {x | spred2 x}).
    intros [[] []] [[] []]. apply p.
    - split.
      + econstructor. apply Hspred1. apply s.
      + econstructor. apply Hspred2. apply s0.
    - split.
      + econstructor. apply Hspred1. apply s1.
      + econstructor. apply Hspred2. apply s2.
  Defined.

  Program Definition restrict2 (p : @perm ({x | spred1' x} * {x | spred2' x})) :
    @perm ({x | spred1 x} * {x | spred2 x}) :=
    {|
      rely := lift22 (rely p);
      guar := lift22 (guar p);
      pre := lift21 (pre p);
    |}.
  Next Obligation.
    constructor; repeat intro.
    - destruct x as [[] []]. cbn. reflexivity.
    - destruct x as [[] []], y as [[] []], z as [[] []]. cbn. etransitivity; eauto.
  Qed.
  Next Obligation.
    constructor; repeat intro.
    - destruct x as [[] []]. cbn. reflexivity.
    - destruct x as [[] []], y as [[] []], z as [[] []]. cbn. etransitivity; eauto.
  Qed.
  Next Obligation.
    cbn. respects.
  Qed.

End SPred2.
*)

Lemma restrict_same config (spred : config -> Prop) p
      (H : forall x, spred x -> spred x) :
  restrict _ _ _ H p ≡≡ p.
Proof.
  split.
  {
    unfold restrict. constructor; cbn; auto.
    - unfold lift1. intros [] ?. rewrite (proof_irrelevance _ (H x s) s); auto.
    - unfold lift2. intros [] [] ?.
      rewrite (proof_irrelevance _ (H x s) s); auto.
      rewrite (proof_irrelevance _ (H x0 s0) s0); auto.
    - unfold lift2. intros [] [] ?.
      rewrite (proof_irrelevance _ s (H x s)); auto.
      rewrite (proof_irrelevance _ s0 (H x0 s0)); auto.
  }
  {
    unfold restrict. constructor; cbn; auto.
    - unfold lift1. intros [] ?. rewrite (proof_irrelevance _ s (H x s)); auto.
    - unfold lift2. intros [] [] ?.
      rewrite (proof_irrelevance _ s (H x s)); auto.
      rewrite (proof_irrelevance _ s0 (H x0 s0)); auto.
    - unfold lift2. intros [] [] ?.
      rewrite (proof_irrelevance _ (H x s) s); auto.
      rewrite (proof_irrelevance _ (H x0 s0) s0); auto.
  }
Qed.

Lemma restrict_restrict config (spred1 spred2 spred3 : config -> Prop) p
      (H12 : forall x, spred1 x -> spred2 x)
      (H23 : forall x, spred2 x -> spred3 x) :
  restrict _ _ _ (fun (x : config) (H : spred1 x) => H23 x (H12 x H)) p ≡≡
  restrict _ _ _ H12 (restrict _ _ _ H23 p).
Proof.
  split.
  {
    intros. constructor.
    - intros [] ?. apply H; auto.
    - intros [] [] ?. apply H; auto.
    - intros [] [] ?. apply H; auto.
  }
  {
    intros. constructor.
    - intros [] ?. apply H; auto.
    - intros [] [] ?. apply H; auto.
    - intros [] [] ?. apply H; auto.
  }
Qed.

(*
Lemma restrict_restrict config (spred1 spred2 spred3 : config -> Prop) p q
      (H12 : forall x, spred1 x -> spred2 x)
      (H23 : forall x, spred2 x -> spred3 x) :
  restrict _ _ _ (fun (x : config) (H : spred1 x) => H23 x (H12 x H)) p <= q ->
  restrict _ _ _ H12 (restrict _ _ _ H23 p) <= q.
Proof.
  intros. constructor.
  - intros [] ?. apply H; auto.
  - intros [] [] ?. apply H; auto.
  - intros [] [] ?. apply H; auto.
Qed.
Lemma restrict_restrict' config (spred1 spred2 spred3 : config -> Prop) p q
      (H12 : forall x, spred1 x -> spred2 x)
      (H23 : forall x, spred2 x -> spred3 x) :
  restrict _ _ _ H12 (restrict _ _ _ H23 p) <= q ->
  restrict _ _ _ (fun (x : config) (H : spred1 x) => H23 x (H12 x H)) p <= q.
Proof.
  intros. constructor.
  - intros [] ?. apply H; auto.
  - intros [] [] ?. apply H; auto.
  - intros [] [] ?. apply H; auto.
Qed.
*)

Lemma lte_perm_restrict config (spred1 spred2 : config -> Prop) (p1 p2 : perm)
  (Hspred : forall x, spred1 x -> spred2 x) :
  p1 <= p2 ->
  restrict _ _ _ Hspred p1 <= restrict _ _ _ Hspred p2.
Proof.
  intros. constructor; intros.
  - destruct x. apply H; auto.
  - destruct x, y. apply H; auto.
  - destruct x, y. apply H; auto.
Qed.

(* Lemma hlte_perm1_reflexive config (spred : config -> Prop) p H : *)
(*   hlte_perm1 config spred spred H p p. *)
(* Proof. *)
(*   unfold hlte_perm1. rewrite restrict_same. reflexivity. *)
(* Qed. *)

(* Lemma hlte_perm1_transitive config (spred1 spred2 spred3 : config -> Prop) (p1 p2 p3 : perm) *)
(*       (H12 : forall x, spred1 x -> spred2 x) *)
(*       (H23 : forall x, spred2 x -> spred3 x) : *)
(*   hlte_perm1 _ _ _ H12 p1 p2 -> *)
(*   hlte_perm1 _ _ _ H23 p2 p3 -> *)
(*   hlte_perm1 _ _ _ ((fun (x : config) (H : spred1 x) => H23 x (H12 x H))) p1 p3. *)
(* Proof. *)
(*   intros. unfold hlte_perm1 in *. etransitivity; eauto. *)
(*   clear H. constructor. *)
(*   - destruct H0 as [? _ _]. *)
(*     intros [] ?. cbn in *. apply pre_inc. cbn. apply H. *)
(*   - destruct H0 as [_ ? _]. *)
(*     intros [] [] ?. cbn in *. apply rely_inc. cbn. apply H. *)
(*   - destruct H0 as [_ _ ?]. *)
(*     intros [] [] ?. cbn in *. *)
(*     specialize (guar_inc _ _ H). (* same as before but slightly cumbersome *) *)
(*     apply guar_inc. *)
(* Qed. *)

Lemma hlte_perm2_reflexive config (spred : config -> Prop) H p :
  hlte_perm2 config spred spred H p p.
Proof.
  unfold hlte_perm2. rewrite restrict_same. reflexivity.
Qed.

Lemma hlte_perm2_transitive config (spred1 spred2 spred3 : config -> Prop) (p1 p2 p3 : perm)
      (H12 : forall x, spred2 x -> spred1 x)
      (H23 : forall x, spred3 x -> spred2 x) :
  hlte_perm2 _ _ _ H12 p1 p2 ->
  hlte_perm2 _ _ _ H23 p2 p3 ->
  hlte_perm2 _ _ _ ((fun (x : config) (H : spred3 x) => H12 x (H23 x H))) p1 p3.
Proof.
  intros. unfold hlte_perm2 in *. etransitivity; eauto.
  clear H0. constructor.
  - destruct H as [? _ _].
    intros [] ?. cbn in *.
    specialize (pre_inc _ H). cbn in pre_inc.
    apply pre_inc.
  - destruct H as [_ ? _].
    intros [] [] ?. cbn in *.
    specialize (rely_inc _ _ H).
    apply rely_inc.
  - destruct H as [_ _ ?].
    intros [] [] ?. cbn in *.
    apply guar_inc. apply H.
Qed.

Lemma separate_restrict config (spred1 spred2 : config -> Prop) (p1 p2 : perm)
      (Hspred : forall x, spred1 x -> spred2 x) :
  p1 ⊥ p2 ->
  (restrict _ _ _ Hspred p1) ⊥ (restrict _ _ _ Hspred p2).
Proof.
  intros. constructor.
  - intros [] [] ?. apply H; auto.
  - intros [] [] ?. apply H; auto.
Qed.

(* only makes sense when the smaller permission also has a smaller spred (actually no) *)
(* Lemma h_sep_antimonotone config (spred1 spred2 : config -> Prop) (p1 p2 p2' : perm) *)
(*       (Hspred : forall x, spred1 x -> spred2 x) : *)
(*   p1 ⊥ p2 -> *)
(*   hlte_perm1 _ _ _ Hspred p2' p2 -> *)
(*   (restrict _ _ _ Hspred p1) ⊥ p2'. *)
(* Proof. *)
(*   intros. *)
(*   eapply separate_antimonotone; eauto. *)
(*   apply separate_restrict; auto. *)
(* Qed. *)

Lemma restrict_sep_conj config (spred1 spred2 : config -> Prop) Hspred p1 p2 :
  restrict config spred1 spred2 Hspred p1 ** restrict config spred1 spred2 Hspred p2 <=
  restrict config spred1 spred2 Hspred (p1 ** p2).
Proof.
  constructor.
  - intros [] (? & ? & ?). split; [| split]; auto. apply separate_restrict; auto.
  - intros [] [] ?. auto.
  - intros [] [] ?. induction H.
    + destruct x1, y. destruct H; constructor; auto.
    + destruct x1, y, z. cbn in *. econstructor 2; eauto.
Qed.

(* the converse is not true *)
Lemma restrict_sep_conj' config (spred1 spred2 : config -> Prop) Hspred p1 p2 :
  restrict config spred1 spred2 Hspred (p1 ** p2) <=
  restrict config spred1 spred2 Hspred p1 ** restrict config spred1 spred2 Hspred p2.
Proof.
  constructor.
  - intros [] (? & ? & ?). split; [| split]; auto.
Abort.

(* Lemma lte_Perms_Restrict config (spred1 spred2 : config -> Prop) (P1 P2 : Perms) *)
(*   (Hspred : forall x, spred1 x -> spred2 x) : *)
(*   P1 ⊑ P2 -> *)
(*   Restrict _ _ _ Hspred P1 ⊑ Restrict _ _ _ Hspred P2. *)
(* Proof. *)
(*   repeat intro. destruct H0 as (p2 & Hhlte & Hp2). *)
(*   exists p2. split; auto. *)
(* Qed. *)

(* Lemma in_Perms_Restrict config (spred1 spred2 : config -> Prop) p P *)
(*   (Hspred : forall x, spred1 x -> spred2 x) : *)
(*   p ∈ P -> *)
(*   restrict _ _ _ Hspred p ∈ Restrict _ _ _ Hspred P. *)
(* Proof. *)
(*   repeat intro. exists p. split; auto. unfold hlte_perm2. reflexivity. *)
(* Qed. *)

(* Lemma hlte_Perms1_transitive config (spred1 spred2 spred3 : config -> Prop) (P1 P2 P3 : Perms) *)
(*       (H12 : forall x, spred1 x -> spred2 x) *)
(*       (H23 : forall x, spred2 x -> spred3 x) : *)
(*   hlte_Perms1 _ _ _ H12 P1 P2 -> *)
(*   hlte_Perms1 _ _ _ H23 P2 P3 -> *)
(*   hlte_Perms1 _ _ _ ((fun (x : config) (H : spred1 x) => H23 x (H12 x H))) P1 P3. *)
(* Proof. *)
(*   intros. unfold hlte_Perms1 in *. etransitivity; eauto. *)
(*   clear H. intros p Hp. destruct Hp as (p3 & Hhlte & Hp3). *)
(*   exists (restrict _ _ _ H23 p3). split. *)
(*   2: { apply H0. apply in_Perms_Restrict; auto. } *)
(*   unfold hlte_perm2 in *. rewrite <- restrict_restrict. apply Hhlte. *)
(* Qed. *)

(* Lemma hlte_Perms2_transitive config (spred1 spred2 spred3 : config -> Prop) (P1 P2 P3 : Perms) *)
(*       (H12 : forall x, spred2 x -> spred1 x) *)
(*       (H23 : forall x, spred3 x -> spred2 x) : *)
(*   hlte_Perms2 _ _ _ H12 P1 P2 -> *)
(*   hlte_Perms2 _ _ _ H23 P2 P3 -> *)
(*   hlte_Perms2 _ _ _ ((fun (x : config) (H : spred3 x) => H12 x (H23 x H))) P1 P3. *)
(* Proof. *)
(*   intros. unfold hlte_Perms2 in *. etransitivity; eauto. *)
(*   intros p Hp. destruct Hp as (p2 & Hhlte & Hp2). *)
(*   apply H in Hp2. destruct Hp2 as (p1 & Hhlte' & Hp1). *)
(*   cbn. exists p1. split; auto. *)
(*   unfold hlte_perm2 in *. etransitivity; eauto. rewrite restrict_restrict. *)
(*   apply lte_perm_restrict. auto. *)
(* Qed. *)

Section PermSet.
  Context {config : Type}.

  Record Perms2 :=
    {
      in_Perms2 : forall {spred}, @perm { x | spred x } -> Prop;
      Perms2_upwards_closed : forall (spred1 spred2 : config -> Prop)
                                (Hspred : forall x, spred1 x -> spred2 x)
                                (p1 : @perm {x | spred2 x}) (p2 : @perm {x | spred1 x}),
        in_Perms2 p1 ->
        hlte_perm2 config spred1 spred2 Hspred p1 p2 ->
        in_Perms2 p2 (* p2 has smaller spred *)
    }.
  Notation "p ∈2 P" := (in_Perms2 P p) (at level 60).

  Definition lte_Perms2 (P Q : Perms2) : Prop :=
    forall spred (p : @perm {x | spred x}), p ∈2 Q -> p ∈2 P.
  Notation "P ⊑2 Q" := (lte_Perms2 P Q) (at level 60).

  Global Instance lte_Perms2_is_preorder : PreOrder lte_Perms2.
  Proof.
    constructor; repeat intro; auto.
  Qed.

  Definition eq_Perms2 (P Q : Perms2) : Prop := P ⊑2 Q /\ Q ⊑2 P.
  Notation "P ≡2 Q" := (eq_Perms2 P Q) (at level 60).

  Global Instance Equivalence_eq_Perms2 : Equivalence eq_Perms2.
  Proof.
    constructor; repeat intro.
    - split; reflexivity.
    - destruct H; split; auto.
    - destruct H, H0. split; etransitivity; eauto.
  Qed.

  Global Instance Proper_eq_Perms2_lte_Perms2 :
    Proper (eq_Perms2 ==> eq_Perms2 ==> Basics.flip Basics.impl) lte_Perms2.
  Proof.
    do 5 red. intros. etransitivity. apply H. etransitivity. apply H1. apply H0.
  Qed.

  (* don't know how to write proper instance for this *)
  Lemma eq_Perms2_eq_perm_in_Perms2 spred P P' p p':
    in_Perms2 P p ->
    P ≡2 P' ->
    p ≡≡ p' ->
    @in_Perms2 P' spred p'.
  Proof.
    intros. apply H0. eapply Perms2_upwards_closed; eauto.
    red. rewrite restrict_same. apply H1.
    Unshelve. all: auto.
  Qed.

  Definition entails_Perms2 P Q := Q ⊑2 P.
  Notation "P ⊨2 Q" := (entails_Perms2 P Q) (at level 60).

  Global Instance entails_Perms2_preorder : PreOrder entails_Perms2.
  Proof.
    constructor; repeat intro; auto.
  Qed.

  Global Instance Proper_eq_Perms2_entails_Perms2 :
    Proper (eq_Perms2 ==> eq_Perms2 ==> Basics.flip Basics.impl) entails_Perms2.
  Proof.
    do 6 red. intros. rewrite H. rewrite H0. auto.
  Qed.

  Program Definition top_Perms2 : Perms2 :=
    {|
      in_Perms2 := fun _ _ => False
    |}.
  Program Definition bottom_Perms2 : Perms2 :=
    {|
      in_Perms2 := fun _ _ => True
    |}.

  Program Definition sep_conj_Perms2 (P Q : Perms2) : Perms2 :=
    {|
      in_Perms2 := fun spred (r : @perm {x | spred x}) =>
                     exists (p q : @perm {x | spred x}),
                       p ∈2 P /\
                         q ∈2 Q /\
                         p ** q <= r
    |}.
  Next Obligation.
    rename H into p, H1 into q, H2 into Hp, H3 into Hq.
    exists (restrict _ _ _ Hspred p), (restrict _ _ _ Hspred q). split; [| split].
    - eapply Perms2_upwards_closed. apply Hp. red. reflexivity.
    - eapply Perms2_upwards_closed. apply Hq. red. reflexivity.
    - etransitivity. apply restrict_sep_conj.
      etransitivity. apply lte_perm_restrict; eauto. apply H0.
  Qed.
  Notation "P *2 Q" := (sep_conj_Perms2 P Q) (at level 60).

  Lemma lte_l_sep_conj_Perms2 : forall P Q, P ⊑2 (P *2 Q).
  Proof.
    intros P Q ? p' ?. destruct H as [p [q [? [? ?]]]].
    eapply Perms2_upwards_closed; eauto.
    eapply hlte_perm2_transitive.
    - apply lte_l_sep_conj_perm.
    - red. do 2 rewrite restrict_same. apply H1.
      Unshelve. all: auto.
  Qed.

  Lemma lte_r_sep_conj_Perms2 : forall P Q, Q ⊑2 (P *2 Q).
  Proof.
    intros P Q ? p' ?. destruct H as [p [q [? [? ?]]]].
    eapply Perms2_upwards_closed; eauto.
    eapply hlte_perm2_transitive.
    - red. apply lte_r_sep_conj_perm.
    - red. do 2 rewrite restrict_same. eapply H1.
      Unshelve. all: auto.
  Qed.

  Lemma sep_conj_Perms2_bottom_identity : forall P, bottom_Perms2 *2 P ≡2 P.
  Proof.
    constructor; repeat intro.
    - exists bottom_perm, p. split; simpl; [auto | split; auto].
      rewrite sep_conj_perm_commut. apply sep_conj_perm_bottom.
    - destruct H as [? [? [_ [? ?]]]].
      eapply (Perms2_upwards_closed P); eauto.
      eapply hlte_perm2_transitive.
      + apply lte_r_sep_conj_perm.
      + red. do 2 rewrite restrict_same. apply H0.
        Unshelve. all: auto.
  Qed.

  Lemma sep_conj_Perms2_top_absorb : forall P, top_Perms2 *2 P ≡2 top_Perms2.
  Proof.
    constructor; repeat intro.
    - inversion H.
    - destruct H as [? [_ [[] _]]].
  Qed.

  Lemma sep_conj_Perms2_monotone : forall P P' Q Q', P' ⊑2 P -> Q' ⊑2 Q -> (P' *2 Q') ⊑2 (P *2 Q).
  Proof.
    repeat intro. destruct H1 as [? [? [? [? ?]]]].
    exists x, x0. auto.
  Qed.

  Lemma sep_conj_Perms2_perm: forall {spred} P Q (p q : @perm {x : config | spred x}),
      p ∈2 P ->
      q ∈2 Q ->
      p ** q ∈2 (P *2 Q).
  Proof.
    intros. exists p, q. split; auto. split; auto. reflexivity.
  Qed.

  Lemma sep_conj_Perms2_commut : forall P Q, (P *2 Q) ≡2 (Q *2 P).
  Proof.
    split; repeat intro.
    - destruct H as [q [p' [? [? ?]]]].
      exists p', q. split; [| split]; auto. etransitivity; eauto. apply sep_conj_perm_commut.
    - destruct H as [p' [q [? [? ?]]]].
      exists q, p'. split; [| split]; auto. etransitivity; eauto. apply sep_conj_perm_commut.
  Qed.

  Lemma sep_conj_Perms2_assoc : forall P Q R, (P *2 (Q *2 R)) ≡2 ((P *2 Q) *2 R).
  Proof.
    split; repeat intro.
    - rename p into p'. destruct H as [pq [r [? [? ?]]]].
      destruct H as [p [q [? [? ?]]]].
      exists p, (q ** r).
      split; auto. split; auto. apply sep_conj_Perms2_perm; auto.
      rewrite <- sep_conj_perm_assoc.
      etransitivity; eauto.
      apply sep_conj_perm_monotone; intuition.
    - rename p into p'. destruct H as [p [qr [? [? ?]]]].
      destruct H0 as [q [r [? [? ?]]]].
      exists (p ** q), r.
      split; auto. apply sep_conj_Perms2_perm; auto. split; auto.
      rewrite sep_conj_perm_assoc.
      etransitivity; eauto.
      apply sep_conj_perm_monotone; intuition.
  Qed.

  (** Complete meet of Perms sets = union *)
  Program Definition meet_Perms2 (Ps : Perms2 -> Prop) : Perms2 :=
    {|
      in_Perms2 := fun _ p => exists P, Ps P /\ p ∈2 P
    |}.
  Next Obligation.
    exists H. split; auto.
    eapply (Perms2_upwards_closed _ _ _ _ p1); eauto.
  Qed.

  Lemma lte_meet_Perms2 : forall (Ps : Perms2 -> Prop) P,
      Ps P ->
      meet_Perms2 Ps ⊑2 P.
  Proof.
    repeat intro. exists P. auto.
  Qed.

  Lemma meet_Perms2_max : forall (Ps : Perms2 -> Prop) Q,
      (forall P, Ps P -> Q ⊑2 P) ->
      Q ⊑2 meet_Perms2 Ps.
  Proof.
    repeat intro. destruct H0 as [? [? ?]].
    eapply H; eauto.
  Qed.

  (** The least Perms set containing a given p *)
  Program Definition singleton_Perms2 spred1 (p1 : @perm {x : config | spred1 x}) : Perms2 :=
    {|
      in_Perms2 := fun spred2 p2 => exists (Hspred : forall x, spred2 x -> spred1 x),
                       hlte_perm2 config spred2 spred1 Hspred p1 p2
    |}.
  Next Obligation.
    eexists. Unshelve.
    2: { intros. apply H. apply Hspred. auto. }
    eapply hlte_perm2_transitive; eassumption.
  Qed.

End PermSet.

Notation "p ∈2 P" := (in_Perms2 P p) (at level 60).
Notation "P ⊑2 Q" := (lte_Perms2 P Q) (at level 60).
Notation "P ⊨2 Q" := (entails_Perms2 P Q) (at level 60).
Notation "P ≡2 Q" := (eq_Perms2 P Q) (at level 60).
Notation "P *2 Q" := (sep_conj_Perms2 P Q) (at level 60).


(** * Definition of a strict category *)
Require Export Category.Core.

Set Universe Polymorphism.
Set Implicit Arguments.
Generalizable All Variables.
Set Asymmetric Patterns.

Local Open Scope morphism_scope.

(** Quoting the HoTT Book: *)
(** Definition. A _strict category_ is a precategory whose type of
    objects is a set. *)

Notation IsStrictCategory C := (IsHSet (object C)).

Record StrictCategory :=
  {
    precategory_strict :> PreCategory;
    isstrict_StrictCategory :> IsStrictCategory precategory_strict
  }.

Global Existing Instance isstrict_StrictCategory.


(* *********************************************************************)
(*                                                                     *)
(*            The CertiKOS Certified Kit Operating System              *)
(*                                                                     *)
(*                   The FLINT Group, Yale University                  *)
(*                                                                     *)
(*  Copyright The FLINT Group, Yale University.  All rights reserved.  *)
(*  This file is distributed under the terms of the Yale University    *)
(*  Non-Commercial License Agreement.                                  *)
(*                                                                     *)
(* *********************************************************************)

(** * Language definitions *)

(** The type classes in the file can be used to define a language and
  instantiate the layer framework correspondingly.

  A language is characterized by the types it uses for identifiers,
  function definitions and variable definitions. We also need to
  define the domain that will be used to interpret the semantics of
  primitives, and the corresponding notion of simulations.

  Once these basic ingredients are provided, we need to provide
  instances of corresponding structures for modules and layers.
  If we use [positive] for identifiers, as Compcert does, this can be
  done automatically by [PTreeModules] and [PTreeLayers].

  The last step is to define the semantics of modules, by giving an
  interpretation in [∀ D, layer D -> layer D]: the semantics tells us,
  if we use a module [M] in a context which implements layer [L], that
  it will implement the specifications in the layer [〚M〛 L]. *)

Require Export liblayers.logic.Modules.
Require Export liblayers.logic.Layers.
Require Export liblayers.logic.Semantics.

(** ** Layer logic *)

(** The interface for the layer logic is given below. It is
  instantiated by the [LayerLogicImpl] Coq module, which interprets
  the module typing judgement [L1 ⊢ (R, M) : L2] in terms of the
  language's semantics as [sim R L2 (〚M〛 L1)]. *)

Class LayerLogicOps {layerdata simrel} ident F primsem V module layer
    `{sem_ops: SemanticsOps layerdata ident F primsem V module layer} :=
  {
    ll_vdash {D1 D2} :> Vdash (layer D1) (simrel D2 D1 * module) (layer D2)
  }.

Class LayerLogic {layerdata simrel} ident F primsem V module layer
    `{ll_ops: LayerLogicOps layerdata simrel ident F primsem V module layer}
    `{rg_ops: !ReflexiveGraphOps layerdata simrel}
    `{primsem_sim: !Sim simrel primsem}
    `{layer_sim: !Sim simrel layer} :=
  {
    (*
    sem_rule {D} (M: module) (L: layer D):
      L ⊢ (id, M) : 〚M〛 L;
    conseq_rule {D1 D2 D3 D4} R21 R32 R43 L1 L2 L3 L4 M:
      simRR D2 D1 R21 L2 L1 ->
      simRR D4 D3 R43 L4 L3 ->
      L2 ⊢ (R32, M) : L3 ->
      L1 ⊢ (R21 ∘ R32 ∘ R43, M) : L4;
    vcomp_rule D1 D2 D3 (R: simrel D2 D1) (S: simrel D3 D2) L1 L2 L3 M N:
      L1 ⊢ (R, M) : L2 ->
      L2 ⊢ (S, N) : L3 ->
      L1 ⊢ (R ∘ S, M ⊕ N) : L3;
    *)
    conseq_le_le D1 D2 (R: simrel D1 D2) L1 L2 L3 L4 M:
      L2 ⊢ (R, M) : L3 ->
      L2 ≤ L1 ->
      L4 ≤ L3 ->
      L1 ⊢ (R, M) : L4;
    hcomp_rule D D' (R: simrel D' D) L M1 M2 (L1 L2: layer D'):
      layers_disjoint L1 L \/ layers_disjoint L2 L ->
      L ⊢ (R, M1) : L1 ->
      L ⊢ (R, M2) : L2 ->
      L ⊢ (R, M1 ⊕ M2) : L1 ⊕ L2
  }.

(** * Derived rules *)

Section DERIVED_RULES.
  Context `{Hll: LayerLogic}.
  (* Context `{Hld: !Category layerdata simrel}. *)
  Context `{Hmodule: !Modules ident F V module}.
  Context `{Hlayer: !Layers ident primsem V layer}.
  Context `{fsem_ops: !FunctionSemanticsOps ident F primsem V module layer}.
  Context `{Hsem: !Semantics ident F primsem V module layer}.

  (** The following specialized versions of the consequence rule are
    easier to apply depending on situation, since you don't have to
    rewrite the relation involved to account for identities. *)

  (*
  Lemma conseq_le_sim {D1 D2} (R: simrel D2 D1) M L1 L2 L3 L4:
    L2 ⊢ (id, M) : L3 ->
    L2 ≤ L1 ->
    sim R L4 L3 ->
    L1 ⊢ (R, M) : L4.
  Proof.
    intros HM HL21 HL43.
    rewrite <- (cat_compose_id_left R).
    rewrite <- (cat_compose_id_right id).
    eapply conseq_rule; eassumption.
  Qed.

  Lemma conseq_sim_le {D1 D2} (R: simrel D2 D1) M L1 L2 L3 L4:
    L2 ⊢ (id, M) : L3 ->
    sim R L2 L1 ->
    L4 ≤ L3 ->
    L1 ⊢ (R, M) : L4.
  Proof.
    intros HM HL21 HL43.
    rewrite <- (cat_compose_id_right R).
    rewrite <- (cat_compose_id_right (R ∘ id)).
    eapply conseq_rule; eassumption.
  Qed.

  Lemma conseq_le_le {D1 D2} (R: simrel D2 D1) M L1 L2 L3 L4:
    L2 ⊢ (R, M) : L3 ->
    L2 ≤ L1 ->
    L4 ≤ L3 ->
    L1 ⊢ (R, M) : L4.
  Proof.
    intros HM HL21 HL43.
    rewrite <- (cat_compose_id_right R).
    rewrite <- (cat_compose_id_left R).
    eapply conseq_rule; eassumption.
  Qed.
  *)

  Lemma conseq_le_left {D1 D2} (R: simrel D1 D2) M L1 L1' L2:
    L1 ⊢ (R, M) : L2 ->
    L1 ≤ L1' ->
    L1' ⊢ (R, M) : L2.
  Proof.
    intros HM HL1.
    eapply conseq_le_le.
    * apply HM.
    * apply HL1.
    * reflexivity.
  Qed.

  Lemma conseq_le_right {D1 D2} (R: simrel D1 D2) M L1 L2 L2':
    L1 ⊢ (R, M) : L2 ->
    L2' ≤ L2 ->
    L1 ⊢ (R, M) : L2'.
  Proof.
    intros HM HL2.
    eapply conseq_le_le.
    * apply HM.
    * reflexivity.
    * apply HL2.
  Qed.

  (** The frame rule can be proved from horizontal composition and
    some consequence rules. *)

  (** Not sure how to fit [layers_disjoint] in though <<<
  Lemma frame_rule D D' (R: simrel D' D) L1 L2 M1 M2 L1' L2':
    L1 ⊢ (R, M1) : L1' ->
    L2 ⊢ (R, M2) : L2' ->
    L1 ⊕ L2 ⊢ (R, M1 ⊕ M2) : L1' ⊕ L2'.
  Proof.
    intros H1 H2.
    apply hcomp_rule.
    * eapply conseq_le_left; try eassumption.
      apply left_upper_bound.
    * eapply conseq_le_left; try eassumption.
      apply right_upper_bound.
  Qed.
  >>> **)
End DERIVED_RULES.


Require Export DACandMAC.

Set Strict Implicit.
Unset Implicit Arguments.

Section Write.

Variable s : SFSstate.

(*********************************************************************)
(*                   Some Useful Synonymous                          *)
(*********************************************************************)

Let t (e : ENTITY) (n : nat) (buf : ENTCONT) : SFSstate :=
  mkSFS (entitySC s) (cap s) (secmat s) (write_entities e n buf).

(*********************************************************************)
(*                            write                                  *)
(*********************************************************************)

(*This operation writes the first n BYTEs of buf to the entity       *)
(*represented by entity e.                                           *)

Inductive write (eSub : ENTITY) (eObj : ENTITY) (n : nat)
(buf : ENTCONT) : SFSstate -> Prop :=
    WriteOK :
      match fsecmat (secmat s) eSub with
      | None => False
      | Some y => set_In eObj (EntWritingList y)
      end -> write eSub eObj n buf (t eObj n buf).

End Write.


Load LFindLoad.
From lfind Require Import LFind.
From QuickChick Require Import QuickChick.
From adtind Require Import goal4.

Derive Show for natural.

              Derive Arbitrary for natural.

              Instance Dec_Eq_natural : Dec_Eq natural.

              Proof. dec_eq. Qed.
Derive Show for lst.

              Derive Arbitrary for lst.

              Instance Dec_Eq_lst : Dec_Eq lst.

              Proof. dec_eq. Qed.

Lemma conj15eqsynthconj6 : forall  (lv0 : lst), (@eq natural (len lv0) (len lv0)).
Admitted.
QuickChick conj15eqsynthconj6.


Require Import Logic.lib.Ensembles_ext.
Require Import Logic.GeneralLogic.Base.
Require Import Logic.GeneralLogic.KripkeModel.
Require Import Logic.GeneralLogic.ProofTheory.BasicSequentCalculus.
Require Import Logic.GeneralLogic.Semantics.Kripke.
Require Import Logic.GeneralLogic.ShallowEmbedded.MonoPredicateAsLang.
Require Import Logic.MinimumLogic.Syntax.
Require Import Logic.MinimumLogic.ProofTheory.Minimum.
Require Import Logic.MinimumLogic.Semantics.Kripke.
Require Import Logic.MinimumLogic.Sound.Sound_Kripke.
Require Import Logic.PropositionalLogic.Syntax.
Require Import Logic.PropositionalLogic.ProofTheory.Intuitionistic.
Require Import Logic.PropositionalLogic.ProofTheory.DeMorgan.
Require Import Logic.PropositionalLogic.ProofTheory.GodelDummett.
Require Import Logic.PropositionalLogic.ProofTheory.Classical.
Require Import Logic.PropositionalLogic.Semantics.Kripke.
Require Import Logic.PropositionalLogic.Sound.Sound_Kripke.

Instance MonoPred_minL (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: MinimumLanguage (MonoPred_L A) := Build_MinimumLanguage (MonoPred_L A) SemanticsMono.impp.

Instance MonoPred_andpL (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: AndLanguage (MonoPred_L A) := Build_AndLanguage (MonoPred_L A) SemanticsMono.andp.

Instance MonoPred_orpL (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: OrLanguage (MonoPred_L A) := Build_OrLanguage (MonoPred_L A) SemanticsMono.orp.

Instance MonoPred_falsepL (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: FalseLanguage (MonoPred_L A) := Build_FalseLanguage (MonoPred_L A) SemanticsMono.falsep.

Instance MonoPred_kiSM (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: KripkeIntuitionisticSemantics (MonoPred_L A) (Build_Model A) (tt: @Kmodel _ (unit_kMD (Build_Model A))) (MonoPred_SM A).
Proof.
  constructor.
  intros; apply (proj2_sig _).
Qed.

Instance MonoPred_kminSM (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: KripkeMinimumSemantics (MonoPred_L A) (Build_Model A) (tt: @Kmodel _ (unit_kMD (Build_Model A))) (MonoPred_SM A).
Proof.
  constructor.
  intros; apply Same_set_refl.
Qed.

Instance MonoPred_kandpSM (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: KripkeAndSemantics (MonoPred_L A) (Build_Model A) (tt: @Kmodel _ (unit_kMD (Build_Model A))) (MonoPred_SM A).
Proof.
  constructor.
  + intros; apply Same_set_refl.
Qed.

Instance MonoPred_korpSM (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: KripkeOrSemantics (MonoPred_L A) (Build_Model A) (tt: @Kmodel _ (unit_kMD (Build_Model A))) (MonoPred_SM A).
Proof.
  constructor.
  + intros; apply Same_set_refl.
Qed.

Instance MonoPred_kfalsepSM (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: KripkeFalseSemantics (MonoPred_L A) (Build_Model A) (tt: @Kmodel _ (unit_kMD (Build_Model A))) (MonoPred_SM A).
Proof.
  constructor.
  + apply Same_set_refl.
Qed.

Instance MonoPred_Gamma (A: Type) {R: Relation A} {po_R: PreOrder Krelation}:
  Provable (MonoPred_L A) :=
  Build_Provable _ (fun x: expr => forall a: A, proj1_sig x a).

Instance MonoPred_minAX (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: MinimumAxiomatization (MonoPred_L A) (MonoPred_Gamma A).
Proof.
  constructor.
  + intros x y ? ? m.
    pose proof @sound_modus_ponens (MonoPred_L A) _ (Build_Model A) (unit_kMD (Build_Model A)) tt R po_R (MonoPred_SM A) (MonoPred_kminSM A) x y.
    exact (H1 m (H m) (H0 m)).
  + intros x y.
    exact (@sound_axiom1 (MonoPred_L A) _ (Build_Model A) (unit_kMD (Build_Model A)) tt R (MonoPred_SM A) (MonoPred_kiSM A) (MonoPred_kminSM A) x y).
  + intros x y z.
    exact (@sound_axiom2 (MonoPred_L A) _ (Build_Model A) (unit_kMD (Build_Model A)) tt R po_R (MonoPred_SM A) (MonoPred_kminSM A) x y z).
Qed.

Instance MonoPred_andpAX (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: AndAxiomatization (MonoPred_L A) (MonoPred_Gamma A).
Proof.
  constructor.
  + intros x y.
    exact (@sound_andp_intros (MonoPred_L A) _ _ (Build_Model A) (unit_kMD (Build_Model A)) tt R (MonoPred_SM A) (MonoPred_kiSM A) (MonoPred_kminSM A) (MonoPred_kandpSM A) x y).
  + intros x y.
    exact (@sound_andp_elim1 (MonoPred_L A) _ _ (Build_Model A) (unit_kMD (Build_Model A)) tt R (MonoPred_SM A) (MonoPred_kminSM A) (MonoPred_kandpSM A) x y).
  + intros x y.
    exact (@sound_andp_elim2 (MonoPred_L A) _ _ (Build_Model A) (unit_kMD (Build_Model A)) tt R (MonoPred_SM A) (MonoPred_kminSM A) (MonoPred_kandpSM A) x y).
Qed.

Instance MonoPred_orpAX (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: OrAxiomatization (MonoPred_L A) (MonoPred_Gamma A).
Proof.
  constructor.
  + intros x y.
    exact (@sound_orp_intros1 (MonoPred_L A) _ _ (Build_Model A) (unit_kMD (Build_Model A)) tt R (MonoPred_SM A) (MonoPred_kminSM A) (MonoPred_korpSM A) x y).
  + intros x y.
    exact (@sound_orp_intros2 (MonoPred_L A) _ _ (Build_Model A) (unit_kMD (Build_Model A)) tt R (MonoPred_SM A) (MonoPred_kminSM A) (MonoPred_korpSM A) x y).
  + intros x y z.
    exact (@sound_orp_elim (MonoPred_L A) _ _ (Build_Model A) (unit_kMD (Build_Model A)) tt R po_R (MonoPred_SM A) (MonoPred_kminSM A) (MonoPred_korpSM A) x y z).
Qed.

Instance MonoPred_falsepAX (A: Type) {R: Relation A} {po_R: PreOrder Krelation}: FalseAxiomatization (MonoPred_L A) (MonoPred_Gamma A).
Proof.
  constructor.
  + intros x.
    exact (@sound_falsep_elim (MonoPred_L A) _ _ (Build_Model A) (unit_kMD (Build_Model A)) tt R (MonoPred_SM A) (MonoPred_kminSM A) (MonoPred_kfalsepSM A) x).
Qed.

Instance MonoPred_gdpAX (A: Type) {R: Relation A} {po_R: PreOrder Krelation} {nkiM: NoBranchKripkeIntuitionisticModel A}: GodelDummettAxiomatization (MonoPred_L A) (MonoPred_Gamma A).
Proof.
  constructor.
  intros x y.
  exact (@sound_impp_choice_no_branch (MonoPred_L A) _ _ (Build_Model A) (unit_kMD (Build_Model A)) tt R (MonoPred_SM A) (MonoPred_kiSM A) (MonoPred_kminSM A) (MonoPred_korpSM A) nkiM x y).
Qed.
(*TODO: need to adjust(about DeMorgan and Classical)
Instance MonoPred_dmpAX (A: Type) {R: Relation A} {po_R: PreOrder Krelation} {bkiM: BranchJoinKripkeIntuitionisticModel A}: DeMorganPropositionalAxiomatization (MonoPred_L A) (MonoPred_Gamma A).
Proof.
  constructor.
  intros x.
  exact (@sound_weak_excluded_middle_branch_join (MonoPred_L A) _ _ (Build_Model A) (unit_kMD (Build_Model A)) tt R po_R (MonoPred_SM A) (MonoPred_kiSM A) (MonoPred_kminSM A) (MonoPred_kpSM A) bkiM x).
Qed.

Instance MonoPred_cpAX (A: Type) {R: Relation A} {po_R: PreOrder Krelation} {ikiM: IdentityKripkeIntuitionisticModel A}: ClassicalPropositionalLogic (MonoPred_L A) (MonoPred_Gamma A).
Proof.
  constructor.
  intros x.
  exact (@sound_excluded_middle_ident (MonoPred_L A) _ _ (Build_Model A) (unit_kMD (Build_Model A)) tt R (MonoPred_SM A) (MonoPred_kminSM A) (MonoPred_kpSM A) ikiM x).
Qed.
*)


Require Export VST.concurrency.paco.src.paconotation VST.concurrency.paco.src.pacotac VST.concurrency.paco.src.pacodef VST.concurrency.paco.src.pacotacuser.
Set Implicit Arguments.

(** ** Predicates of Arity 2
*)

(** 1 Mutual Coinduction *)

Section Arg2_1.

Definition monotone2 T0 T1 (gf: rel2 T0 T1 -> rel2 T0 T1) :=
  forall x0 x1 r r' (IN: gf r x0 x1) (LE: r <2= r'), gf r' x0 x1.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable gf : rel2 T0 T1 -> rel2 T0 T1.

Theorem paco2_acc: forall
  l r (OBG: forall rr (INC: r <2= rr) (CIH: l <_paco_2= rr), l <_paco_2= paco2 gf rr),
  l <2= paco2 gf r.
Proof.
  intros; assert (SIM: paco2 gf (r \2/ l) x0 x1) by eauto.
  clear PR; repeat (try left; do 3 paco_revert; paco_cofix_auto).
Qed.

Theorem paco2_mon: monotone2 (paco2 gf).
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Theorem paco2_mult_strong: forall r,
  paco2 gf (upaco2 gf r) <2= paco2 gf r.
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Corollary paco2_mult: forall r,
  paco2 gf (paco2 gf r) <2= paco2 gf r.
Proof. intros; eapply paco2_mult_strong, paco2_mon; eauto. Qed.

Theorem paco2_fold: forall r,
  gf (upaco2 gf r) <2= paco2 gf r.
Proof. intros; econstructor; [ |eauto]; eauto. Qed.

Theorem paco2_unfold: forall (MON: monotone2 gf) r,
  paco2 gf r <2= gf (upaco2 gf r).
Proof. unfold monotone2; intros; destruct PR; eauto. Qed.

End Arg2_1.

Hint Unfold monotone2.
Hint Resolve paco2_fold.

Arguments paco2_acc            [ T0 T1 ].
Arguments paco2_mon            [ T0 T1 ].
Arguments paco2_mult_strong    [ T0 T1 ].
Arguments paco2_mult           [ T0 T1 ].
Arguments paco2_fold           [ T0 T1 ].
Arguments paco2_unfold         [ T0 T1 ].

Instance paco2_inst  T0 T1 (gf : rel2 T0 T1->_) r x0 x1 : paco_class (paco2 gf r x0 x1) :=
{ pacoacc    := paco2_acc gf;
  pacomult   := paco2_mult gf;
  pacofold   := paco2_fold gf;
  pacounfold := paco2_unfold gf }.

(** 2 Mutual Coinduction *)

Section Arg2_2.

Definition monotone2_2 T0 T1 (gf: rel2 T0 T1 -> rel2 T0 T1 -> rel2 T0 T1) :=
  forall x0 x1 r_0 r_1 r'_0 r'_1 (IN: gf r_0 r_1 x0 x1) (LE_0: r_0 <2= r'_0)(LE_1: r_1 <2= r'_1), gf r'_0 r'_1 x0 x1.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable gf_0 gf_1 : rel2 T0 T1 -> rel2 T0 T1 -> rel2 T0 T1.

Theorem paco2_2_0_acc: forall
  l r_0 r_1 (OBG: forall rr (INC: r_0 <2= rr) (CIH: l <_paco_2= rr), l <_paco_2= paco2_2_0 gf_0 gf_1 rr r_1),
  l <2= paco2_2_0 gf_0 gf_1 r_0 r_1.
Proof.
  intros; assert (SIM: paco2_2_0 gf_0 gf_1 (r_0 \2/ l) r_1 x0 x1) by eauto.
  clear PR; repeat (try left; do 3 paco_revert; paco_cofix_auto).
Qed.

Theorem paco2_2_1_acc: forall
  l r_0 r_1 (OBG: forall rr (INC: r_1 <2= rr) (CIH: l <_paco_2= rr), l <_paco_2= paco2_2_1 gf_0 gf_1 r_0 rr),
  l <2= paco2_2_1 gf_0 gf_1 r_0 r_1.
Proof.
  intros; assert (SIM: paco2_2_1 gf_0 gf_1 r_0 (r_1 \2/ l) x0 x1) by eauto.
  clear PR; repeat (try left; do 3 paco_revert; paco_cofix_auto).
Qed.

Theorem paco2_2_0_mon: monotone2_2 (paco2_2_0 gf_0 gf_1).
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Theorem paco2_2_1_mon: monotone2_2 (paco2_2_1 gf_0 gf_1).
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Theorem paco2_2_0_mult_strong: forall r_0 r_1,
  paco2_2_0 gf_0 gf_1 (upaco2_2_0 gf_0 gf_1 r_0 r_1) (upaco2_2_1 gf_0 gf_1 r_0 r_1) <2= paco2_2_0 gf_0 gf_1 r_0 r_1.
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Theorem paco2_2_1_mult_strong: forall r_0 r_1,
  paco2_2_1 gf_0 gf_1 (upaco2_2_0 gf_0 gf_1 r_0 r_1) (upaco2_2_1 gf_0 gf_1 r_0 r_1) <2= paco2_2_1 gf_0 gf_1 r_0 r_1.
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Corollary paco2_2_0_mult: forall r_0 r_1,
  paco2_2_0 gf_0 gf_1 (paco2_2_0 gf_0 gf_1 r_0 r_1) (paco2_2_1 gf_0 gf_1 r_0 r_1) <2= paco2_2_0 gf_0 gf_1 r_0 r_1.
Proof. intros; eapply paco2_2_0_mult_strong, paco2_2_0_mon; eauto. Qed.

Corollary paco2_2_1_mult: forall r_0 r_1,
  paco2_2_1 gf_0 gf_1 (paco2_2_0 gf_0 gf_1 r_0 r_1) (paco2_2_1 gf_0 gf_1 r_0 r_1) <2= paco2_2_1 gf_0 gf_1 r_0 r_1.
Proof. intros; eapply paco2_2_1_mult_strong, paco2_2_1_mon; eauto. Qed.

Theorem paco2_2_0_fold: forall r_0 r_1,
  gf_0 (upaco2_2_0 gf_0 gf_1 r_0 r_1) (upaco2_2_1 gf_0 gf_1 r_0 r_1) <2= paco2_2_0 gf_0 gf_1 r_0 r_1.
Proof. intros; econstructor; [ | |eauto]; eauto. Qed.

Theorem paco2_2_1_fold: forall r_0 r_1,
  gf_1 (upaco2_2_0 gf_0 gf_1 r_0 r_1) (upaco2_2_1 gf_0 gf_1 r_0 r_1) <2= paco2_2_1 gf_0 gf_1 r_0 r_1.
Proof. intros; econstructor; [ | |eauto]; eauto. Qed.

Theorem paco2_2_0_unfold: forall (MON: monotone2_2 gf_0) (MON: monotone2_2 gf_1) r_0 r_1,
  paco2_2_0 gf_0 gf_1 r_0 r_1 <2= gf_0 (upaco2_2_0 gf_0 gf_1 r_0 r_1) (upaco2_2_1 gf_0 gf_1 r_0 r_1).
Proof. unfold monotone2_2; intros; destruct PR; eauto. Qed.

Theorem paco2_2_1_unfold: forall (MON: monotone2_2 gf_0) (MON: monotone2_2 gf_1) r_0 r_1,
  paco2_2_1 gf_0 gf_1 r_0 r_1 <2= gf_1 (upaco2_2_0 gf_0 gf_1 r_0 r_1) (upaco2_2_1 gf_0 gf_1 r_0 r_1).
Proof. unfold monotone2_2; intros; destruct PR; eauto. Qed.

End Arg2_2.

Hint Unfold monotone2_2.
Hint Resolve paco2_2_0_fold.
Hint Resolve paco2_2_1_fold.

Arguments paco2_2_0_acc            [ T0 T1 ].
Arguments paco2_2_1_acc            [ T0 T1 ].
Arguments paco2_2_0_mon            [ T0 T1 ].
Arguments paco2_2_1_mon            [ T0 T1 ].
Arguments paco2_2_0_mult_strong    [ T0 T1 ].
Arguments paco2_2_1_mult_strong    [ T0 T1 ].
Arguments paco2_2_0_mult           [ T0 T1 ].
Arguments paco2_2_1_mult           [ T0 T1 ].
Arguments paco2_2_0_fold           [ T0 T1 ].
Arguments paco2_2_1_fold           [ T0 T1 ].
Arguments paco2_2_0_unfold         [ T0 T1 ].
Arguments paco2_2_1_unfold         [ T0 T1 ].

Instance paco2_2_0_inst  T0 T1 (gf_0 gf_1 : rel2 T0 T1->_) r_0 r_1 x0 x1 : paco_class (paco2_2_0 gf_0 gf_1 r_0 r_1 x0 x1) :=
{ pacoacc    := paco2_2_0_acc gf_0 gf_1;
  pacomult   := paco2_2_0_mult gf_0 gf_1;
  pacofold   := paco2_2_0_fold gf_0 gf_1;
  pacounfold := paco2_2_0_unfold gf_0 gf_1 }.

Instance paco2_2_1_inst  T0 T1 (gf_0 gf_1 : rel2 T0 T1->_) r_0 r_1 x0 x1 : paco_class (paco2_2_1 gf_0 gf_1 r_0 r_1 x0 x1) :=
{ pacoacc    := paco2_2_1_acc gf_0 gf_1;
  pacomult   := paco2_2_1_mult gf_0 gf_1;
  pacofold   := paco2_2_1_fold gf_0 gf_1;
  pacounfold := paco2_2_1_unfold gf_0 gf_1 }.

(** 3 Mutual Coinduction *)

Section Arg2_3.

Definition monotone2_3 T0 T1 (gf: rel2 T0 T1 -> rel2 T0 T1 -> rel2 T0 T1 -> rel2 T0 T1) :=
  forall x0 x1 r_0 r_1 r_2 r'_0 r'_1 r'_2 (IN: gf r_0 r_1 r_2 x0 x1) (LE_0: r_0 <2= r'_0)(LE_1: r_1 <2= r'_1)(LE_2: r_2 <2= r'_2), gf r'_0 r'_1 r'_2 x0 x1.

Variable T0 : Type.
Variable T1 : forall (x0: @T0), Type.
Variable gf_0 gf_1 gf_2 : rel2 T0 T1 -> rel2 T0 T1 -> rel2 T0 T1 -> rel2 T0 T1.

Theorem paco2_3_0_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_0 <2= rr) (CIH: l <_paco_2= rr), l <_paco_2= paco2_3_0 gf_0 gf_1 gf_2 rr r_1 r_2),
  l <2= paco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco2_3_0 gf_0 gf_1 gf_2 (r_0 \2/ l) r_1 r_2 x0 x1) by eauto.
  clear PR; repeat (try left; do 3 paco_revert; paco_cofix_auto).
Qed.

Theorem paco2_3_1_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_1 <2= rr) (CIH: l <_paco_2= rr), l <_paco_2= paco2_3_1 gf_0 gf_1 gf_2 r_0 rr r_2),
  l <2= paco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco2_3_1 gf_0 gf_1 gf_2 r_0 (r_1 \2/ l) r_2 x0 x1) by eauto.
  clear PR; repeat (try left; do 3 paco_revert; paco_cofix_auto).
Qed.

Theorem paco2_3_2_acc: forall
  l r_0 r_1 r_2 (OBG: forall rr (INC: r_2 <2= rr) (CIH: l <_paco_2= rr), l <_paco_2= paco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 rr),
  l <2= paco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof.
  intros; assert (SIM: paco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 (r_2 \2/ l) x0 x1) by eauto.
  clear PR; repeat (try left; do 3 paco_revert; paco_cofix_auto).
Qed.

Theorem paco2_3_0_mon: monotone2_3 (paco2_3_0 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Theorem paco2_3_1_mon: monotone2_3 (paco2_3_1 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Theorem paco2_3_2_mon: monotone2_3 (paco2_3_2 gf_0 gf_1 gf_2).
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Theorem paco2_3_0_mult_strong: forall r_0 r_1 r_2,
  paco2_3_0 gf_0 gf_1 gf_2 (upaco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <2= paco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Theorem paco2_3_1_mult_strong: forall r_0 r_1 r_2,
  paco2_3_1 gf_0 gf_1 gf_2 (upaco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <2= paco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Theorem paco2_3_2_mult_strong: forall r_0 r_1 r_2,
  paco2_3_2 gf_0 gf_1 gf_2 (upaco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <2= paco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. paco_cofix_auto; repeat (left; do 3 paco_revert; paco_cofix_auto). Qed.

Corollary paco2_3_0_mult: forall r_0 r_1 r_2,
  paco2_3_0 gf_0 gf_1 gf_2 (paco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <2= paco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco2_3_0_mult_strong, paco2_3_0_mon; eauto. Qed.

Corollary paco2_3_1_mult: forall r_0 r_1 r_2,
  paco2_3_1 gf_0 gf_1 gf_2 (paco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <2= paco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco2_3_1_mult_strong, paco2_3_1_mon; eauto. Qed.

Corollary paco2_3_2_mult: forall r_0 r_1 r_2,
  paco2_3_2 gf_0 gf_1 gf_2 (paco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (paco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <2= paco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; eapply paco2_3_2_mult_strong, paco2_3_2_mon; eauto. Qed.

Theorem paco2_3_0_fold: forall r_0 r_1 r_2,
  gf_0 (upaco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <2= paco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco2_3_1_fold: forall r_0 r_1 r_2,
  gf_1 (upaco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <2= paco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco2_3_2_fold: forall r_0 r_1 r_2,
  gf_2 (upaco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2) <2= paco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2.
Proof. intros; econstructor; [ | | |eauto]; eauto. Qed.

Theorem paco2_3_0_unfold: forall (MON: monotone2_3 gf_0) (MON: monotone2_3 gf_1) (MON: monotone2_3 gf_2) r_0 r_1 r_2,
  paco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 <2= gf_0 (upaco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone2_3; intros; destruct PR; eauto. Qed.

Theorem paco2_3_1_unfold: forall (MON: monotone2_3 gf_0) (MON: monotone2_3 gf_1) (MON: monotone2_3 gf_2) r_0 r_1 r_2,
  paco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 <2= gf_1 (upaco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone2_3; intros; destruct PR; eauto. Qed.

Theorem paco2_3_2_unfold: forall (MON: monotone2_3 gf_0) (MON: monotone2_3 gf_1) (MON: monotone2_3 gf_2) r_0 r_1 r_2,
  paco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 <2= gf_2 (upaco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2) (upaco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2).
Proof. unfold monotone2_3; intros; destruct PR; eauto. Qed.

End Arg2_3.

Hint Unfold monotone2_3.
Hint Resolve paco2_3_0_fold.
Hint Resolve paco2_3_1_fold.
Hint Resolve paco2_3_2_fold.

Arguments paco2_3_0_acc            [ T0 T1 ].
Arguments paco2_3_1_acc            [ T0 T1 ].
Arguments paco2_3_2_acc            [ T0 T1 ].
Arguments paco2_3_0_mon            [ T0 T1 ].
Arguments paco2_3_1_mon            [ T0 T1 ].
Arguments paco2_3_2_mon            [ T0 T1 ].
Arguments paco2_3_0_mult_strong    [ T0 T1 ].
Arguments paco2_3_1_mult_strong    [ T0 T1 ].
Arguments paco2_3_2_mult_strong    [ T0 T1 ].
Arguments paco2_3_0_mult           [ T0 T1 ].
Arguments paco2_3_1_mult           [ T0 T1 ].
Arguments paco2_3_2_mult           [ T0 T1 ].
Arguments paco2_3_0_fold           [ T0 T1 ].
Arguments paco2_3_1_fold           [ T0 T1 ].
Arguments paco2_3_2_fold           [ T0 T1 ].
Arguments paco2_3_0_unfold         [ T0 T1 ].
Arguments paco2_3_1_unfold         [ T0 T1 ].
Arguments paco2_3_2_unfold         [ T0 T1 ].

Instance paco2_3_0_inst  T0 T1 (gf_0 gf_1 gf_2 : rel2 T0 T1->_) r_0 r_1 r_2 x0 x1 : paco_class (paco2_3_0 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1) :=
{ pacoacc    := paco2_3_0_acc gf_0 gf_1 gf_2;
  pacomult   := paco2_3_0_mult gf_0 gf_1 gf_2;
  pacofold   := paco2_3_0_fold gf_0 gf_1 gf_2;
  pacounfold := paco2_3_0_unfold gf_0 gf_1 gf_2 }.

Instance paco2_3_1_inst  T0 T1 (gf_0 gf_1 gf_2 : rel2 T0 T1->_) r_0 r_1 r_2 x0 x1 : paco_class (paco2_3_1 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1) :=
{ pacoacc    := paco2_3_1_acc gf_0 gf_1 gf_2;
  pacomult   := paco2_3_1_mult gf_0 gf_1 gf_2;
  pacofold   := paco2_3_1_fold gf_0 gf_1 gf_2;
  pacounfold := paco2_3_1_unfold gf_0 gf_1 gf_2 }.

Instance paco2_3_2_inst  T0 T1 (gf_0 gf_1 gf_2 : rel2 T0 T1->_) r_0 r_1 r_2 x0 x1 : paco_class (paco2_3_2 gf_0 gf_1 gf_2 r_0 r_1 r_2 x0 x1) :=
{ pacoacc    := paco2_3_2_acc gf_0 gf_1 gf_2;
  pacomult   := paco2_3_2_mult gf_0 gf_1 gf_2;
  pacofold   := paco2_3_2_fold gf_0 gf_1 gf_2;
  pacounfold := paco2_3_2_unfold gf_0 gf_1 gf_2 }.