(* This program is free software; you can redistribute it and/or      *)
(* modify it under the terms of the GNU Lesser General Public License *)
(* as published by the Free Software Foundation; either version 2.1   *)
(* of the License, or (at your option) any later version.             *)
(*                                                                    *)
(* This program 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 Lesser General Public   *)
(* License along with this program; if not, write to the Free         *)
(* Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA *)
(* 02110-1301 USA                                                     *)

 (* Computation Tree Logic (CTL) and Timed Computation Tree Logic (TCTL) *)

Set Implicit Arguments.
Unset Strict Implicit.

Require Import Streams.
Require Import time_clocks. (* Temporal notions for discrete time *)

(****************************************************************************)
(* Hypothesis: type Label with label Tick                                   *)
(* Inductive Label : Set := L1 : Label | ... | Ln : Label | Tick : Label.   *)
(****************************************************************************)

Section TemporalOperators_Ind.

(* Temporal operators with inductive types: definitions and properties *)

  Variable S : Set.                (* States *)
  Variable tr : S -> Label -> S -> Prop.  (* Transitions *)

  (* Reachable states form "Sini" with transitions "tr" *)

  Inductive RState (Sini : S) : S -> Prop :=
    | rsIni : RState Sini Sini
    | rsNext :
        forall (s1 s2 : S) (l : Label),
        RState Sini s1 -> tr s1 l s2 -> RState Sini s2.

  (* Reachable states form "Sini" with transitions "tr" in time units *)

  Inductive RState_T (Sini : S) : S -> Instant -> Prop :=
    | rsIni_T : RState_T Sini Sini time0
    | rsTime_T :
        forall (s1 s2 : S) (t : Instant),
        RState_T Sini s1 t -> tr s1 Tick s2 -> RState_T Sini s2 (Inc t)
    | rsNoTime_T :
        forall (s1 s2 : S) (l : Label) (t : Instant),
        RState_T Sini s1 t -> l <> Tick -> tr s1 l s2 -> RState_T Sini s2 t.

  (**************************************************************************)
  (*                       Invariants and Reachability                      *)
  (**************************************************************************)

  (* Init => FA[] P *)

  Definition ForAll (Sini : S) (P : S -> Prop) :=
    forall s : S, RState Sini s -> P s.

  (* Init => FA[](bound t) P *)

  Definition ForAll_T (Sini : S) (P : S -> Prop) (bound : Instant -> Prop) :=
    forall (s : S) (t : Instant), bound t -> RState_T Sini s t -> P s.

  (* Init => EX<> P *)

  Inductive Exists (Sini : S) (P : S -> Prop) : Prop :=
      exists_ : forall s : S, RState Sini s -> P s -> Exists Sini P.

  (* Init => EX<>(bound t) P *)

  Inductive Exists_T (Sini : S) (P : S -> Prop) (bound : Instant -> Prop) :
  Prop :=
      exists_T :
        forall (s : S) (t : Instant),
        bound t -> RState_T Sini s t -> P s -> Exists_T Sini P bound.

  (**************************************************************************)
  (*                            Some Properties                             *)
  (**************************************************************************)

  Theorem Mon_I :
   forall (Sini : S) (Pg Pp : S -> Prop),
   ForAll Sini Pg -> (forall s : S, Pg s -> Pp s) -> ForAll Sini Pp.
  Proof.
    unfold ForAll in |- *; intros.
    apply H0.
    apply H; assumption.
  Qed.

  Theorem Mon_I_T :
   forall (Sini : S) (Pg Pp : S -> Prop) (bound : Instant -> Prop),
   ForAll_T Sini Pg bound ->
   (forall s : S, Pg s -> Pp s) -> ForAll_T Sini Pp bound.
  Proof.
    unfold ForAll_T in |- *; intros.
    apply H0.
    apply (H s t); assumption.
  Qed.

 Theorem Conj :
  forall (Sini : S) (P1 P2 : S -> Prop),
  ForAll Sini P1 -> ForAll Sini P2 -> ForAll Sini (fun s : S => P1 s /\ P2 s).
  Proof.
    unfold ForAll in |- *; intros.
    split; [ apply H | apply H0 ]; assumption.
  Qed.

  Theorem Conj_T :
   forall (Sini : S) (P1 P2 : S -> Prop) (bound : Instant -> Prop),
   ForAll_T Sini P1 bound ->
   ForAll_T Sini P2 bound -> ForAll_T Sini (fun s : S => P1 s /\ P2 s) bound.
  Proof.
    unfold ForAll_T in |- *; intros.
    split; [ apply (H s t) | apply (H0 s t) ]; assumption.
  Qed.

  Theorem Mon_I_EX :
   forall (Sini : S) (Pg Pp : S -> Prop),
   Exists Sini Pg -> (forall s : S, Pg s -> Pp s) -> Exists Sini Pp.
  Proof.
    intros.
    inversion_clear H.
    apply (exists_ H1 (H0 s H2)).
  Qed.

  Theorem Mon_I_EX_T :
   forall (Sini : S) (Pg Pp : S -> Prop) (bound : Instant -> Prop),
   Exists_T Sini Pg bound ->
   (forall s : S, Pg s -> Pp s) -> Exists_T Sini Pp bound.
  Proof.
    intros.
    inversion_clear H.
    apply (exists_T H1 H2 (H0 s H3)).
  Qed.

  Lemma RState_Trans :
   forall s1 s2 s3 : S, RState s1 s2 -> RState s2 s3 -> RState s1 s3.
  Proof.
    intros.
    elim H0; [ assumption | intros ].
    apply (rsNext H2 H3).
  Qed.

  Lemma RState_Trans_T :
   forall (s1 s2 s3 : S) (t1 t2 : Instant),
   RState_T s1 s2 t1 -> RState_T s2 s3 t2 -> RState_T s1 s3 (plus_Ck t1 t2).
  Proof.
    simple induction 2; unfold plus_Ck in |- *; intros.
    rewrite (plus_comm t1 time0); unfold time0 in |- *; simpl in |- *;
     assumption.
    unfold Inc in |- *; unfold plus_Ck in |- *;
     rewrite (plus_assoc t1 t tick).
    apply (rsTime_T H2 H3).
    apply (rsNoTime_T H2 H3 H4).
  Qed.

  Theorem StepsEX :
   forall (s1 s2 : S) (P : S -> Prop),
   RState s1 s2 -> Exists s2 P -> Exists s1 P.
  Proof.
    intros.
    inversion H0.
    apply (exists_ (RState_Trans H H1) H2).
  Qed.

  Require Import Classical.

  Theorem ForAll_EX :
   forall (Sini : S) (P : S -> Prop),
   ForAll Sini P <-> ~ Exists Sini (fun s : S => ~ P s).
  Proof.
    unfold not in |- *; unfold ForAll in |- *; red in |- *; intros; split;
     intros.
    inversion H0.
    apply (H2 (H s H1)).
    elim (classic (P s));
     [ trivial | intro; absurd (Exists Sini (fun s : S => P s -> False)) ].
    assumption.
    apply exists_ with (1 := H0); assumption.
  Qed.

  Theorem ForAll_EX_T :
   forall (Sini : S) (P : S -> Prop) (bound : Instant -> Prop),
   ForAll_T Sini P bound <-> ~ Exists_T Sini (fun s : S => ~ P s) bound.
  Proof.
    unfold not in |- *; unfold ForAll_T in |- *; red in |- *; intros; split;
     intros.
    inversion H0.
    apply (H3 (H s t H1 H2)).
    elim (classic (P s));
     [ trivial
     | intro; absurd (Exists_T Sini (fun s : S => P s -> False) bound) ].
    assumption.
    apply exists_T with (2 := H1); assumption.
  Qed.

  (**************************************************************************)
  (*                             Other Definitions                          *)
  (**************************************************************************)

  (* FA[] (Q => FA[] P) *)

  Definition ForAll_from (Sini : S) (Q P : S -> Prop) :=
    ForAll Sini (fun s : S => Q s -> ForAll s P).
     (* (s:S) (RState Sini s) -> (Q s) -> (ForAll s P). *)

  (* FA[] (Q => FA[](bound t) P) *)

  Definition ForAll_from_T (Sini : S) (Q P : S -> Prop)
    (bound : Instant -> Prop) :=
    ForAll Sini (fun s : S => Q s -> ForAll_T s P bound).
     (* (s:S) (RState Sini s) -> (Q s) -> (ForAll_T s P bound). *)

  (* FA[] (Q => EX<> P) *)

  Definition Exists_from (Sini : S) (Q P : S -> Prop) :=
    ForAll Sini (fun s : S => Q s -> Exists s P).
     (* (s:S) (RState Sini s) -> (Q s) -> (Exists s P). *)

  (* FA[] (Q => EX<>(bound t) P) *)

  Definition Exists_from_T (Sini : S) (Q P : S -> Prop)
    (bound : Instant -> Prop) :=
    ForAll Sini (fun s : S => Q s -> Exists_T s P bound).
     (* (s:S) (RState Sini s) -> (Q s) -> (Exists_T s P bound). *)

End TemporalOperators_Ind.

Infix "^" := Cons.

Section TemporalOperators_CTL.

(* CTL operators with co-inductives types: definitions and properties *)

  Variable S : Set.                (* States *)
  Variable tr : S -> Label -> S -> Prop.  (* Transitions *)

  Notation SPath := (Stream S) (only parsing).

  CoInductive ForAllS (P : Stream S -> Prop) : Stream S -> Prop :=
      forallS :
        forall (x : Stream S) (s : S),
        P (s ^ x) -> ForAllS P x -> ForAllS P (s ^ x).

  Inductive ExistsS (P : Stream S -> Prop) : Stream S -> Prop :=
    | Here : forall x : Stream S, P x -> ExistsS P x
    | Further :
        forall (x : Stream S) (s : S), ExistsS P x -> ExistsS P (s ^ x).

  (* Ejecution traces *)

  CoInductive isTrace : Stream S -> Prop :=
      is_trace :
        forall (x : Stream S) (s1 s2 : S) (l : Label),
        tr s1 l s2 -> isTrace (s2 ^ x) -> isTrace (s1 ^ s2 ^ x).

  Definition isTraceFrom (Sini : S) (x : Stream S) :=
    Sini = hd x /\ isTrace x.

  (* Operator Until *)

  Inductive Until (P Q : Stream S -> Prop) : Stream S -> Prop :=
    | UntilFurther :
        forall (s : S) (x : Stream S),
        P (s ^ x) -> Until P Q x -> Until P Q (s ^ x)
    | UntilHere : forall x : Stream S, Q x -> Until P Q x.

  Inductive EX_Until (Sini : S) (P Q : Stream S -> Prop) : Prop :=
      ExUntil :
        forall x : Stream S,
        isTraceFrom Sini x -> Until P Q x -> EX_Until Sini P Q.

  Definition FA_Until (Sini : S) (P Q : Stream S -> Prop) :=
    forall x : Stream S, isTraceFrom Sini x -> Until P Q x.

  (* Init => FA[] P *)

  Definition Always (Sini : S) (P : Stream S -> Prop) :=
    forall x : Stream S, isTraceFrom Sini x -> ForAllS P x.

  (* Init => FA<> P *)

  Definition Inevitable (Sini : S) (P : Stream S -> Prop) :=
    forall x : Stream S, isTraceFrom Sini x -> ExistsS P x.

  (* Init => EX<> P *)

  Inductive Posible (Sini : S) (P : Stream S -> Prop) : Prop :=
      posible :
        forall x : Stream S,
        isTraceFrom Sini x -> ExistsS P x -> Posible Sini P.

  (* Init => EX[] P *)

  Inductive SafePath (Sini : S) (P : Stream S -> Prop) : Prop :=
      safePath :
        forall x : Stream S,
        isTraceFrom Sini x -> ForAllS P x -> SafePath Sini P.

  (**************************************************************************)
  (*                            Some Properties                             *)
  (**************************************************************************)

  Theorem Equiv1 :
   forall (Sini : S) (P : Stream S -> Prop),
   Posible Sini P <-> EX_Until Sini (fun _ : Stream S => True) P.
  Proof.
    unfold iff in |- *; intros; split; intro.
    inversion_clear H.
    apply ExUntil with (P := fun _ : Stream S => True) (1 := H0).
    elim H1; intros.
    constructor 2; assumption.
    constructor 1; trivial.
    inversion_clear H.
    apply posible with (1 := H0).
    elim H1; intros.
    constructor 2; assumption.
    constructor 1; assumption.
  Qed.

  Theorem Equiv2 :
   forall (Sini : S) (P : Stream S -> Prop),
   Inevitable Sini P <-> FA_Until Sini (fun _ : Stream S => True) P.
  Proof.
    unfold iff, Inevitable, FA_Until in |- *; intros; split; intros.
    elim (H x H0); intros.
    constructor 2; assumption.
    constructor 1; trivial.
    elim (H x H0); intros.
    constructor 2; assumption.
    constructor 1; assumption.
  Qed.

  Lemma ConsTrace :
   forall (s1 s2 : S) (x z : Stream S),
   isTraceFrom s2 z ->
   isTraceFrom s1 (s1 ^ s2 ^ x) -> isTraceFrom s1 (s1 ^ z).
  Proof.
    unfold isTraceFrom in |- *; simpl in |- *.
    simple destruct z; simple destruct 1; simple destruct 3; simpl in |- *;
     intros.
    compute in H0; rewrite H0 in H4.
    inversion_clear H4.
    split; [ trivial | apply (is_trace H5 H1) ].
  Qed.

  Lemma notPosible :
   forall (P : Stream S -> Prop) (s1 : S),
   ~ Posible s1 P ->
   forall (z : Stream S) (s2 : S),
   isTraceFrom s1 (s1 ^ s2 ^ z) -> ~ Posible s2 P.
  Proof.
    unfold not at 2 in |- *; intros.
    elim H1; intros.
    apply H; cut (isTraceFrom s1 (s1 ^ x)).
    intro H4; apply (posible (P:=P) H4).
    apply Further; assumption.
    apply ConsTrace with (1 := H2) (2 := H0); assumption.
  Qed.

  Theorem Equiv3 :
   forall (Sini : S) (P : Stream S -> Prop),
   Always Sini P <-> ~ Posible Sini (fun s : Stream S => ~ P s).
  Proof.
    unfold iff, Always, not in |- *; intros; split.
    intros H H0; inversion_clear H0.
    generalize (H x H1); elim H2; intros.
    inversion_clear H3 in H0.
    apply (H0 H4).
    inversion_clear H4.
    apply (H3 H6).
    generalize Sini; cofix u.
    simple destruct x; intros; constructor.
    elim (classic (P (s ^ s0))); [ trivial | intros ].
    absurd (Posible Sini0 (fun s : Stream S => ~ P s)).
    assumption.
    apply posible with (1 := H0).
    constructor 1; assumption.
    elim H0; simpl in |- *; intros.
    apply (u (hd s0)); intros.
    generalize H0; clear H0; generalize H3; clear H3.
    rewrite <- H1; case s0; simpl in |- *; intros.
    apply (notPosible (P:=fun s : Stream S => ~ P s) H H0); assumption.
    inversion_clear H2; simpl in |- *.
    unfold isTraceFrom in |- *; split; trivial.
  Qed.

  Lemma not_EX :
   forall (P : Stream S -> Prop) (x : Stream S) (s : S),
   ~ ExistsS P (s ^ x) -> ~ ExistsS P x.
  Proof.
      unfold not in |- *; intros.
      apply (H (Further s H0)).
  Qed.

  Theorem Equiv4 :
   forall (Sini : S) (P : Stream S -> Prop),
   SafePath Sini P <-> ~ Inevitable Sini (fun s : Stream S => ~ P s).
  Proof.
    unfold iff, Inevitable, not in |- *; intros; split.
    intro sp; inversion sp; intros.
    generalize H0; elim (H1 x H); intros.
    inversion_clear H3 in H2.
    apply (H2 H4).
    apply H3; inversion_clear H4; assumption.
    intro H;
     elim
      (not_all_ex_not (Stream S)
         (fun x : Stream S =>
          isTraceFrom Sini x -> ExistsS (fun s : Stream S => P s -> False) x)
         H).
    intros.
    generalize
     (not_imply_elim2 (isTraceFrom Sini x)
        (ExistsS (fun s : Stream S => ~ P s) x) H0).
    generalize
     (not_imply_elim (isTraceFrom Sini x)
        (ExistsS (fun s : Stream S => ~ P s) x) H0);
     intros.
    apply safePath with (1 := H1).
    generalize H1; clear H1; generalize H2; clear H2.
    generalize x; generalize Sini; cofix u.
    simple destruct x0; intros; constructor.
    elim (classic (P (s ^ s0))); [ trivial | intro ].
    elim (H2 (Here (P:=fun s : Stream S => ~ P s) H3)).
    apply u with (Sini := hd s0).
    generalize H2; clear H2; case s0; unfold not in |- *; intros.
    apply (not_EX H2 H3).
    elim H1; intros ig trace; inversion_clear trace.
    unfold isTraceFrom in |- *; split; trivial.
  Qed.

  Theorem Mon_I_S :
   forall (x : Stream S) (Pg Pp : Stream S -> Prop),
   ForAllS Pg x -> (forall s : Stream S, Pg s -> Pp s) -> ForAllS Pp x.
  Proof.
    cofix u; intro x; case x; intros.
    case H; constructor.
    apply (H0 (s1 ^ x0) H1).
    apply (u x0 Pg Pp H2 H0).
  Qed.

  Theorem Conj_S :
   forall (x : Stream S) (P1 P2 : Stream S -> Prop),
   ForAllS P1 x ->
   ForAllS P2 x -> ForAllS (fun s : Stream S => P1 s /\ P2 s) x.
  Proof.
    cofix u; intro x; case x; intros.
    inversion_clear H; inversion_clear H0.
    constructor; [ split | apply (u s0) ]; assumption.
  Qed.

  Theorem Mon_I_EX_S :
   forall (x : Stream S) (Pg Pp : Stream S -> Prop),
   ExistsS Pg x -> (forall s : Stream S, Pg s -> Pp s) -> ExistsS Pp x.
  Proof.
    simple induction 1; intros.
    constructor 1; apply (H1 x0 H0).
    constructor 2; apply (H1 H2).
  Qed.

  Theorem OneStep_EX :
   forall (x : Stream S) (P : Stream S -> Prop),
   ExistsS P x -> forall s : S, ExistsS P (s ^ x).
  Proof.
    intros; constructor 2; assumption.
  Qed.

End TemporalOperators_CTL.

Section TemporalOperators_TCTL.

(* TCTL operators with co-inductives types: definitions and properties *)

  Variable S : Set.                (* States *)
  Variable tr : S -> Label -> S -> Prop.  (* Transitions *)
  Variable bound : Instant -> Prop.    (* Location invariants *)

  Notation State_T := (S * Instant)%type (only parsing).
  Notation SPath_T := (Stream (S * Instant)) (only parsing).

  (* Ejecution traces *)

  CoInductive isTrace_T : Stream (S * Instant) -> Prop :=
    | isTraceTick :
        forall (x : Stream (S * Instant)) (s1 s2 : S) (t : Instant),
        tr s1 Tick s2 ->
        isTrace_T ((s2, Inc t) ^ x) -> isTrace_T ((s1, t) ^ (s2, Inc t) ^ x)
    | isTraceDisc :
        forall (x : Stream (S * Instant)) (s1 s2 : S)
          (t : Instant) (l : Label),
        tr s1 l s2 ->
        l <> Tick ->
        isTrace_T ((s2, t) ^ x) -> isTrace_T ((s1, t) ^ (s2, t) ^ x).

  Definition isTraceFrom_T (Sini : S * Instant) (x : Stream (S * Instant)) :=
    Sini = hd x /\ isTrace_T x.

  (* Until operator *)

  Inductive Until_bound (P Q : Stream (S * Instant) -> Prop) :
  Stream (S * Instant) -> Prop :=
    | UntilFurther_bound :
        forall (s : S * Instant) (x : Stream (S * Instant)),
        P (s ^ x) -> Until_bound P Q x -> Until_bound P Q (s ^ x)
    | UntilHere_bound :
        forall (s : S) (t : Instant) (x : Stream (S * Instant)),
        bound t -> Q ((s, t) ^ x) -> Until_bound P Q ((s, t) ^ x).

  Inductive EX_Until_bound (Sini : S * Instant)
  (P Q : Stream (S * Instant) -> Prop) : Prop :=
      ExUntil_bound :
        forall x : Stream (S * Instant),
        isTraceFrom_T Sini x -> Until_bound P Q x -> EX_Until_bound Sini P Q.

  Definition FA_Until_bound (Sini : S * Instant)
    (P Q : Stream (S * Instant) -> Prop) :=
    forall x : Stream (S * Instant),
    isTraceFrom_T Sini x -> Until_bound P Q x.

  (* Init => FA[](bound t) P *)

  Definition Always_T (Sini : S * Instant)
    (P : Stream (S * Instant) -> Prop) :=
    forall x : Stream (S * Instant),
    isTraceFrom_T Sini x ->
    ForAllS (fun s : Stream (S * Instant) => bound (snd (hd s)) -> P s) x.

  (* Init => FA<>(bound t) P *)

  Definition Inevitable_T (Sini : S * Instant)
    (P : Stream (S * Instant) -> Prop) :=
    forall x : Stream (S * Instant),
    isTraceFrom_T Sini x ->
    ExistsS (fun s : Stream (S * Instant) => bound (snd (hd s)) /\ P s) x.

  (* Init => EX<>(bound t) P *)

  Inductive Posible_T (Sini : S * Instant) (P : Stream (S * Instant) -> Prop)
  : Prop :=
      posible_T :
        forall x : Stream (S * Instant),
        isTraceFrom_T Sini x ->
        ExistsS (fun s : Stream (S * Instant) => bound (snd (hd s)) /\ P s) x ->
        Posible_T Sini P.

  (* Init => EX[](bound t) P *)

  Inductive SafePath_T (Sini : S * Instant)
  (P : Stream (S * Instant) -> Prop) : Prop :=
      safePath_T :
        forall x : Stream (S * Instant),
        isTraceFrom_T Sini x ->
        ForAllS (fun s : Stream (S * Instant) => bound (snd (hd s)) -> P s) x ->
        SafePath_T Sini P.

  (**************************************************************************)
  (*                              Some Properties                           *)
  (**************************************************************************)

  Theorem Equiv1_T :
   forall (Sini : S * Instant) (P : Stream (S * Instant) -> Prop),
   Posible_T Sini P <->
   EX_Until_bound Sini (fun _ : Stream (S * Instant) => True) P.
  Proof.
    unfold iff in |- *; intros; split; intro.
    inversion_clear H.
    apply
     ExUntil_bound with (P := fun _ : Stream (S * Instant) => True) (1 := H0).
    elim H1.
    simple destruct x0; simpl in |- *.
    simple destruct p; simple destruct 1; simpl in |- *; intros.
    constructor 2; assumption.
    simple destruct s; intros.
    constructor 1; trivial.
    inversion_clear H.
    apply posible_T with (1 := H0).
    elim H1.
    simple destruct s; intros.
    constructor 2; assumption.
    intros; constructor 1; simpl in |- *; split; assumption.
  Qed.

  Theorem Equiv2_T :
   forall (Sini : S * Instant) (P : Stream (S * Instant) -> Prop),
   Inevitable_T Sini P <->
   FA_Until_bound Sini (fun _ : Stream (S * Instant) => True) P.
  Proof.
    unfold iff, Inevitable_T, FA_Until_bound in |- *; intros; split; intros.
    elim (H x H0); simple destruct x0.
    simple destruct p; intros.
    elim H1; intros.
    constructor 2; assumption.
    constructor 1; trivial.
    elim (H x H0); intros.
    constructor 2; assumption.
    constructor 1; split; assumption.
  Qed.

  Lemma ConsTrace_T :
   forall (s1 s2 : S * Instant) (x z : Stream (S * Instant)),
   isTraceFrom_T s2 z ->
   isTraceFrom_T s1 (s1 ^ s2 ^ x) -> isTraceFrom_T s1 (s1 ^ z).
  Proof.
    unfold isTraceFrom_T in |- *; simpl in |- *.
    simple destruct z; simple destruct 1; simple destruct 3; simpl in |- *;
     intros.
    compute in H0; rewrite H0 in H4.
    inversion_clear H4 in H1.
    split; [ trivial | apply (isTraceTick H5 H1) ].
    split; [ trivial | apply (isTraceDisc H5 H6 H1) ].
  Qed.

  Lemma notPosible_T :
   forall (P : Stream (S * Instant) -> Prop) (s1 : S * Instant),
   ~ Posible_T s1 P ->
   forall (z : Stream (S * Instant)) (s2 : S * Instant),
   isTraceFrom_T s1 (s1 ^ s2 ^ z) -> ~ Posible_T s2 P.
  Proof.
    unfold not at 2 in |- *; intros.
    elim H1; intros.
    apply H; cut (isTraceFrom_T s1 (s1 ^ x)).
    intro H4; apply (posible_T (P:=P) H4).
    apply Further; assumption.
    apply ConsTrace_T with (1 := H2) (2 := H0); assumption.
  Qed.

  Theorem Equiv3_T :
   forall (Sini : S * Instant) (P : Stream (S * Instant) -> Prop),
   Always_T Sini P <->
   ~ Posible_T Sini (fun s : Stream (S * Instant) => ~ P s).
  Proof.
    unfold iff, Always_T, not in |- *; intros; split.
    intros H H0; inversion_clear H0.
    generalize (H x H1); elim H2; intros.
    inversion_clear H3 in H0.
    elim H0; intros.
    elim (H6 (H4 H3)).
    inversion_clear H4.
    apply (H3 H6).
    generalize Sini; cofix u.
    simple destruct x; intros; constructor.
    intro; elim (classic (P (p ^ s))); [ trivial | intros ].
    absurd (Posible_T Sini0 (fun s : Stream (S * Instant) => ~ P s)).
    assumption.
    apply posible_T with (1 := H0).
    constructor 1; split; assumption.
    elim H0; simpl in |- *; intros.
    apply (u (hd s)); intros.
    generalize H0; clear H0; generalize H3; clear H3.
    rewrite <- H1; case s; simpl in |- *; intros.
    apply (notPosible_T (P:=fun s : Stream (S * Instant) => ~ P s) H H0);
     assumption.
    unfold isTraceFrom_T in |- *; inversion_clear H2; simpl in |- *.
    split; trivial.
    split; trivial.
  Qed.

  Theorem Equiv4_T :
   forall (Sini : S * Instant) (P : Stream (S * Instant) -> Prop),
   SafePath_T Sini P <->
   ~ Inevitable_T Sini (fun s : Stream (S * Instant) => ~ P s).
  Proof.
    unfold iff, Inevitable_T, not in |- *; intros; split.
    intro sp; inversion sp; intros.
    generalize H0; elim (H1 x H); intros.
    inversion_clear H3 in H2.
    elim H2; intros.
    apply (H6 (H4 H3)).
    apply H3; inversion_clear H4; assumption.
    intro H;
     elim
      (not_all_ex_not (Stream (S * Instant))
         (fun x : Stream (S * Instant) =>
          isTraceFrom_T Sini x ->
          ExistsS
            (fun s : Stream (S * Instant) =>
             bound (snd (hd s)) /\ (P s -> False)) x) H).
    intros.
    generalize
     (not_imply_elim2 (isTraceFrom_T Sini x)
        (ExistsS
           (fun s : Stream (S * Instant) =>
            bound (snd (hd s)) /\ (P s -> False)) x) H0).
    generalize
     (not_imply_elim (isTraceFrom_T Sini x)
        (ExistsS
           (fun s : Stream (S * Instant) =>
            bound (snd (hd s)) /\ (P s -> False)) x) H0);
     intros.
    apply safePath_T with (1 := H1).
    generalize H1; clear H1; generalize H2; clear H2.
    generalize x; generalize Sini; cofix u.
    simple destruct x0; intros; constructor.
    elim (classic (P (p ^ s))); [ trivial | intros ].
    cut
     (ExistsS
        (fun s0 : Stream (S * Instant) =>
         bound (snd (hd s0)) /\ (P s0 -> False)) (p ^ s)).
    intro ex; elim (H2 ex).
    apply
     Here
      with
        (P := fun s : Stream (S * Instant) =>
              bound (snd (hd s)) /\ (P s -> False)).
    split; assumption.
    apply u with (Sini := hd s).
    generalize H2; clear H2; case s; unfold not in |- *; intros.
    apply (not_EX H2 H3).
    unfold isTraceFrom_T in |- *; elim H1; intros ig trace;
     inversion_clear trace.
    split; trivial.
    split; trivial.
  Qed.

End TemporalOperators_TCTL.


Require Import compcert.lib.Maps.
Require Import Coq.Relations.Relations.
Require Import Relations.
Require Import Setoid.
Require Import Morphisms.
Import RelationClasses.
Require Import Libraries.CpdtTactics Permutation ExtLib.Data.List Coq.NArith.BinNat.
(* Utility library for Compcert's Maps *)

(* Sections:
    DES: Useful facts about the PTree instance of Maps
    EQMAP: map_get_r (equivalence relation on accessible content) and related
    GETD : Get with default interpreation of None
    EQDMAP: map_getd_r (equivalence relation with default interpretation of None) and related

 *)

Module M := Maps.PTree.
Definition var_dec := M.elt_eq.

Ltac destructAll :=
  match goal with
    | [ H : _ /\ _ |- _] => destruct H; destructAll
    | [ H : exists E, _ |- _ ] => destruct H; destructAll
    | _ => subst
  end.

Section DES.
  Arguments M.empty {A}.

  Theorem xelements_set_leaf {A}: forall  (v:A) i j acc,
    M.xelements' (M.set0 i v) j acc = ((M.prev_append j i), v)::acc.
    Proof.
      induction i; intros; simpl.
      - rewrite IHi. simpl. reflexivity.
      - rewrite IHi. simpl. reflexivity.
      - unfold M.prev.
        reflexivity.
    Qed.

    Theorem elements_set_leaf {A}: forall (v:A) i,
        M.elements (M.set i v M.empty) = cons (i,v) nil.
    Proof.
      intros. unfold M.elements. simpl.
      rewrite xelements_set_leaf. simpl. reflexivity.
  Qed.

    Lemma xelements_set_node_xI {A} i (v : A) l o r :
      M.set (xI i) v (M.Node l o r) = M.Node l o (M.set i v r).
    Proof.
      unfold M.set.
      destruct r; cbn; simpl;
      destruct l; destruct o; auto.
    Qed.

    Lemma xelements_set_node_xO {A} i (v : A) l o r :
      M.set (xO i) v (M.Node l o r) = M.Node (M.set i v l) o r.
    Proof.
      unfold M.set.
      destruct r; cbn; simpl;
      destruct l; destruct o; auto.
    Qed.

    Lemma xelements_set_node_xH {A} (v : A) l o r :
      M.set xH v (M.Node l o r) = M.Node l (Some v) r.
    Proof.
      unfold M.set.
      destruct r; cbn; simpl;
      destruct l; destruct o; auto.
    Qed.

    Theorem xelements_set_none:
    forall (A: Type) v (m: M.t A) i j,
      M.get i m = None ->
      exists l1 l2, M.xelements m j = app l1 l2 /\ M.xelements (M.set i v m) j =
        app l1 (cons (M.prev_append j i,v) l2).
    Proof.
      intros A v m.
      induction m using M.tree_ind; intros.
      - exists nil, nil.
        split; auto. cbn.
        unfold M.set; cbn. now rewrite xelements_set_leaf.
      - destruct i; simpl in *.
        + rewrite M.gNode in H0.
          rewrite xelements_set_node_xI, M.xelements_Node.
          apply IHm0 with (j:= xI j) in H0; do 3 (destruct H0).
          rewrite M.xelements_Node. cbn.
          rewrite H0.
          destruct o.
          * exists (M.xelements l (xO j) ++ ((M.prev j, a) :: x)), x0.
            split. cbn. now rewrite <- app_assoc.
            now rewrite <- app_assoc, H1.
          * exists ((M.xelements l (xO j)) ++ x), x0.
            split; auto. cbn.
            now rewrite <- app_assoc.
            now rewrite H1, <- app_assoc.
        + rewrite M.gNode in H0.
          rewrite xelements_set_node_xO, !M.xelements_Node.
          apply IHm with (j := xO j) in H0; destructAll.
          destruct o as [a|].
          * exists x, (x0 ++ ((M.prev j, a)::M.xelements r (xI j))).
            split; auto. now rewrite (app_assoc x x0), <- H0.
            cbn. now rewrite H1, <- app_assoc.
          * exists x, (x0 ++ M.xelements r (xI j)).
            split; auto. now rewrite (app_assoc x x0), <- H0.
            cbn. now rewrite H1, <- app_assoc.
        + rewrite M.gNode in H0. subst o.
          exists (M.xelements l (xO j)), (M.xelements r (xI j)).
          rewrite xelements_set_node_xH, !M.xelements_Node. split; auto.
    Qed.

  Theorem elements_set_none:
    forall (A: Type) v (m: M.t A) i ,
      M.get i m = None ->
      exists l1 l2, M.elements m = l1 ++ l2 /\ M.elements (M.set i v m) = l1 ++ (i,v)::l2.
  Proof.
    unfold M.elements.
    intros.
    apply xelements_set_none with (v:= v) (j := xH) (m := m) in H.
    simpl in H. apply H.
  Qed.

    Theorem xelements_set_some:
    forall (A: Type) v v' (m: M.t A) i j,
      M.get i m = Some v' ->
      exists l1 l2, M.xelements m j = l1 ++ (M.prev_append j i,v')::l2 /\ M.xelements (M.set i v m) j = l1 ++ (M.prev_append j i,v)::l2.
    Proof.
      intros A v v' m.
      induction m using M.tree_ind; intros.
      - rewrite M.gempty in H. congruence.
      - destruct i; simpl in *.
        + rewrite M.gNode in H0.
          rewrite xelements_set_node_xI, M.xelements_Node.
          apply IHm0 with (j:= xI j) in H0; do 3 (destruct H0).
          rewrite M.xelements_Node. cbn.
          rewrite H0.
          destruct o.
          * exists (M.xelements l (xO j) ++ ((M.prev j, a) :: x)), x0.
            split. cbn. now rewrite <- app_assoc.
            now rewrite <- app_assoc, H1.
          * exists ((M.xelements l (xO j)) ++ x), x0.
            split; auto. cbn.
            now rewrite <- app_assoc.
            now rewrite H1, <- app_assoc.
        + rewrite M.gNode in H0.
          rewrite xelements_set_node_xO, !M.xelements_Node.
          apply IHm with (j := xO j) in H0; destructAll.
          destruct o as [a|].
          * exists x, (x0 ++ ((M.prev j, a)::M.xelements r (xI j))).
            split; auto. cbn.
            change ((M.prev_append j (xO i), v') :: x0 ++ (M.prev j, a) :: M.xelements r (xI j))
              with (((M.prev_append j (xO i), v') :: nil) ++ x0 ++ (M.prev j, a) :: M.xelements r (xI j)).
            rewrite H0, !app_assoc. f_equal.
            now rewrite <- app_assoc.
            change ((M.prev_append j (xO i), v) :: x0 ++ (M.prev j, a) :: M.xelements r (xI j))
              with (((M.prev_append j (xO i), v) :: nil) ++ x0 ++ (M.prev j, a) :: M.xelements r (xI j)).
            rewrite H1, !app_assoc. cbn.
            rewrite <- app_assoc. simpl.
            now rewrite <- (app_assoc x _ x0).
          * exists x, (x0 ++ M.xelements r (xI j)).
            split; auto. simpl.
            now rewrite H0, <- app_assoc.
            now rewrite H1, <- app_assoc.
        + rewrite M.gNode in H0. subst o.
          exists (M.xelements l (xO j)), (M.xelements r (xI j)).
          rewrite xelements_set_node_xH, !M.xelements_Node. split; auto.
    Qed.

  Theorem elements_set_some:
    forall (A: Type) i v v' (m: M.t A),
      M.get i m = Some v'  ->
      exists l1 l2, M.elements m = l1 ++ (i, v') :: l2 /\ M.elements (M.set i v m) = l1 ++ (i,v)::l2.
  Proof.
    unfold M.elements. intros.
    eapply xelements_set_some with (j := xH) in H. simpl in H. apply H.
  Qed.

End DES.

Section EQMAP.

  Definition map_get_r: forall t, relation (M.t t) :=
    fun t => fun sub sub' => forall v, M.get v sub = M.get v sub'.

  Infix " <~m_get~> " := (map_get_r _) (at level 50).

  Theorem smg_refl: forall t, Reflexive (map_get_r t).
  Proof.
    intros; intro; intro; reflexivity.
Qed.

  Theorem smg_sym: forall t, Symmetric (map_get_r t).
  Proof.
    intro; intro; intros; intro; auto.
  Qed.

Theorem smg_trans: forall t, Transitive (map_get_r t).
Proof.
 intros t sub sub' sub''.  unfold map_get_r. intros. specialize (H v). specialize (H0 v). rewrite H. assumption.
Qed.

Instance map_get_r_equiv : forall t, Equivalence (map_get_r t).
Proof. intro. split;
[apply smg_refl |
apply smg_sym |
apply smg_trans].
Qed.

(* following two should be syntactically true *)
Theorem remove_empty: forall t x, map_get_r t (M.remove x (M.empty t)) (M.empty t).
Proof.
  unfold map_get_r; intros. now rewrite !M.gempty.
Qed.

Theorem remove_none: forall t v x, M.get x v = None -> map_get_r t (M.remove x v) v.
Proof.
  unfold map_get_r; intros.
 destruct (var_dec v0 x). subst. rewrite H. rewrite M.grs. reflexivity. rewrite M.gro. reflexivity. assumption.
Qed.

Theorem remove_set_1: forall t x v e, map_get_r t (M.remove x (M.set x e v)) (M.remove x v).
Proof.
 unfold map_get_r; intros.
 destruct (var_dec v0 x). subst. rewrite M.grs. rewrite M.grs. reflexivity.
                                 rewrite M.gro. rewrite M.gso. rewrite M.gro. reflexivity. assumption. assumption. assumption.
Qed.

Theorem remove_set_2: forall t x y v e, x <> y  -> map_get_r t (M.remove x (M.set y e v)) (M.set y e (M.remove x v)).
Proof.
  unfold map_get_r; intros.
  destruct (var_dec v0 x).
  - subst. rewrite M.grs. rewrite M.gso. rewrite M.grs. reflexivity. assumption.
  - rewrite M.gro. 2: assumption. destruct (var_dec v0 y).
    + subst. rewrite M.gss. rewrite M.gss. reflexivity.
    + rewrite M.gso. rewrite M.gso. rewrite M.gro. reflexivity. assumption. assumption. assumption.
Qed.

Theorem remove_remove: forall t x y sub, map_get_r t (M.remove x (M.remove y sub)) (M.remove y (M.remove x sub)).
Proof.
 unfold map_get_r; intros.
  destruct (var_dec v x); destruct (var_dec v y); subst.
  - subst. reflexivity.
  - rewrite M.grs. rewrite M.gro. rewrite M.grs. reflexivity. assumption.
  - rewrite M.gro. rewrite M.grs. rewrite M.grs. reflexivity. assumption.
  - rewrite M.gro. rewrite M.gro. rewrite M.gro. rewrite M.gro. reflexivity. assumption. assumption. assumption. assumption.
Qed.

Theorem set_set: forall t e e' x y sub, x <> y -> map_get_r t (M.set x e (M.set y e' sub)) (M.set y e' (M.set x e sub)).
Proof.
  unfold map_get_r; intros.
  destruct (var_dec v x); destruct (var_dec v y); try (subst x || subst y).
  - exfalso; auto.
  - rewrite M.gss. rewrite M.gso. rewrite M.gss. reflexivity. assumption.
  -  rewrite M.gso. rewrite M.gss. rewrite M.gss. reflexivity. assumption.
  - rewrite M.gso. rewrite M.gso. rewrite M.gso. rewrite M.gso. reflexivity. assumption. assumption. assumption. assumption.
Qed.

Theorem inv_set: forall t e sub sub' v,  map_get_r t (M.remove v sub) (M.remove v sub')  -> map_get_r t (M.set v e sub) (M.set v e sub').
Proof.
  unfold map_get_r; intros.
  specialize (H v0). destruct (var_dec v0 v).
  - subst. rewrite 2 M.gss. reflexivity.
    - rewrite 2 M.gso. rewrite 2 M.gro in H. assumption. assumption. assumption. assumption. assumption.
Qed.

Theorem set_remove: forall t x e sub,  map_get_r t (M.set x e (M.remove x sub)) (M.set x e sub).
Proof.
  unfold map_get_r; intros.
  destruct (var_dec v x).
  + subst. rewrite M.gss. rewrite M.gss. reflexivity.
  + rewrite M.gso. rewrite M.gro. rewrite M.gso. reflexivity. assumption. assumption. assumption.
Qed.

Theorem proper_remove: forall t v,  Proper (map_get_r t ==> map_get_r t) (M.remove v).
Proof.
  intros t v r. unfold map_get_r; intros. destruct (var_dec v0 v).
  - subst. rewrite 2 M.grs. reflexivity.
  - rewrite 2 M.gro. apply H. assumption. assumption.
Qed.

Theorem proper_set: forall t v e, Proper (map_get_r t ==> map_get_r t) (M.set v e).
Proof.
 intros t v e r. unfold map_get_r; intros. destruct (var_dec v0 v).
 - subst. rewrite 2 M.gss. reflexivity.
 - rewrite 2 M.gso. apply H. assumption. assumption.
Qed.

End EQMAP.

Section GETD.
  Definition getd {A:Type} (d:A) :=
  fun v sub => match M.get v sub with
               | None => d
               | Some e => e
               end.

  Theorem e_getd: forall A (d:A) v sub,
                  exists e, getd d v sub = e.
  Proof.
    unfold getd; intros; destruct (M.get v sub);
         [ exists a; reflexivity | exists d; reflexivity].
  Qed.

  Theorem getd_det: forall A v (a1 a2 d:A) sub,
                      getd d v sub  = a1 ->
                      getd d v sub = a2 ->
                      a1 = a2.
  Proof.
    unfold getd; intros; destruct (M.get v sub); subst; trivial.
  Qed.

  Theorem gdss: forall A (d:A) x c v,
         getd d x (M.set x v c) = v.
  Proof.
    intros. unfold getd. rewrite M.gss. reflexivity.
  Qed.

  Theorem gdso: forall A (d:A) x x' c v,
                  x <> x' -> getd d x (M.set x' v c) = getd d x c.
  Proof.
    unfold getd. intros. rewrite M.gso. reflexivity. assumption.
  Qed.

  Theorem gdempty: forall A (d:A) x,
             getd d x (M.empty A) = d.
  Proof.
    unfold getd. symmetry. rewrite M.gempty. reflexivity.
  Qed.

End GETD.

Section EQDMAP.

  Definition map_getd_r: forall t d, relation (M.t t) :=
    fun t d => fun sub sub' => forall v, getd d v sub = getd d v sub'.

  Theorem smgd_refl: forall t d, Reflexive (map_getd_r t d).
  Proof.
    do 4 intro; reflexivity.
  Qed.

  Theorem smgd_sym: forall t d, Symmetric (map_getd_r t d).
  Proof.
    do 6 intro; auto.
  Qed.

  Theorem smgd_trans: forall t d, Transitive (map_getd_r t d).
  Proof.
    intros t d sub sub' sub'';  unfold map_get_r; intros; intro;
    specialize (H v); specialize (H0 v); rewrite H; assumption.
  Qed.

  Instance map_getd_r_equiv : forall t d, Equivalence (map_getd_r t d).
  Proof. intro. split;
           [apply smgd_refl |
            apply smgd_sym |
            apply smgd_trans].
  Qed.

  Theorem remove_empty_d: forall t d x, map_getd_r t d (M.remove x (M.empty t)) (M.empty t).
  Proof.
    unfold map_getd_r; intros. unfold getd. rewrite M.gempty. destruct (var_dec v x). subst.
    rewrite M.gempty. reflexivity. rewrite M.gempty. reflexivity.
  Qed.

  Theorem remove_none_d: forall t d v x, M.get x v = None -> map_getd_r t d (M.remove x v) v.
    unfold map_getd_r; intros. unfold getd.
    destruct (var_dec v0 x). subst. rewrite H. rewrite M.grs. reflexivity. rewrite M.gro. reflexivity. assumption.
  Qed.

  Theorem remove_set_1_d: forall t d x v e, map_getd_r t d (M.remove x (M.set x e v)) (M.remove x v).
  Proof.
    unfold map_getd_r; unfold getd; intros.
    destruct (var_dec v0 x). subst. rewrite M.grs. rewrite M.grs. reflexivity.
    rewrite M.gro. rewrite M.gso. rewrite M.gro. reflexivity. assumption. assumption. assumption.
  Qed.

  Theorem remove_set_2_d: forall t d x y v e, x <> y  -> map_getd_r t d (M.remove x (M.set y e v)) (M.set y e (M.remove x v)).
  Proof.
    unfold map_getd_r; intros. unfold getd.
    destruct (var_dec v0 x).
    - subst. rewrite M.grs. rewrite M.gso. rewrite M.grs. reflexivity. assumption.
    - rewrite M.gro. 2: assumption. destruct (var_dec v0 y).
      + subst. rewrite M.gss. rewrite M.gss. reflexivity.
      + rewrite M.gso. rewrite M.gso. rewrite M.gro. reflexivity. assumption. assumption. assumption.
  Qed.

  Theorem remove_remove_d: forall t d x y sub, map_getd_r t d (M.remove x (M.remove y sub)) (M.remove y (M.remove x sub)).
  Proof.
    unfold map_getd_r; intros. unfold getd.
    destruct (var_dec v x); destruct (var_dec v y); subst.
    - subst. reflexivity.
    - rewrite M.grs. rewrite M.gro. rewrite M.grs. reflexivity. assumption.
    - rewrite M.gro. rewrite M.grs. rewrite M.grs. reflexivity. assumption.
    - rewrite M.gro. rewrite M.gro. rewrite M.gro. rewrite M.gro. reflexivity. assumption. assumption. assumption. assumption.
  Qed.

  Theorem set_set_d: forall t d e e' x y sub, x <> y -> map_getd_r t d (M.set x e (M.set y e' sub)) (M.set y e' (M.set x e sub)).
  Proof.
    unfold map_getd_r; intros. unfold getd.
    destruct (var_dec v x); destruct (var_dec v y); try (subst x || subst y).
    - exfalso; auto.
    - rewrite M.gss. rewrite M.gso. rewrite M.gss. reflexivity. assumption.
    -  rewrite M.gso. rewrite M.gss. rewrite M.gss. reflexivity. assumption.
    - rewrite M.gso. rewrite M.gso. rewrite M.gso. rewrite M.gso. reflexivity. assumption. assumption. assumption. assumption.
  Qed.

  Theorem inv_set_d: forall t d e sub sub' v,  map_getd_r t d (M.remove v sub) (M.remove v sub')  -> map_getd_r t d (M.set v e sub) (M.set v e sub').
  Proof.
    unfold map_getd_r; intros. unfold getd.
    specialize (H v0). destruct (var_dec v0 v).
    - subst. rewrite 2 M.gss. reflexivity.
    - rewrite 2 M.gso. unfold getd in H. rewrite 2 M.gro in H. assumption. assumption. assumption. assumption. assumption.
  Qed.

  Theorem set_remove_d: forall t d x e sub,  map_getd_r t d (M.set x e (M.remove x sub)) (M.set x e sub).
  Proof.
    unfold map_getd_r; unfold getd; intros.
    destruct (var_dec v x).
    + subst. rewrite M.gss. rewrite M.gss. reflexivity.
    + rewrite M.gso. rewrite M.gro. rewrite M.gso. reflexivity. assumption. assumption. assumption.
  Qed.

  Theorem proper_remove_d: forall t d v,  Proper (map_getd_r t d ==> map_getd_r t d) (M.remove v).
  Proof.
    intros t d v r. unfold map_getd_r; unfold getd. intros. destruct (var_dec v0 v).
    - subst. rewrite 2 M.grs. reflexivity.
    - rewrite 2 M.gro. apply H. assumption. assumption.
  Qed.

  Theorem proper_set_d: forall t d v e, Proper (map_getd_r t d ==> map_getd_r t d) (M.set v e).
  Proof.
    intros t d v e r. unfold map_getd_r; unfold getd. intros. destruct (var_dec v0 v).
    - subst. rewrite 2 M.gss. reflexivity.
    - rewrite 2 M.gso. apply H. assumption. assumption.
  Qed.

End EQDMAP.

Theorem gr_some : forall A x y s (a:A), M.get x (M.remove y s) = Some a -> M.get x s = Some a.
Proof.
  intros. destruct (var_dec x y).
  subst; rewrite M.grs in H; inversion H.
  rewrite M.gro in H; assumption.
Qed.

Theorem gr_none: forall A x y (s:M.t A), M.get x s = None -> M.get x (M.remove y s) = None.
Proof.
  intros. destruct (var_dec x y).
  subst; apply M.grs.
  rewrite M.gro; assumption.
Qed.


Require Import List.

Require Import defns.

Require Import nl_sgn.
Require Import nl_eq.
Require Import nl_fusion.
Require Import nl_struct.

(** algeq mockup **)
Lemma algeq_nTy_check:
  forall (sS : snsgn) (sG : snctx) (M N : nte) (tau : snTy),
    wfssig_nl sS ->
    { algeq_nl_te sS sG M N tau } +
    { ~ algeq_nl_te sS sG M N tau}.
Admitted.

(** * weak algorithmic equality **)

(** determinacy **)

Lemma walgeq_nTy_determinacy':
  forall (sA : sTy) (sS : snsgn) (sG : snctx) (A1 A2 : nTy)
    (kappa1 kappa2 : snK),
    sA = struct_nTy A1 ->
    wfssig_nl sS ->
    walgeq_nl_Ty sS sG A1 A2 kappa1 ->
    walgeq_nl_Ty sS sG A1 A2 kappa2 ->
    kappa1 = kappa2.
Proof.
  intros.
  generalize dependent kappa2.
  generalize dependent kappa1.
  generalize dependent A2.
  generalize dependent A1.
  generalize dependent sG.

  induction sA; intros sG A1 Hstruct A2 kappa1 Hwalg1 kappa2 Hwalg2;
  destruct A1 as [a | A11 A12 | A1 M1 ];
  destruct A2 as [a' | A21 A22 | A2 M2 ];
  inversion Hstruct;
  try (solve [inversion Hwalg1 ]).

  - (* tcon case *)
    inversion Hwalg1.
    inversion Hwalg2.
    subst.
    eauto using boundsnTCon_determinacy.

  - inversion Hwalg2.
    inversion Hwalg1.
    reflexivity.

  - (* pi_elim case *)
    inversion Hwalg1.
    inversion Hwalg2.

    assert (Heq : skind_nl_pi_intro tau kappa1
            = skind_nl_pi_intro tau0 kappa2).
    eapply IHsA; eauto.

    inversion Heq.
    reflexivity.
Qed.

Lemma walgeq_nTy_determinacy:
  forall (sS : snsgn) (sG : snctx) (A1 A2 : nTy)
    (kappa1 kappa2 : snK),
    wfssig_nl sS ->
    walgeq_nl_Ty sS sG A1 A2 kappa1 ->
    walgeq_nl_Ty sS sG A1 A2 kappa2 ->
    kappa1 = kappa2.
Proof.
  intros; eauto using walgeq_nTy_determinacy'.
Qed.

(** decidability **)

Lemma walgeq_nTy_dec':
  forall (sA : sTy) (sS : snsgn) (sG : snctx) (A1 A2 : nTy),
    sA = struct_nTy A1 ->
    wfssig_nl sS ->
    { kappa | walgeq_nl_Ty sS sG A1 A2 kappa } +
    { forall kappa , ~ (walgeq_nl_Ty sS sG A1 A2 kappa) }.
Proof.
  intro sA.
  induction sA; intros sS sG A1 A2 Hstruct HwfsS.

  - destruct A1 as [a | | ] ; try (inversion Hstruct).
    destruct A2 as [a' | | ];
      try (solve [right ; intros; intro Hc; inversion Hc]).

    assert ({a = a'} + {a <> a'})
        as [ e | ]
          by (apply eq_tcon).
    + subst.
      assert ({kappa | boundsnTCon a' kappa sS} +
              {forall kappa, ~ boundsnTCon a' kappa sS})
        as [ [kappa] | ]
          by (eauto using boundsnTCon_dec).
        * left; eexists; econstructor; eauto.
        * right; intros; intro Hwalg; inversion Hwalg.
          eapply n; eauto.
    + right; intros; intro Hwalg; inversion Hwalg.
      contradiction.
  - destruct A1 as [ | A11 A12 | ];
    destruct A2 as [ | A21 A22 | ];
    inversion Hstruct;
    try (solve [right; intros; intro Hc; inversion Hc ]).

    + assert ({kappa | walgeq_nl_Ty sS sG A11 A21 kappa} +
              {forall kappa, ~ walgeq_nl_Ty sS sG A11 A21 kappa})
        as [[kappa'] | ]
          by (apply IHsA1; auto).

      * assert ({kappa' = skind_nl_type} + {kappa' <> skind_nl_type})
          as [ | ]
            by (apply eq_snK).

        { (*  *)
          assert ({ A12' | cstu_nTy A12 0 A12'})
            as [ A12' ]
              by (eapply cstu_nTy_dec).
          assert ({ A22' | cstu_nTy A22 0 A22'})
            as [ A22' ]
              by (eapply cstu_nTy_dec).

          assert ({kappa'' | walgeq_nl_Ty sS (erasure_nTy A11 :: sG)
                                A12' A22' kappa''} +
                  {forall kappa'', ~(walgeq_nl_Ty sS (erasure_nTy A11 :: sG)
                                  A12' A22' kappa'')})
            as [ [kappa''] | ]
              by (apply IHsA2; subst; eauto using struct_nTy_cstu).

          - assert ({kappa'' = skind_nl_type} + {kappa'' <> skind_nl_type})
              as [ | ]
                by (apply eq_snK).

            subst.
            left ; eexists; econstructor; eauto.

            right; intros; intro Heq.
            inversion Heq.
            assert (Heq1 : A12' = nA2')
              by (eauto using cstu_nTy_determinacy).

            assert (Heq2 : A22' = nB2')
              by (eauto using cstu_nTy_determinacy).
            subst.
            apply n.
            eapply walgeq_nTy_determinacy; eauto.

          - right; intros; intro Hc; inversion Hc.

            assert (Heq1 : A12' = nA2')
              by (eauto using cstu_nTy_determinacy).

            assert (Heq2 : A22' = nB2')
              by (eauto using cstu_nTy_determinacy).

            subst.
            eapply n; eauto. }

        { right; intros; intro Hc; inversion Hc.
          apply n.

          eapply walgeq_nTy_determinacy; eauto. }

      * right; intros; intro Hc; inversion Hc.
        eapply n; eauto.

  - destruct A1 as [ | | A1 M1 ] ;
    destruct A2 as [ | | A2 M2];
    inversion Hstruct;
    try (solve [ right ; intros; intro Hc; inversion Hc ]).

    assert ({kappa' | walgeq_nl_Ty sS sG A1 A2 kappa'} +
            {forall kappa', ~ walgeq_nl_Ty sS sG A1 A2 kappa'})
      as [ [ [ | tau kappa'] ]  | ]
           by (apply IHsA; auto).

    + right; intros; intro Hc; inversion Hc.

      assert (Hcontra : skind_nl_type = skind_nl_pi_intro tau kappa)
        by (eapply walgeq_nTy_determinacy; eauto).

      inversion Hcontra.

    + assert ({algeq_nl_te sS sG M1 M2 tau} +
              {~ algeq_nl_te sS sG M1 M2 tau})
        as [ | ]
          by (apply algeq_nTy_check; eauto).

      * left; eexists; econstructor; eauto.
      * right; intros; intro Hc; inversion Hc.

        assert (Heq : skind_nl_pi_intro tau kappa'
                      = skind_nl_pi_intro tau0 kappa)
          by (eapply walgeq_nTy_determinacy; eauto).
        inversion Heq.
        subst.
        contradiction.

    + right; intros; intro Hc; inversion Hc.
      eapply n; eauto.
Qed.

Lemma walgeq_nTy_dec:
  forall (sS : snsgn) (sG : snctx) (A1 A2 : nTy),
    wfssig_nl sS ->
    { kappa | walgeq_nl_Ty sS sG A1 A2 kappa } +
    { forall kappa , ~ (walgeq_nl_Ty sS sG A1 A2 kappa) }.
Proof.
  intros; eauto using walgeq_nTy_dec'.
Qed.

(** wagleq checking **)

Lemma walgeq_nTy_check:
  forall (sS : snsgn) (sG : snctx) (A1 A2 : nTy) (kappa : snK),
    wfssig_nl sS ->
    { walgeq_nl_Ty sS sG A1 A2 kappa} +
    { ~ (walgeq_nl_Ty sS sG A1 A2 kappa) }.
Proof.
  intros.

  assert ({kappa' | walgeq_nl_Ty sS sG A1 A2 kappa'} +
          {forall kappa', ~ walgeq_nl_Ty sS sG A1 A2 kappa'})
    as [ [kappa'] | ]
      by (eauto using walgeq_nTy_dec).

  - assert ({kappa = kappa'} + {kappa <> kappa'})
      as [ | ]
        by (apply eq_snK).

    + subst; left; auto.
    + right; intro.
      assert (kappa = kappa') by (eauto using walgeq_nTy_determinacy).
      contradiction.
  - right; intro.
    eapply n; eauto.
Qed.


CoInductive stream {A} : Type :=
| Cons (a : A) (s : stream) : stream
.

CoFixpoint ones := Cons 1 ones.
CoFixpoint twos := Cons 2 twos.

(* cofixes only reduce when they are the target of a match *)
Goal ones = ones.
  cbv.
  reflexivity.
Qed.
Goal match ones with
     | Cons a s => s
     end = ones.
  simpl.
  reflexivity.
Qed.

(* Not guarded *)
Fail CoFixpoint loop : stream nat := loop.

Fixpoint approx {A} n (s : stream) : list A :=
  match n with
  | O => nil
  | S n => match s with
          | Cons a s' => cons a (approx n s')
          end
  end.

Compute approx 10 ones.

CoFixpoint map {A B} (f : A -> B) (s : stream) : stream :=
  match s with
  | Cons a s' => Cons (f a) (map f s')
  end.

Compute approx 10 (map (fun x => x + 1) ones).

(* Not guarded (since this function may never finish) *)
Fail CoFixpoint filter {A} (p : A -> bool) (s : stream) : stream :=
  match s with
  | Cons a s' => if p a then Cons a (filter p s') else filter p s'
  end.

Section SubjectReduction.
  CoInductive tick := Tick : tick -> tick.
  CoFixpoint loop := Tick loop.

  (* simply eq_refl is also a valid proof *)
  Definition etaeq : loop = loop :=
    match loop with
    | Tick t => eq_refl (Tick t)
    end.

  (* The dependent pattern match gives us some information (the
     definition of loop) about the structure of loop, and reducing the
     match loses this information, resulting in a different type *)
  Eval compute in etaeq.
  Fail Definition BOOM : loop = loop := Eval compute in etaeq.
End SubjectReduction.

Require Import Paco.paco.

(** Example from "The Power of Parameterization in Coinductive Proof"

    a ---> b ---> c
         /^     ^ |
        //     /  |
       //     /   |
      v/     /    v
    d      e      f
*)

(* The finite type of Nodes: *)

Inductive Node: Type := a | b | c | d | e | f.

(* The edge relation *)
Inductive edge: Node -> Node -> Prop :=
| Sab: edge a b
| Sbc: edge b c
| Sbd: edge b d
| Sdb: edge d b
| Sec: edge e c
| Scf: edge c f
.
Hint Constructors edge.

(* We want to define the set of nodes from which it is possible to step indefinitely. (a, b, d)
   We have essentially three possibilities.
 *)

(* The positive coinductive style.
   Historical way of doing things in Coq
   Known to break subject reduction.
 *)
CoInductive inf : Node -> Prop :=
| step: forall x y, inf y -> edge x y -> inf x.

(* The negative coinductive style.
   Define first the functor, then define the coinductive
   as a coinductive record with primitive projections on
   to prevent pattern matching having a single field
   forcing the call to the functor.
   Think of it as: the primitive projection allows you
   to "observe" the outside call to the functor, that
   may in turn return a new state, i.e. a new object
   that you can observe.
 *)
Set Primitive Projections.
Inductive F (X: Node -> Prop): Node -> Prop :=
| Fstep: forall x y, X y -> edge x y -> F X x.
Hint Constructors F.

CoInductive inf' (x: Node) : Prop :=
  go { _observe : F inf' x}.

(* The paco way.
   While the two previous options stand both for
   coinductive types and coinductive predicates, paco
   is specific to coinductive predicates.
   It relies on the paco library to wrap Coq's syntactic
   guard checker into a semantic one based on a generalization
   of Tarski's theorem over a parameterized cofixed point.
 *)
Definition inf'' := paco1 F bot1.
Hint Unfold inf''.

(* We can now prove that a is the source of an infinite path.
   The normal way:
 *)
Lemma b_inf: inf b.
Proof.
  cofix CIH.
  apply step with d; auto.
  apply step with b; auto.
Qed.

Lemma a_inf: inf a.
Proof.
  apply step with b; auto.
  cofix CIH.
  apply step with d; auto.
  apply step with b; auto.
Qed.

(* The negative way: *)
Lemma a_inf': inf' a.
Proof.
  constructor.
  apply Fstep with b; auto.
  cofix CIH.
  constructor; apply Fstep with d; auto.
  constructor; apply Fstep with b; auto.
Qed.

(* The paco way: *)
Lemma a_inf'': inf'' a.
Proof.
  pfold.
  apply Fstep with b; auto.
  left.
  pcofix IHb.
  pfold.
  apply Fstep with d; auto.
  left.
  pfold.
  apply Fstep with b; auto.
Qed.

Lemma F_mon: monotone1 F.
Proof.
  pmonauto.
Qed.
Hint Resolve F_mon : paco.


From Coq Require Import
     Basics
     RelationClasses
     Program.Equality
     Logic.Eqdep.

From Coinduction Require Import
     coinduction rel tactics.

From ITree Require Import
     Core.Subevent.

From CTree Require Import
     CTree
     Utils
     Eq.Equ
     Eq.Shallow
     Eq.Trans.

From RelationAlgebra Require Export
     rel monoid srel.

Import CTree.
Set Implicit Arguments.

(* TODO: Decide where to set this *)
Arguments trans : simpl never.

(*| The function defining weak simulation (left plays): [trans] of [L] must be answered by
  [ltrans] of [L +' R] plays. |*)
Program Definition wsl {L R C X} `{B0 -< C}:
  mon (ctree L C X -> ctree (L +' R) C X -> Prop) :=
  {| body R t u :=
    forall l t' (x: X), trans (obs l x) t t' -> exists u' , ltrans l x u u' /\ R t' u'
  |}.
Next Obligation.
  edestruct H1 as (u' & l' & ?); eauto.
Qed.

(*| The function defining weak simulation (right plays): [trans] of [R] must be answered by
  [rtrans] of [L +' R] plays. |*)
Program Definition wsr {L R C X} `{B0 -< C}:
  mon (ctree R C X -> ctree (L +' R) C X -> Prop) :=
  {| body R t u :=
    forall l t' (x: X), trans (obs l x) t t' -> exists u' , rtrans l x u u' /\ R t' u'
  |}.
Next Obligation.
  edestruct H1 as (u' & l' & ?); eauto.
Qed.

#[global] Instance weq_wsl : forall {L R C X} `{B0 -< C},
    Proper (weq ==> weq) (@wsl L R C X _).
  Proof.
    cbn; intros; split; intros; apply H1 in H2 as (? & ? & ?);
      exists x1; split.
    - apply H2; now apply H0.
    - now apply H0.
    - apply H2; now apply H0.
    - now apply H0.
  Qed.

Definition wsiml {L R C X} `{HasStuck : B0 -< C} :=
  (gfp (@wsl L R C X _): hrel _ _).

#[global] Instance weq_wsr : forall {L R C X} `{B0 -< C},
    Proper (weq ==> weq) (@wsr L R C X _).
  Proof.
    cbn; intros; split; intros; apply H1 in H2 as (? & ? & ?);
      exists x1; split.
    - apply H2; now apply H0.
    - now apply H0.
    - apply H2; now apply H0.
    - now apply H0.
  Qed.

Definition wsimr {L R C X} `{HasStuck : B0 -< C} :=
  (gfp (@wsr L R C X _): hrel _ _).


Require Import String.
Import List.
Import ListNotations.

Require Import Input_Properties.
Require Import Flood_Properties.
Require Import Flood_Box.

Require Import add_message_to_all_properties.
Require Import extract_port_buffer_message_properties.
Require Import execute_flood_aux_properties.

Require Import List_Properties.

Definition buffer_reveals_input_in_trace_def (inp : inputs) : Prop :=
  forall buf port_buf trace i j p c m n,
  execute_flood_rec inp (Flood_Box_init n) = (trace, buf) ->
  nth_error buf i = Some port_buf ->
  nth_error port_buf j = Some (p, m, c) ->
  exists t, nth_error trace t = Some (Flood_Input p (m, c)).

Lemma buffer_reveals_input_in_trace:
  forall inp,
  buffer_reveals_input_in_trace_def inp.
Proof.
  apply rev_ind;
  unfold buffer_reveals_input_in_trace_def.
  - intros buf port_buf trace i j p c m n.
    intros H_exec H_index_port_buf H_index_mes.
    simpl in H_exec.
    inversion H_exec. subst. clear H_exec.
    assert (port_buf = [])
      as H_empty_port
      by (apply Flood_Box_init_buffers_empty with n i;
          assumption).
    rewrite H_empty_port in H_index_mes.
    destruct j;
    simpl in H_index_mes;
    discriminate.
  - intros a inp.
    intros H_ind.
    intros buf port_buf trace i j p c m n.
    intros H_exec H_index_port_buf H_index_mes.
    destruct a.
    + apply concat_inp_concats_trace_split in H_exec.
      destruct H_exec as [buf' H_exec].
      destruct H_exec as [trace_head H_exec].
      destruct H_exec as [trace_tail H_exec].
      destruct H_exec as [H_trace H_exec].
      destruct H_exec as [H_exec_inp H_exec_send].
      simpl in H_exec_send.
      destruct p0 in H_exec_send.
      inversion H_exec_send.
      assert (exists port_buf', port_buf = (n0, s, n1) :: port_buf')
        as H_port_buf
        by (apply add_message_to_all_reveals_older_messages with buf' buf i;
            auto).
      destruct H_port_buf as [port_buf' H_port_buf].
      rewrite H_port_buf in H_index_mes.
      destruct j.
      * simpl in H_index_mes.
        inversion H_index_mes.
        subst.
        exists (Datatypes.length trace_head).
        rewrite nth_error_app2.
        -- rewrite PeanoNat.Nat.sub_diag.
           simpl.
           reflexivity.
        -- apply PeanoNat.Nat.le_refl.
      * assert (exists t : nat, nth_error trace_head t = Some (Flood_Input p (m, c)))
          as H_trace_input.
        -- apply H_ind with buf' port_buf' i j n.
           ++ assumption.
           ++ eapply add_message_to_all_old_lookups;
              eauto.
              rewrite H1.
              rewrite <- H_port_buf.
              assumption.
           ++ simpl in H_index_mes.
              assumption.
        -- destruct H_trace_input as [t H_trace_input].
           exists t.
           rewrite H_trace.
           apply nth_succes_larger.
           assumption.
    + apply concat_inp_concats_trace_split in H_exec.
      destruct H_exec as [buf' H_exec].
      destruct H_exec as [trace_head H_exec].
      destruct H_exec as [trace_tail H_exec].
      destruct H_exec as [H_trace H_exec].
      destruct H_exec as [H_exec_inp H_exec_deliver].
      simpl in H_exec_deliver.
      destruct p0.
      destruct (extract_port_buffer buf' n1 n0 n1 s n2) eqn:extract.
      destruct o.
      * do 3 destruct p0.
        assert (n0 = n5 /\ n1 = n4 /\ s = s0 /\ n2 = n3)
          as H_eq
          by (eapply extract_port_buffer_success_same_output;
              eassumption).
        destruct H_eq as [H_eqi H_eq].
        destruct H_eq as [H_eqj H_eq].
        destruct H_eq as [H_eqm H_eqc].
        subst.
        inversion H_exec_deliver.
        subst. clear H_exec_deliver.
        assert (exists k' h' port_buf',
                  nth_error buf' k' = Some port_buf' /\
                  nth_error port_buf' h' = Some (p, m, c))
          as H_message_exists
          by (eapply extract_port_buffer_success_lookups_reveal_old;
              eassumption).
        destruct H_message_exists as [k' H_message_exists].
        destruct H_message_exists as [h' H_message_exists].
        destruct H_message_exists as [port_buf' H_message_exists].
        destruct H_message_exists as [H_mess_port_buf H_mess_exists].
        assert (exists t : nat, nth_error trace_head t = Some (Flood_Input p (m, c)))
          as H_trace_head_input
          by (eapply H_ind;
              eassumption).
        destruct H_trace_head_input as [t H_trace_head_input].
        exists t.
        rewrite concat_list_two.
        do 2 apply nth_succes_larger.
        assumption.
      * apply extract_port_buffer_none_action_same_buffer in extract.
        inversion H_exec_deliver.
        subst. clear H_exec_deliver.
        assert (exists t : nat, nth_error trace_head t = Some (Flood_Input p (m, c)))
          as H_trace_head_input
          by (apply H_ind with buf port_buf i j n;
              assumption).
        destruct H_trace_head_input as [t H_trace_head_input].
        exists t.
        apply nth_succes_larger.
        assumption.
Qed.


Set Implicit Arguments.

From mathcomp.ssreflect
Require Import ssreflect ssrnat seq ssrbool ssrfun fintype choice eqtype .
From Probchain
Require Import Comp.

Lemma size_enum_equiv: forall n: nat, size(enum (ordinal n.+1)) = n.+1 -> #|ordinal_finType n.+1| = n.+1.
Proof.
    move=> n H.
    by rewrite unlock H.
Qed.
Definition random n := (@Rnd (ordinal_finType n.+1) n (size_enum_equiv (size_enum_ord n.+1))).

Notation "'ret' v" := (Ret _ v) (at level 75).

Notation "[0 ... n ]" := (random n).
Notation "{ 0 , 1 } ^ n" := (random (2^n))
    (right associativity, at level 77).

Notation "{ 0 , 1 }" := (random 1)
    (right associativity, at level 75).

Notation "x <-$ c1 ; c2" := (@Bind _ _ c1 (fun x => c2))
    (right associativity, at level 81, c1 at next level).

Notation "x <- e1 ; e2" := ((fun x => e2) e1)
    (right associativity, at level 81, e1 at next level).

Definition example :=
    x <- 3;
    y <-$ [0 ... 3];
    ret y.
About example.