Require Export Lci.
Require Export misc.
Require Export groups.
Require Export Compare_dec.

Section ring.

Variable S : Set.
Variable A : S -> Prop.
Variable Add Mult : S -> S -> S.
Variable O I : S.
Variable Opp : S -> S.
Variable v : S -> nat.

Definition is_ring :=
  commutativity S Add /\
  is_group S A Add O Opp /\
  intern S A Mult /\ associativity S Mult /\ distributivity S Add Mult.

Lemma mult_O : is_ring -> forall x : S, A x -> Mult x O = O /\ Mult O x = O.
Proof.
intros.
elim H; intros; elim H2; intros; elim H3; intros; elim H4; intros.
elim H6; intros; elim H8; intros; elim H10; intros; elim H13; intros.
clear H2 H4 H5 H6 H8 H9 H10 H11 H13 H14.
split.
(* [x*0 = 0] *)
apply
 (regular_l S A Add O Opp H3 (Mult x O) O (H7 x O H0 H15) H15
    (Mult x O) (H7 x O H0 H15)).
elim (H16 (Mult x O) (H7 x O H0 H15)); intros; rewrite H2.
elim (H12 x O O); intros; elim H6.
elim (H16 O H15); intros; rewrite H8; reflexivity.
(* [0*x = 0] *)
apply
 (regular_l S A Add O Opp H3 (Mult O x) O (H7 O x H15 H0) H15
    (Mult O x) (H7 O x H15 H0)).
elim (H16 (Mult O x) (H7 O x H15 H0)); intros; rewrite H2.
elim (H12 O O x); intros; elim H5.
elim (H16 O H15); intros; rewrite H8; reflexivity.
Qed.

Lemma mult_opp_r :
 is_ring -> forall x y : S, A x -> A y -> Mult x (Opp y) = Opp (Mult x y).
Proof.
intros.
elim H; intros; elim H3; intros; elim H4; intros; elim H5; intros.
elim H7; intros; elim H9; intros; elim H11; intros; elim (H15 y H1); intros.
elim H17; intros; elim H19; intros.
clear H2 H3 H5 H6 H7 H9 H10 H11 H12 H14 H15 H16 H17 H19.
apply (opp_unicity S A Add O Opp H4 (Mult x y) (Mult x (Opp y))).
unfold is_opposite in |- *; split.
exact (H8 x y H0 H1).
split.
exact (H8 x (Opp y) H0 H18).
elim (mult_O H x H0); intros; elim H2; clear H H0 H1 H2 H3 H4 H8 H18.
pattern O at 1 in |- *; elim H20; elim H21; clear H20 H21.
elim (H13 x y (Opp y)); intros; rewrite H0; clear H H0.
elim (H13 x (Opp y) y); intros; rewrite H0; auto.
Qed.

Lemma mult_opp_l :
 is_ring -> forall x y : S, A x -> A y -> Mult (Opp x) y = Opp (Mult x y).
Proof.
intros.
elim H; intros; elim H3; intros; elim H4; intros; elim H5; intros.
elim H7; intros; elim H9; intros; elim H11; intros; elim (H15 x H0); intros.
elim H17; intros; elim H19; intros.
clear H2 H3 H5 H6 H7 H9 H10 H11 H12 H14 H15 H16 H17 H19.
apply (opp_unicity S A Add O Opp H4 (Mult x y) (Mult (Opp x) y)).
unfold is_opposite in |- *; split.
exact (H8 x y H0 H1).
split.
exact (H8 (Opp x) y H18 H1).
elim (mult_O H y H1); intros; elim H3; clear H H0 H1 H2 H3 H4 H8 H18.
pattern O at 1 in |- *; elim H20; elim H21; clear H20 H21.
elim (H13 x (Opp x) y); intros; rewrite H; clear H H0.
elim (H13 (Opp x) x y); intros; rewrite H; auto.
Qed.

Lemma mult_opp_opp :
 is_ring -> forall x y : S, A x -> A y -> Mult (Opp x) (Opp y) = Mult x y.
Proof.
intros.
elim H; intros; elim H3; intros; elim H4; intros; elim H5; intros.
elim H7; intros; elim H9; intros; elim H11; intros; elim (H15 x H0); intros.
elim H17; intros; clear H2 H3 H5 H6 H7 H9 H10 H11 H12 H13 H14 H15 H16 H17 H19.
rewrite (mult_opp_r H (Opp x) y H18 H1).
rewrite (mult_opp_l H x y H0 H1).
symmetry  in |- *.
exact (opp_opp S A Add O Opp H4 (Mult x y) (H8 x y H0 H1)).
Qed.

Definition integrity := forall a b : S, Mult a b = O -> {a = O} + {b = O}.

Definition is_unitary_commutative_ring :=
  is_ring /\ commutativity S Mult /\ neutral S A Mult I.

(* Division *)

Definition divide (a b : S) :=
  A a /\ A b /\ (b = O \/ a <> O /\ (exists q : S, A q /\ b = Mult a q)).

Theorem div_O_O : is_ring -> divide O O.
Proof.
unfold divide in |- *; intros.
elim H; intros; elim H1; intros; elim H2; intros; elim H5; intros.
elim H7; intros; elim H8; intros.
split. exact H10.
split. exact H10.
left; reflexivity.
Qed.

Theorem div_add :
 is_ring -> forall a b d : S, divide d a -> divide d b -> divide d (Add a b).
Proof.
unfold divide in |- *; intros.
split.
(* [A d] *)
elim H0; trivial.
split.
(* [A (a+b)] *)
elim H; intros; elim H3; intros; elim H4; intros.
elim H0; intros; elim H9; intros; elim H1; intros; elim H13; intros.
exact (H6 a b H10 H14).
(* [a+b = 0 or d <> 0 and a+b = d*q] *)
elim H; intros; elim H3; intros; elim H4; intros; elim H5; intros.
elim H7; intros; elim H9; intros; elim H11; intros; elim H14; intros.
clear H H2 H3 H4 H5 H7 H8 H9 H10 H11 H12 H14 H15 H16.
elim H0; intros; elim H2; intros; clear H H0 H2.
elim H1; intros; elim H0; intros; clear H H0 H1.
  (* [a = 0] *)
elim H4; intros. rewrite H.
elim (H17 b H2); intros. rewrite H1.
exact H5.
  (* [b = 0] *)
elim H5; intros. rewrite H0.
elim (H17 a H3); intros. rewrite H1.
exact H4. clear H2 H3 H4 H5 H17.
  (* [a <> 0 and b <> 0] *)
right.
elim H; intros; elim H2; intros; elim H3; intros; clear H H2 H3.
elim H0; intros; elim H2; intros; elim H3; intros; clear H H0 H2 H3.
split.
exact H1. clear H1.
exists (Add x x0).
split.
exact (H6 x x0 H4 H7).
elim (H13 d x x0); intros. clear H4 H6 H7 H13.
rewrite H0. clear H H0.
elim H5; elim H8; reflexivity.
Qed.

Theorem div_mult :
 is_ring -> forall a b d : S, divide d a -> A b -> divide d (Mult a b).
Proof.
unfold divide in |- *; intros.
(* [A d] *)
elim H0; intros. split. exact H2. clear H0 H2.
(* [A (a*b)] *)
elim H; intros; elim H2; intros; elim H5; intros; elim H7; intros.
clear H0 H2 H4 H5 H7 H9.
elim H3; intros.
split. exact (H6 a b H0 H1). clear H0 H3.
(* [a*b = 0 or d <> 0 and a*b = d*q] *)
  (* [a = 0] *)
elim H2; intros. rewrite H0.
elim (mult_O H b H1); intros. rewrite H4. left; reflexivity. clear H H2.
  (* [a <> 0] *)
right.
elim H0; intros; elim H2; intros. split. exact H.
exists (Mult x b).
elim H3; intros. split. exact (H6 x b H4 H1).
rewrite (H8 d x b). elim H5; reflexivity.
Qed.

Theorem div_opp : is_ring -> forall a d : S, divide d a -> divide d (Opp a).
Proof.
unfold divide in |- *; intros.
(* [A d] *)
elim H0; intros; elim H2; intros. split. exact H1. clear H0 H2.
(* [A (-a)] *)
elim H; intros; elim H2; intros; elim H5; intros; elim H8; intros.
elim H10; intros; elim (H12 a H3); intros; elim H14; intros.
split. exact H15. clear H0 H2 H3 H6 H7 H8 H9 H10 H13 H14 H15 H16.
(* [(-a) = 0 or d <> 0 and (-a)= d*q] *)
  (* [a = 0] *)
elim H4; intros. rewrite H0. left. exact (opp_neutral S A Add O Opp H5).
clear H4 H11.
  (* [a <> 0] *)
right.
elim H0; intros; elim H3; intros; elim H4; intros.
split. exact H2. clear H0 H2 H3 H4.
exists (Opp x).
elim (H12 x H6); intros; elim H2; intros. split. exact H3.
clear H3 H4 H5 H6 H12.
rewrite (mult_opp_r H d x H1 H0). elim H7; reflexivity.
Qed.

Definition is_gcd (a b d : S) :=
  divide d a /\
  divide d b /\ (forall q : S, divide q a -> divide q b -> divide q d).

Lemma gcd_null : forall a b : S, is_gcd a b O -> a = O /\ b = O.
Proof.
unfold is_gcd in |- *; intros.
elim H; intros; elim H0; intros; elim H3; intros.
elim H5; intros. split. exact H6. clear H H0 H2 H3 H4 H5 H6.
elim H1; intros; elim H; intros; elim H3; intros; elim H5; intros. exact H6.
elim H6; intros; elim H7; reflexivity.
elim H6; intros; elim H7; reflexivity.
Qed.

Lemma gcd_null2 : is_ring -> forall d : S, is_gcd O O d -> d = O.
Proof.
unfold is_gcd in |- *. intros.
elim H0; intros; elim H2; intros.
elim (H4 O (div_O_O H) (div_O_O H)); intros; elim H6; intros.
elim H8; intros. exact H9.
elim H9; intros; elim H10; reflexivity.
Qed.

Lemma simplification_integrity :
 is_unitary_commutative_ring ->
 integrity -> forall a x : S, A a -> A x -> a <> O -> Mult a x = a -> x = I.
Proof.
intros. elim H; intros; elim H5; intros; elim H6; intros; elim H8; intros.
elim H11; intros; elim H12; intros; elim H14; intros; elim H16; intros.
elim H18; intros. clear H6 H8 H9 H12 H13 H14 H15 H16 H17 H18 H19 H21.
rewrite (opp_opp S A Add O Opp H11 x H2).
symmetry  in |- *; apply (opp_unicity S A Add O Opp H11 (Opp x) I).
elim (H22 x H2); intros; elim H8; intros; elim H10; intros.
apply (opp_com S A Add O H7 (Opp x) I H9 H13). clear H6 H8 H12 H13.
elim (H0 a (Add (Opp x) I)); intros.
elim H3. exact a0. exact b.
elim (H20 a (Opp x) I); intros. rewrite H8. elim (H14 a H1); intros.
rewrite H12. clear H6 H8 H9 H12 H13 H14.
rewrite (mult_opp_r H5 a x H1 H2). rewrite H4.
elim (H22 a H1); intros; elim H8; intros; elim H12; intros; exact H14.
Qed.

Lemma gcd_unicity_apart_unities :
 is_unitary_commutative_ring ->
 integrity ->
 forall a b d1 d2 : S,
 is_gcd a b d1 ->
 is_gcd a b d2 ->
 exists x : S, inversible S Mult I x /\ A x /\ d2 = Mult d1 x.
Proof.
intros.
elim H2; intros; elim H4; intros; elim H1; intros; elim H8; intros.
elim (H6 d1 H7 H9); intros; elim H12; intros; elim H14; intros.
(* [d2 = O] *)
exists I. unfold inversible in |- *.
elim H; intros; elim H17; intros; elim H19; intros.
split. exists I. exact (H21 I H20). split. exact H20.
elim (gcd_null a b); intros. rewrite H15. rewrite (gcd_null2 H16 d1).
elim (mult_O H16 I); intros. symmetry  in |- *; exact H25. exact H20.
pattern O at 1 in |- *; elim H22; elim H23; exact H1. elim H15; exact H2.
(* [d2 <> 0] *)
elim H15; intros; elim H17; intros. exists x.
elim H; intros; elim H20; intros. split. apply (inv_com S Mult I x H21).
elim H1; intros; elim H24; intros; elim (H26 d2 H3 H5); intros.
elim H28; intros; elim H30; intros. elim H16; exact H31.
(* [d1 <> 0] *)
elim H31; intros; elim H33; intros. exists x0.
elim H34; intro; clear H35. elim H18; intro; intro. rewrite H36.
elim H; intros H37 H38; elim H37; intros H39 H40; elim H40; intros H41 H42.
elim H42; intros H43 H44; elim H44; intros H45 H46; elim (H45 d1 x x0);
 intros.
elim H34; intros.
apply
 (simplification_integrity H H0 d1 (Mult x x0) H11 (H43 x x0 H35 H48) H16).
symmetry  in |- *; exact H47.
exact H18.
Qed.

Lemma opp_O : is_ring -> forall x : S, A x -> Opp x = O -> x = O.
Proof.
intros.
elim H; intros; elim H3; intros. rewrite (opp_opp S A Add O Opp H4 x H0).
rewrite H1. exact (opp_neutral S A Add O Opp H4).
Qed.

End ring.


Require Import Coq.Lists.List.
Require Import Coq.ZArith.ZArith.
Require Import Coq.Strings.String.
Require Import Logic.

Import ListNotations.

Require Import Omega. (* for omega tactic *)

Open Scope Z_scope. (* we must use integer Z, rather than natural number, this declaration is madetory *)

(* Syntax of Clock-based Dynamic Logic *)

(* Syntax of SEP_exp (Synchonous Event Program) *)

(* ========================= Syntax of CPM_exp ========================*)

(* =============== Syntax of Expressions ===================*)

(* variable name*)
Inductive Var := var : Z -> Var.

Definition x : Var := (var 1).
Definition y : Var := (var 2).
Definition z : Var := (var 3).
Definition k : Var := (var 4).

(* clock name *)
Inductive CName := clk : Z -> CName.

Definition c : CName := (clk 11).
Definition d : CName := (clk 12).
Definition c1 : CName  := (clk 13).
Definition c2 : CName  := (clk 14).
Definition c3 : CName  := (clk 15).
Definition c4 : CName  := (clk 16).

(* function h*)
Inductive h_f := hC : CName -> h_f.

(* function eta (we use y to express `eta')*)
Inductive y_f := yC : CName -> y_f.

(* guard g*)
Inductive g_exp :=
  gltC : h_f -> h_f -> Z -> g_exp |
  gleC : h_f -> h_f -> Z -> g_exp |
  ggtC : h_f -> h_f -> Z -> g_exp |
  ggeC : h_f -> h_f -> Z -> g_exp |
  geqC : h_f -> h_f -> Z -> g_exp
.

Print g_exp.

(* 33 - 41 *)
Notation "D( c1 , c2 ) < k" := (gltC (hC c1) (hC c2) k) (at level 35).
Notation "D( c1 , c2 ) <= k" := (gleC (hC c1) (hC c2) k) (at level 35).
Notation "D( c1 , c2 ) > k" := (ggtC (hC c1) (hC c2) k) (at level 35).
Notation "D( c1 , c2 ) >= k" := (ggeC (hC c1) (hC c2) k) (at level 35).
Notation "D( c1 , c2 ) == k" := (geqC (hC c1) (hC c2) k) (at level 35).

Check D(c, d) < 5.
Check D(c,d) >= -5.
Check D(c, d) == 5.

(* clock event *)
Definition ClkEvt := list CName.

Check ClkEvt.
Check c :: d :: nil.

(* Syntax of CPM *)
Inductive CPM_exp : Type :=
  evtC : ClkEvt -> CPM_exp | (* clock event *)
  gevtC : g_exp -> ClkEvt -> CPM_exp | (* guarded clock event *)
  eps : CPM_exp | (* empty program *)
  halt : CPM_exp | (* halting program *)
  seqC : CPM_exp -> CPM_exp -> CPM_exp | (* sequence *)
  choC : CPM_exp -> CPM_exp -> CPM_exp | (* choice *)
  starC : CPM_exp -> CPM_exp |(* finite loop *)
  omegaC : CPM_exp -> CPM_exp (* infinite loop *)
.

Coercion evtC : ClkEvt >-> CPM_exp. (* it does not work here *)
Notation "{ a1 | .. | an }" := (cons a1 .. (cons an nil) .. ) (at level 45).
Check { c | d }.
Notation "@ a" := (evtC a) (at level 46).
Definition idle : ClkEvt := nil.
Check idle.
Notation "g ? a" := (gevtC g a) (at level 48).
Notation "P1 ; P2" := (seqC P1 P2) (at level 49, right associativity).
Notation "P1 'U' P2" := (choC P1 P2) (at level 51, right associativity).
Notation "P ^*" := (starC P) (at level 47, left associativity).
Notation "P ^w" := (starC P) (at level 47, left associativity).

Locate "^*".
Locate "^w".
Check c :: d :: nil.
Check evtC (c :: c1 :: nil).
Check { c | d }.
Check idle.
Check @ { c } ; ((D(c, d)<2) ? { d })^w.
Check @ { c } U ((D(c, d)<2) ? { d })^w.
Check @ {c} ; ((D(c, d)<2) ? { d })^w.
(*Check @ { c } ; ((h(hC c, hC d)<2) ? { d })^w.*)

(* ========================================= Syntax of cDL Formula ===============================================*)

(* expression e *)
Inductive e_exp :=
  varC : Var -> e_exp | (* variable *)
  hfuncC : h_f -> e_exp | (* h function *)
  yfuncC : y_f -> e_exp | (* eta function *)
  numC : Z -> e_exp | (* constant *)
  plusC : e_exp -> e_exp -> e_exp | (* plus *)
  mulC : e_exp -> e_exp -> e_exp | (* multiply *)
  (* unecessary expression *)
  minusC : e_exp -> e_exp -> e_exp | (* minus *)
  divC : e_exp -> e_exp -> e_exp (* division *)
.
Print e_exp.

Coercion varC : Var >-> e_exp.
Notation "h( c )" := (hfuncC (hC c)) (at level 52).
Notation "y( c )" := (yfuncC (yC c)) (at level 52).
Coercion numC : Z >-> e_exp.
Notation "e1 +' e2" := (plusC e1 e2) (at level 55, right associativity).
Notation "e1 *' e2" := (mulC e1 e2) (at level 53, right associativity).
Notation "e1 -' e2" := (minusC e1 e2) (at level 55, right associativity).
Notation "e1 /' e2" := (divC e1 e2) (at level 53, right associativity).

Check 5 +' 3.
Check 5 *' (3 +' 5).
Check h( c1 ) *' 4.
Compute y(c) *' 4.

(* dynamic formula *)
(* DEL
Inductive dyF_exp (A : Type) :=
  diaC : CPM_exp -> A -> A -> dyF_exp A |
  dnegC : dyF_exp A -> dyF_exp A |
  (*DEL diadC : CPM_exp -> dyF_exp A -> dyF_exp A | *)
  (* unnecessary expressions *)
  boxC : CPM_exp -> A -> A -> dyF_exp A
.
*)
(* DEL
Arguments diaC {A} _ _ _.
Arguments boxC {A} _ _ _.

Notation "<< p >> ( phi , psi )" := (diaC p phi psi) (at level 63).
Notation "[[ p ]] ( phi , psi )" := (boxC p phi psi) (at level 63).
Notation "'~ phi" := (dnegC phi) (at level 64).
*)

(* syntax of cDL formula *)
(* in this version, we define a language which is a bit more expressive than the one we give in ths paper, in
order to make the syntax of the langauge easier to define. *)
Inductive cDL_exp :=
  cdlTrueC : cDL_exp |
  cdlLEC : e_exp -> e_exp -> cDL_exp |
  cdlNegC : cDL_exp -> cDL_exp |
  cdlAndC : cDL_exp -> cDL_exp -> cDL_exp |
  cdlForallC : Var -> cDL_exp -> cDL_exp |
  cdlDiaC : CPM_exp -> cDL_exp -> cDL_exp -> cDL_exp |
  (* unnecessary expressions *)
  cdlFalseC : cDL_exp |
  cdlLTC : e_exp -> e_exp -> cDL_exp |
  cdlGTC : e_exp -> e_exp -> cDL_exp |
  cdlGEC : e_exp -> e_exp -> cDL_exp |
  cdlEQC : e_exp -> e_exp -> cDL_exp |
  cdlOrC : cDL_exp -> cDL_exp -> cDL_exp |
  cdlImpC : cDL_exp -> cDL_exp -> cDL_exp |
  cdlExistsC : Var -> cDL_exp -> cDL_exp |
  cdlBoxC : CPM_exp -> cDL_exp -> cDL_exp -> cDL_exp
.

(*DEL Coercion cdlDYFC : dyF_exp >-> cDL_exp. (* it does not work here *)*)

(*test
Inductive A (X: Type) :=
  n1 : nat -> X -> (A X)
.

Arguments n1 {X} _ _.

Inductive B :=
  m1 : (A nat) -> B |
  m2 : B -> B -> B
.

Coercion m1 : A >-> B.

Check m2 (m1 (n1 1 2)) (m1 (n1 2 2)).
Check m2 (n1 1 2) (n1 2 2).
*)

Notation "'tt''" := cdlTrueC (at level 9). (* previous setting is 65, but I don't why it does not work sometimes *)
Notation "e1 <=' e2" := (cdlLEC e1 e2) (at level 61).
(*DEL Notation "# d " := (cdlDYFC d) (at level 62).*)
Notation "~' e" := (cdlNegC e) (at level 67).
Notation "e1 /\' e2" := (cdlAndC e1 e2) (at level 69, right associativity).
Notation "'all' x , e" := (cdlForallC x e) (at level 68, x at level 67).
Notation "<< p >> ( phi , psi )" := (cdlDiaC p phi psi) (at level 63).
(* unnecessary expressions *)
Notation "'ff''" := cdlFalseC (at level 9).
Notation "e1 <' e2" := (cdlLTC e1 e2) (at level 61).
Notation "e1 >' e2" := (cdlGTC e1 e2) (at level 61).
Notation "e1 >=' e2" := (cdlGEC e1 e2) (at level 61).
Notation "e1 =' e2" := (cdlEQC e1 e2) (at level 61).
(*DEL
Notation "<< p >>' r" := (cdl_dia1C p r) (at level 63, p at level 51, r at level 51).
(* must be higher than the precedence of <<, which is 52 *)
Notation "<< p >> e" := (cdl_dia2C p e) (at level 63, p at level 51, e at level 51).
*)
Notation "e1 \/' e2" := (cdlOrC e1 e2) (at level 71, right associativity).
Notation "e1 ->' e2" := (cdlImpC e1 e2) (at level 72, right associativity).
Notation "'ext' x , e" := (cdlExistsC x e) (at level 68, x at level 67).
Notation "[[ p ]] ( phi , psi )" := (cdlBoxC p phi psi) (at level 63).

Check tt'.
Check ff'.
Check (5 -' 3) <' 2.
Check (cdlDiaC eps tt' (5 =' 5)).
Check << eps >> (tt' , 5 =' 5).
(*DEL Check (cdlDYFC (<< eps >> (tt' , 5 =' 5))) /\' x >' 5.*)
Check (<< eps >> (tt' , 5 =' 5)) /\' x >' 5.
Check (<< eps >> (tt' , 5 =' 5)) \/' x >' 5.
Check all x , 4 =' 5.
Check ext x , 4 =' 5.

Check h( c ) =' 2.

(*************************** Some   Auxiliary Functions ***************************)

(* compare the id of two variables *)
Definition eqv (x : Var) (y: Var) : bool :=
  match x, y with
  | var n, var m => if n =? m then true else false
  end.

Definition eqc (c1 : CName) (c2: CName) : bool :=
  match c1, c2 with
  | clk n, clk m => if n =? m then true else false
  end.

Compute 4=?4.

(* romove all elements x from a Var list *)
Fixpoint rmv (V : list Var) (x : Var) : list Var :=
  match V with
  | nil => nil
  | e :: V' => if eqv e x then rmv V' x else e :: (rmv V' x)
  end
.

Fixpoint rmvc (V : list CName) (x : CName) : list CName :=
  match V with
  | nil => nil
  | e :: V' => if eqc e x then rmvc V' x else e :: (rmvc V' x)
  end
.

(* generate a new variable id *)
Fixpoint MaxId (VSet : list Var) : Z :=
  match VSet with
  | nil => 0 (* when there is no variables in the current environment VSet, just start from the number 0 *)
  | v :: VSet' => let n := MaxId VSet' in (
                      match v with | var m =>
                        if n <=? m then m else (MaxId VSet') (* le_lt_dec : <= *)
                      end
                      )
  end
.

Compute 4 <=? 5.
Compute 5 <=? 5.
Compute 6 <=? 5.
Compute -6 <=? -5.
(* -------------------------------------- generate new variable in the context ----------------------- *)
Compute MaxId (var 1 :: var 3 :: var 5 :: var 6 :: nil).

Definition NewId (VSet : list Var) : Z := (MaxId VSet)+1.

Compute NewId (var 7 :: var 1 :: var 3 :: var 3 :: var 5 :: var 6 :: nil).
Compute NewId nil.

(* --------------------------substitution--------------------------- *)

(*variable type*)
Inductive VarType :=
  tVarC : Var -> VarType |
  thC : CName -> VarType |
  tyC : CName -> VarType
.

Notation "& x" := (tVarC x) (at level 52).
Notation "&h( c )" := (thC c) (at level 52).
Notation "&y( c )" := (tyC c) (at level 52).

Locate "&".

(*substitution*)

(*sustitution for e_exp*)
Fixpoint e_exp_subsE (e : e_exp) (E : e_exp) (u : VarType) : e_exp :=
  match e with
  | varC v => match u with
                | tVarC x => if (eqv v x) then E else varC v
                | thC c => varC v
                | tyC c => varC v
               end
  | hfuncC hf => match hf with
                  | hC c =>
                    match u with
                    | tVarC x => hfuncC hf
                    | thC c' => if (eqc c' c) then E else hfuncC hf
                    | tyC c' => hfuncC hf
                    end
                 end
  | yfuncC yf => match yf with
                  | yC c =>
                    match u with
                      | tVarC x => yfuncC yf
                      | thC c' => yfuncC yf
                      | tyC c' => if (eqc c' c) then E else yfuncC yf
                    end
                 end
  | numC n => numC n
  | plusC e1 e2 => plusC (e_exp_subsE e1 E u) (e_exp_subsE e2 E u)
  | mulC e1 e2 => mulC (e_exp_subsE e1 E u) (e_exp_subsE e2 E u)
  | minusC e1 e2 => minusC (e_exp_subsE e1 E u) (e_exp_subsE e2 E u)
  | divC e1 e2 => divC (e_exp_subsE e1 E u) (e_exp_subsE e2 E u)
  end
.

Compute e_exp_subsE (x +' y) (y +' 1) (&x).
Compute e_exp_subsE (x *' z) (y *' 5) (&h(c)).
Compute e_exp_subsE (h(c) *' z) (y *' 5) (&h(c)).

Notation "e [ E 'subs-E' u ]" := (e_exp_subsE e E u) (at level 9).

Compute (x +' y) [(y +' 1) subs-E &x].

(*sustitution for dyF_exp*)
Definition subs_type := cDL_exp -> e_exp -> VarType -> cDL_exp.

(* currently we don't need it
Fixpoint dyF_subsE (e : dyF_exp cDL_exp) (E : e_exp) (u : VarType) (cdl_subsE : subs_type) : dyF_exp cDL_exp:=
  match e with
  | diaC p phi psi => diaC p (cdl_subsE phi E u) (cdl_subsE psi E u)
  | dnegC e' => dnegC (dyF_subsE e' E u)
  | diadC p e' => diadC (CPM_exp_subsE p E u) (dyF_subssE e' E u)
  end
.
*)

(*sustitution for cDL_exp*)
Fixpoint cdl_subsE (e : cDL_exp) (E : e_exp) (u : VarType) : cDL_exp := (* e[E // x] *)
    match e with
    | cdlTrueC => cdlTrueC
    | cdlLEC e1 e2 => cdlLEC (e_exp_subsE e1 E u) (e_exp_subsE e2 E u)
    | cdlNegC e' => cdlNegC (cdl_subsE e' E u)
    | cdlAndC e1 e2 => cdlAndC (cdl_subsE e1 E u) (cdl_subsE e2 E u)
    | cdlForallC x1 e' => match u with
                             | tVarC x => if (eqv x1 x) then
                                            cdlForallC x1 e' else
                                              cdlForallC x1 (cdl_subsE e' E u)
                             | thC c => cdlForallC x1 (cdl_subsE e' E u)
                             | tyC c => cdlForallC x1 (cdl_subsE e' E u)
                           end
    | cdlDiaC p phi psi => cdlDiaC p (cdl_subsE phi E u) (cdl_subsE psi E u)
(*we temporally do not need to consider the substitution of $p$ since
we assume that our sequent is single-targeted and there is no case that we substitute a clock variable
in a dyanmic formula. *)
    | cdlFalseC => cdlFalseC
    | cdlLTC e1 e2 => cdlLTC (e_exp_subsE e1 E u) (e_exp_subsE e2 E u)
    | cdlGTC e1 e2 => cdlGTC (e_exp_subsE e1 E u) (e_exp_subsE e2 E u)
    | cdlGEC e1 e2 => cdlGEC (e_exp_subsE e1 E u) (e_exp_subsE e2 E u)
    | cdlEQC e1 e2 => cdlEQC (e_exp_subsE e1 E u) (e_exp_subsE e2 E u)
    | cdlOrC e1 e2 => cdlOrC (cdl_subsE e1 E u) (cdl_subsE e2 E u)
    | cdlImpC e1 e2 => cdlImpC (cdl_subsE e1 E u) (cdl_subsE e2 E u)
    | cdlExistsC x1 e' => match u with
                             | tVarC x => if (eqv x1 x) then
                                            cdlExistsC x1 e' else
                                              cdlExistsC x1 (cdl_subsE e' E u)
                             | thC c => cdlExistsC x1 (cdl_subsE e' E u)
                             | tyC c => cdlExistsC x1 (cdl_subsE e' E u)
                           end
    | cdlBoxC p phi psi => cdlBoxC p (cdl_subsE phi E u) (cdl_subsE psi E u)
  end.

Notation "e [ E 'subs' u ]" := (cdl_subsE e E u) (at level 9).
(* Check << skip ]]' c1 << c2 .*)
Locate "/".
Locate "//".

Compute (x +' y) =' 1 /\' (h(c) *' z <=' 5) [(x +' 1) subs &h(c)].

(* substitution for a list *)
Fixpoint cdl_subsE_l (T : list cDL_exp) (E : e_exp) (u : VarType) : list cDL_exp := (* T [x' // x] *)
  match T with
  | nil => nil
  | e :: T' => (cdl_subsE e E u) :: (cdl_subsE_l T' E u)
  end.

Notation "T [ E 'subs-l' u ]" := (cdl_subsE_l T E u) (at level 9).

(* ------------------------------------------------------------------ *)

(* add an element at the nail of a exp list *)
Fixpoint addNail (l : list cDL_exp) (e : cDL_exp) : list cDL_exp :=
  match l with
    | nil => e :: nil
    | a :: l' => a :: (addNail l' e)
  end.

(* Guard to cdl expression *)
Definition G_2_cdl (g : g_exp) : cDL_exp :=
  match g with
  | gltC h1 h2 k => cdlLTC (minusC (hfuncC h1) (hfuncC h2)) k
  | gleC h1 h2 k => cdlLEC (minusC (hfuncC h1) (hfuncC h2)) k
  | ggtC h1 h2 k => cdlGTC (minusC (hfuncC h1) (hfuncC h2)) k
  | ggeC h1 h2 k => cdlGEC (minusC (hfuncC h1) (hfuncC h2)) k
  | geqC h1 h2 k => cdlEQC (minusC (hfuncC h1) (hfuncC h2)) k
  end
.

Compute G_2_cdl (D(c1 , c2) <= 1).
Compute G_2_cdl (D(c1 , c2) > 5).

(* -------------------------------computation of variables in cdl formula----------------------------------------*)
(* this function check whether a variable (i.e. a string) belongs to a list of variables (list of string) *)
Fixpoint NotIn_bool (s : Var) (vec : list Var) : bool :=
  match vec with
  | nil => true
  | v :: vec' => if (eqv s v) then false else NotIn_bool s vec'
  end.

Compute NotIn_bool x (x :: y :: z :: nil).
Compute NotIn_bool z (x :: y :: z :: nil).

Fixpoint e_exp_V (e : e_exp) (V : list Var) : list Var := (*bv : list of computed variables at current time *)
  match e with
  | varC v => if (NotIn_bool v V) then v :: nil else nil
  | hfuncC h => nil
  | yfuncC y => nil
  | numC n => nil
  | plusC e1 e2 => (e_exp_V e1 V) ++ (e_exp_V e2 (V ++ (e_exp_V e1 V)))
  | mulC e1 e2 => (e_exp_V e1 V) ++ (e_exp_V e2 (V ++ (e_exp_V e1 V)))
  | minusC e1 e2 => (e_exp_V e1 V) ++ (e_exp_V e2 (V ++ (e_exp_V e1 V)))
  | divC e1 e2 => (e_exp_V e1 V) ++ (e_exp_V e2 (V ++ (e_exp_V e1 V)))
  end
.

Fixpoint cdl_V (e : cDL_exp) (V : list Var) : list Var := (*V : list of computed variables at current time *)
  match e with
  | cdlTrueC => nil
  | cdlLEC e1 e2 => let l := (e_exp_V e1 V) in (l ++ (e_exp_V e2 (V ++ l)))
  | cdlNegC e' => cdl_V e' V
  | cdlAndC e1 e2 => let l := (cdl_V e1 V) in (l ++ (cdl_V e2 (V ++ l)))
  | cdlForallC x1 e' => if NotIn_bool x1 V then x1 :: (cdl_V e' (x1 :: V)) else cdl_V e' V
  | cdlDiaC p phi psi => let l := (cdl_V phi V) in (l ++ (cdl_V psi (V ++ l)))
  (* in cDL there is no variables in a CPM *)
  | cdlFalseC => nil
  | cdlLTC e1 e2 => let l := (e_exp_V e1 V) in (l ++ (e_exp_V e2 (V ++ l)))
  | cdlGTC e1 e2 => let l := (e_exp_V e1 V) in (l ++ (e_exp_V e2 (V ++ l)))
  | cdlGEC e1 e2 => let l := (e_exp_V e1 V) in (l ++ (e_exp_V e2 (V ++ l)))
  | cdlEQC e1 e2 => let l := (e_exp_V e1 V) in (l ++ (e_exp_V e2 (V ++ l)))
  | cdlOrC e1 e2 => let l := (cdl_V e1 V) in (l ++ (cdl_V e2 (V ++ l)))
  | cdlImpC e1 e2 => let l := (cdl_V e1 V) in (l ++ (cdl_V e2 (V ++ l)))
  | cdlExistsC x1 e' => if NotIn_bool x1 V then x1 :: (cdl_V e' (x1 :: V)) else cdl_V e' V
  | cdlBoxC p phi psi => let l := (cdl_V phi V) in (l ++ (cdl_V psi (V ++ l)))
  (* in cDL there is no variables in a CPM *)
  end
.

(* compute V for a function *)
(* here we do a trick. We pass to phi a variable with a variable id that we will never use in the context
(i.e., the var 0), and we add this variable to the bounded variable list bv, so that the final V set of
phi will definitely not contain var 0.
Note that var 0 must not be used anywhere, or it would be dangerous since it is possible var 0
has already existed in the formul phi *)

Definition cdl_V_f (phi : e_exp -> cDL_exp) (V : list Var) : list Var :=
  cdl_V (phi (var 0)) ((var 0) :: V).

(*------------------------------------ transform a CDL exp to a FOLF formula ------------------------------*)
(* build a type for distinguishing pure FOL (i.e. Prop) or non-pure FOL *)
Inductive FOLF :=
  pureC : Prop -> FOLF |
  noPureC : FOLF
.

(* Evaluation *)
Definition state (A : Type) := A -> nat.
Arguments state {A}.

(* transform an e_exp to a FOL exp under a given state st. *)
(* here the functionality of st is to link the concept of `variable' in CDL we define to
the `nat' domain in Coq *)

Fixpoint Eexp_2_exp (e : e_exp) (st : Var -> Z) (fn : CName -> Z) (gn : CName -> Z) : Z :=
  match e with
  | varC v => (st v)
  | hfuncC h => match h with
                 | hC c => (fn c)
                end
  | yfuncC y => match y with
                 | yC c => (gn c)
                end
  | numC n => n
  | plusC e1 e2 => (Eexp_2_exp e1 st fn gn) + (Eexp_2_exp e2 st fn gn)
  | mulC e1 e2 => (Eexp_2_exp e1 st fn gn) * (Eexp_2_exp e2 st fn gn)
  | minusC e1 e2 => (Eexp_2_exp e1 st fn gn) - (Eexp_2_exp e2 st fn gn)
  | divC e1 e2 => (Eexp_2_exp e1 st fn gn) / (Eexp_2_exp e2 st fn gn)
  end
.

(* transform a CDL exp to a FOLF formula *)
Fixpoint CDLexp_2_FOLF (e : cDL_exp) (st : Var -> Z) (fn : CName -> Z) (gn : CName -> Z) : FOLF :=
  match e with
  | cdlTrueC => pureC True
  | cdlLEC e1 e2 => pureC ((Eexp_2_exp e1 st fn gn) <= (Eexp_2_exp e2 st fn gn))
  | cdlNegC e' => match (CDLexp_2_FOLF e' st fn gn) with
                    | noPureC => noPureC
                    | pureC f => pureC (~ f)
                   end
  | cdlAndC e1 e2 => match (CDLexp_2_FOLF e1 st fn gn), (CDLexp_2_FOLF e2 st fn gn) with
                        | noPureC , _ => noPureC
                        | _ , noPureC => noPureC
                        | (pureC f1) , (pureC f2) => pureC (f1 /\ f2)
                      end
  | cdlForallC x e' => match (CDLexp_2_FOLF e' st fn gn) with
                          | noPureC => noPureC
                          | pureC f => pureC (forall (x : nat), f)
                        end
  | cdlDiaC p phi psi => noPureC (*once met dynamic operators, it is not a pure FOL formula *)
  | cdlFalseC => pureC False
  | cdlLTC e1 e2 => pureC ((Eexp_2_exp e1 st fn gn) < (Eexp_2_exp e2 st fn gn))
  | cdlGTC e1 e2 => pureC ((Eexp_2_exp e1 st fn gn) > (Eexp_2_exp e2 st fn gn))
  | cdlGEC e1 e2 => pureC ((Eexp_2_exp e1 st fn gn) >= (Eexp_2_exp e2 st fn gn))
  | cdlEQC e1 e2 => pureC ((Eexp_2_exp e1 st fn gn) = (Eexp_2_exp e2 st fn gn))
  | cdlOrC e1 e2 => match (CDLexp_2_FOLF e1 st fn gn), (CDLexp_2_FOLF e2 st fn gn) with
                        | noPureC , _ => noPureC
                        | _ , noPureC => noPureC
                        | (pureC f1) , (pureC f2) => pureC (f1 \/ f2)
                     end
  | cdlImpC e1 e2 => match (CDLexp_2_FOLF e1 st fn gn), (CDLexp_2_FOLF e2 st fn gn) with
                        | noPureC , _ => noPureC
                        | _ , noPureC => noPureC
                        | (pureC f1) , (pureC f2) => pureC (f1 -> f2)
                      end
  | cdlExistsC x e' => match (CDLexp_2_FOLF e' st fn gn) with
                          | noPureC => noPureC
                          | pureC f => pureC (exists (x : nat), f)
                        end
  | cdlBoxC p phi psi => noPureC (*once met dynamic operators, it is not a pure FOL formula *)
  end.

Fixpoint CDLexp_2_FOLF_Arith (e : cDL_exp) (st : Var -> Z) (fn : CName -> Z) (gn : CName -> Z) : FOLF :=
  match e with
  | cdlTrueC => pureC (0 = 0)
  | cdlLEC e1 e2 => pureC ((Eexp_2_exp e1 st fn gn) <= (Eexp_2_exp e2 st fn gn))
  | cdlNegC e' => match (CDLexp_2_FOLF_Arith e' st fn gn) with
                    | noPureC => noPureC
                    | pureC f => pureC (~ f)
                   end
  | cdlAndC e1 e2 => match (CDLexp_2_FOLF_Arith e1 st fn gn), (CDLexp_2_FOLF_Arith e2 st fn gn) with
                        | noPureC , _ => noPureC
                        | _ , noPureC => noPureC
                        | (pureC f1) , (pureC f2) => pureC (f1 /\ f2)
                      end
  | cdlForallC x e' => match (CDLexp_2_FOLF_Arith e' st fn gn) with
                          | noPureC => noPureC
                          | pureC f => pureC (forall (x : nat), f)
                        end
  | cdlDiaC p phi psi => noPureC (*once met dynamic operators, it is not a pure FOL formula *)
  | cdlFalseC => pureC (0 > 0)
  | cdlLTC e1 e2 => pureC ((Eexp_2_exp e1 st fn gn) < (Eexp_2_exp e2 st fn gn))
  | cdlGTC e1 e2 => pureC ((Eexp_2_exp e1 st fn gn) > (Eexp_2_exp e2 st fn gn))
  | cdlGEC e1 e2 => pureC ((Eexp_2_exp e1 st fn gn) >= (Eexp_2_exp e2 st fn gn))
  | cdlEQC e1 e2 => pureC ((Eexp_2_exp e1 st fn gn) = (Eexp_2_exp e2 st fn gn))
  | cdlOrC e1 e2 => match (CDLexp_2_FOLF_Arith e1 st fn gn), (CDLexp_2_FOLF_Arith e2 st fn gn) with
                        | noPureC , _ => noPureC
                        | _ , noPureC => noPureC
                        | (pureC f1) , (pureC f2) => pureC (f1 \/ f2)
                     end
  | cdlImpC e1 e2 => match (CDLexp_2_FOLF_Arith e1 st fn gn), (CDLexp_2_FOLF_Arith e2 st fn gn) with
                        | noPureC , _ => noPureC
                        | _ , noPureC => noPureC
                        | (pureC f1) , (pureC f2) => pureC (f1 -> f2)
                      end
  | cdlExistsC x e' => match (CDLexp_2_FOLF_Arith e' st fn gn) with
                          | noPureC => noPureC
                          | pureC f => pureC (exists (x : nat), f)
                        end
  | cdlBoxC p phi psi => noPureC (*once met dynamic operators, it is not a pure FOL formula *)
  end.

Variable st0 : Var -> Z.
Variable fn0 : CName -> Z.
Variable gn0 : CName -> Z.
Compute (CDLexp_2_FOLF tt' st0 fn0 gn0).
Compute (CDLexp_2_FOLF (tt' /\' x >=' 5) st0 fn0 gn0).
Compute (CDLexp_2_FOLF (tt' /\' (x >=' 5 ->' << eps >> (x >' 5, tt'))) st0 fn0 gn0).
Compute (CDLexp_2_FOLF (tt' /\' (x >=' 5 ->' h(c) >' 5 )) st0 fn0 gn0).
Compute (CDLexp_2_FOLF_Arith (tt' /\' (x >=' 5 ->' h(c) >' 5 )) st0 fn0 gn0).

(* transform a CDL_exp to Prop formula, if CDL_exp is not pure, simply return False, otherwise,
return the Prop formula corresponding to it. *)

Definition CDLexp_2_Prop (e : cDL_exp) (st : Var -> nat) (fn : CName -> nat) (gn : CName -> nat) : Prop :=
  match (CDLexp_2_FOLF e st fn gn) with
    | noPureC => False
    | pureC f => f
  end.

(* this function only differs from CDLexp_2_Prop in that it replaces every `False' and `True' Prop with an arithmetic
expression which is `False' or `True'. *)
Definition CDLexp_2_Arith (e : cDL_exp) (st : Var -> nat) (fn : CName -> nat) (gn : CName -> nat) : Prop :=
  match (CDLexp_2_FOLF_Arith e st fn gn) with
    | noPureC => (0 > 0)
    | pureC f => f
  end.

Compute CDLexp_2_Prop (tt' /\' (x >=' 5 ->' << eps >> (x >' 5, tt'))) st0 fn0 gn0.
Compute CDLexp_2_Prop (tt' /\' (x >=' 5 ->' y(c) >' 5 )) st0 fn0 gn0.
Compute CDLexp_2_Arith (tt' /\' (x >=' 5 ->' y(c) >' 5 )) st0 fn0 gn0.

(* ----------------------------------- check if a substitution is admissible --------------------------------- *)
(* when checking if a substitution is admissible, we consider clock names c1 c2 c3 instead of clock-related
variables h(c1) h(c2) h(c3) y(c1) y(c2) y(c3) .... This is simpler to be dealt with in Coq. And this is
not like when we consider the substitution, there we must consider the clock-related variables *)
(*
Currently we can assume that there is no clock variables in the substituting expression so we only take care of
general variables.
*)

Fixpoint commonEle (v1 : list Var) (v2 : list Var) : bool :=
  match v1 with
  | nil => false
  | e :: v1' => if (NotIn_bool e v2) then commonEle v1' v2 else true
  end.

Compute commonEle (x :: y :: nil) (z :: nil).
Compute commonEle (x :: y :: nil) (z :: y :: nil).

Fixpoint e_exp_chk (e : e_exp) (ev : list Var) (u : VarType) (bv : list Var) : Prop :=
  (* ev --> variables in expression, bv --> bounded variables currently *)
  match e with
  | varC v => match u with
                | tVarC x => if andb (eqv v x) (commonEle ev bv) then False else True
                | thC c => True
                | tyC c => True
               end
  | hfuncC h => match h with
                  hC c => match u with
                            | tVarC x => True
                            | thC c' => if andb (eqc c c') (commonEle ev bv) then False else True
                            | tyC c' => True
                          end
                end

  | yfuncC y => match y with
                  | yC c =>match u with
                              | tVarC x => True
                              | thC c' => True
                              | tyC c' => if andb (eqc c c') (commonEle ev bv) then False else True
                            end
                end
  | numC n => True
  | plusC e1 e2 => (e_exp_chk e1 ev u bv) /\ (e_exp_chk e2 ev u bv)
  | mulC e1 e2 => (e_exp_chk e1 ev u bv) /\ (e_exp_chk e2 ev u bv)
  | minusC e1 e2 => (e_exp_chk e1 ev u bv) /\ (e_exp_chk e2 ev u bv)
  | divC e1 e2 => (e_exp_chk e1 ev u bv) /\ (e_exp_chk e2 ev u bv)
  end
.

Fixpoint cdl_chk (e : cDL_exp) (ev : list Var) (u : VarType) (bv : list Var) : Prop :=
  (* e --> the expression to be substituted, ev --> the set of variables of the substituting expression,
     u --> the variable type to be substituted, bv --> the set of bounded variables at current time *)
(*currently we only consider variables and not clock variables,
this is correct since we assume only general variables
are contained in the substituting expression*)
    match e with
    | cdlTrueC => True
    | cdlLEC e1 e2 => (e_exp_chk e1 ev u bv) /\ (e_exp_chk e2 ev u bv)
    | cdlNegC e' => cdl_chk e' ev u bv
    | cdlAndC e1 e2 => (cdl_chk e1 ev u bv) /\ (cdl_chk e2 ev u bv)
    | cdlForallC x1 e' => cdl_chk e' ev u (x1 :: bv)
    | cdlDiaC p phi psi => (cdl_chk phi ev u bv) /\ (cdl_chk psi ev u bv)
(*currently we can safely skip the CPM p cause no substituion happen in ps*)
    | cdlFalseC => True
    | cdlLTC e1 e2 => (e_exp_chk e1 ev u bv) /\ (e_exp_chk e2 ev u bv)
    | cdlGTC e1 e2 => (e_exp_chk e1 ev u bv) /\ (e_exp_chk e2 ev u bv)
    | cdlGEC e1 e2 => (e_exp_chk e1 ev u bv) /\ (e_exp_chk e2 ev u bv)
    | cdlEQC e1 e2 => (e_exp_chk e1 ev u bv) /\ (e_exp_chk e2 ev u bv)
    | cdlOrC e1 e2 => (cdl_chk e1 ev u bv) /\ (cdl_chk e2 ev u bv)
    | cdlImpC e1 e2 => (cdl_chk e1 ev u bv) /\ (cdl_chk e2 ev u bv)
    | cdlExistsC x1 e' => cdl_chk e' ev u (x1 :: bv)
    | cdlBoxC p phi psi => (cdl_chk phi ev u bv) /\ (cdl_chk psi ev u bv)
    end.

(* =========================================== construction of the proof system ================================================= *)

Reserved Notation "<| T , p1  ==> p2 , D // V , C , ntC |> " (at level 75).

Locate "==>". (* check that we could use this notation without any problems *)

(* definition of sequent *)
(* currently we do not consider the other direction of the rules and rules for the dual operator of `[[p]]'. *)
(* Gamma, Delta *)
Definition Gamma := list cDL_exp.
Definition Delta := list cDL_exp.

(* target place *)
Inductive place :=
  exp : cDL_exp -> place |
  empty : place
.

(* --------- transform a sequent to a CDL exp, which we will need to implement Rule (o) below ---------*)
Fixpoint Gamma_2_CDLexp (T : Gamma) : cDL_exp :=
  match T with
  | nil => tt'
  | e :: T' => e /\' (Gamma_2_CDLexp T')
  end.

Fixpoint Delta_2_CDLexp (D : Gamma) : cDL_exp :=
  match D with
  | nil => ff'
  | e :: D' => e \/' (Delta_2_CDLexp D')
  end.

Definition place_2_CDLexp_L (p : place) : cDL_exp :=
  match p with
  | empty => tt'
  | exp e => e
  end.

Definition place_2_CDLexp_R (p : place) : cDL_exp :=
  match p with
  | empty => ff'
  | exp e => e
  end.

Definition Seq_2_CDLexp (T : Gamma) (p1 : place) (p2 : place) (D : Delta) : cDL_exp :=
  ((Gamma_2_CDLexp T) /\' (place_2_CDLexp_L p1))
  ->'
  ((place_2_CDLexp_R p2) \/' (Delta_2_CDLexp D))
.

Inductive Seq : Gamma -> place -> place -> Delta -> (list Var) -> (list CName) -> (list CName) -> Prop :=

  (* ****************************** rules special for the sequent defined in Coq ********************* *)
(* these rules are special in Coq, they are not defined in the original proof system of cDL in the paper. We need them because
  the structure of the sequent in Coq is slightly different from that in the paper. We need special rules to deal with
  `place' in the sequent *)

(*
   V: all variables appearing in the current sequent
   C: all clocks appearing in the current sequent
   ntC: all clocks that does not tick at current instant.
*)

  r_placeR_rmv : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                        (phi : cDL_exp),
          (
            Seq T pls1 empty (addNail D phi) V C ntC (* put phi at the nail of D *)
          )
          ->
          (
            Seq T pls1 (exp phi) D V C ntC
          )
|
  r_placeR_add : forall (T : Gamma) (pls1 : place) (D' : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                        (phi : cDL_exp),
          (
            Seq T pls1 (exp phi) D' V C ntC (* add a new phi from the head of D = phi :: D' *)
          )
          ->
          (
            Seq T pls1 empty (phi :: D') V C ntC
          )
|
  r_placeL_rmv : forall (T : Gamma) (pls2 : place) (D : Delta)  (V : list Var) (C : list CName) (ntC : list CName)
                        (phi : cDL_exp),
          (
            Seq (addNail T phi) empty pls2 D V C ntC (* put phi at the nail of T *)
          )
          ->
          (
            Seq T (exp phi) pls2 D V C ntC
          )
|
  r_placeL_add : forall (T' : Gamma) (pls2 : place) (D : Delta)  (V : list Var) (C : list CName) (ntC : list CName)
                        (phi : cDL_exp),
          (
            Seq T' (exp phi) pls2 D V C ntC (* add a new phi from the head of T = phi :: T' *)
          )
          ->
          (
            Seq (phi :: T') empty pls2 D V C ntC
          )
|
(* ****************************** rules for combinational events *********************** *)
(* Rule (\alpha) *)
  r_Alpha_c : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                    (c : CName) (a : ClkEvt) (phi : cDL_exp) (psi : cDL_exp),
          let n := NewId V in
          let m := S n in
          (
            Seq (
                  (h(c) =' (var n) +' 1) :: (y(c) =' 1) ::
                  (
                    (T [ (var n) subs-l &h(c) ]) [ (var m) subs-l &y(c) ]
                  )
                )
                      pls1
                        (exp (<< @ a >> (phi, psi)))
                          (
                            (D [ (var n) subs-l &h(c) ]) [ (var m) subs-l &y(c)]
                          )
                            (var m :: var n :: V)
                              C
                                (rmvc ntC c) (*c ticks so it should be removed from ntC *)
          )
          ->
          (
            Seq T pls1 (exp (<< @ (c :: a) >> (phi, psi) )) D V C ntC
          )
|
  r_Alpha_idle1 : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName)
                    (phi : cDL_exp) (psi : cDL_exp),
          (
            Seq T pls1 (exp (phi /\' psi)) D V C C (* when ntC = nil, reset it to C *)
          )
          ->
          (
            Seq T pls1 (exp (<< @ idle >> (phi, psi))) D V C nil
          )
|
  r_Alpha_idle2 : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (c : CName) (ntC' : list CName)
                    (phi : cDL_exp) (psi : cDL_exp), (* dealing with all clocks that do not tick *)
          (
            let n := NewId V in
            (
              Seq (
                    (y(c) =' 0) :: (T [(var n) subs-l &y(c)])
                  )
                    pls1
                      (exp (<< @ idle >> (phi, psi)))
                        (D [(var n) subs-l &y(c)])
                          ((var n) :: V)
                            C
                              ntC'
            )
          )
          ->
          (
            Seq T pls1 (exp (<< @ idle >> (phi, psi))) D V C (c :: ntC')
          )
|

(* Rule epsilon *)
  r_Eps : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                  (phi : cDL_exp) (psi : cDL_exp),
          (
            Seq T pls1 ( exp phi ) D V C ntC
          )
          ->
          (
            Seq T pls1 (exp (<< eps >> (phi, psi))) D V C ntC
          )
|

(* Rule g? *)
  r_Guard : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                          (g : g_exp) (a : ClkEvt) (phi : cDL_exp) (psi : cDL_exp),
          (
            Seq T pls1 (exp ((G_2_cdl g) /\' << a >> (phi, psi))) D V C ntC
          )
          ->
          (
            Seq T pls1 (exp (<< g ? a >> (phi, psi))) D V C ntC
          )
|

(* Rule halt *)
  r_Halt : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                          (phi : cDL_exp) (psi : cDL_exp),
          (
            Seq T pls1 (exp ff') D V C ntC
          )
          ->
          (
            Seq T pls1 (exp (<< halt >> (phi, psi))) D V C ntC
          )
|

(* Rule << omega >> *)
  r_Omega_dia : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                  (p : CPM_exp) (phi : cDL_exp) (psi : cDL_exp),
          (
            exists (inv : cDL_exp), (* invariant has to be manually provided *)
              (
                Seq T pls1
                        (exp inv)
                            D
                              (V ++ (cdl_V inv V))
                                  C
                                   ntC
              )
              /\
              (
                Seq nil pls1
                          (exp (
                                  inv ->' << p >> (inv, psi)
                               )
                          )
                            nil
                              (cdl_V (inv ->' << p >> (inv, psi)) nil)
                                  C
                                    ntC

              )
          )
          ->
          (
            Seq T pls1
                    (exp (<< p^w >> (phi, psi))) D V C ntC
          )
|

(* --------------------------------- rules inherited from FODL and dTL^2 -------------------------------- *)
(* Rule choice *)
  r_Choice : forall (T: Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                      (p : CPM_exp) (q : CPM_exp) (phi : cDL_exp) (psi : cDL_exp),
          (
            Seq T pls1
                    (exp (<< p >> (phi, psi) \/' << q >> (phi,psi)))
                      D V C ntC
          )
          ->
          (
            Seq T pls1 (exp (<< p U q >> (phi, psi))) D V C ntC
          )
|

(* Rule sequence *)
  r_Seq : forall (T: Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                      (p : CPM_exp) (q : CPM_exp) (phi : cDL_exp) (psi : cDL_exp),
          (
            Seq T pls1
                    (
                      exp (<< p >> (<< q >> (phi, psi), psi))
                    )
                      D V C ntC
          )
          ->
          (
            Seq T pls1 (exp (<< p;q >> (phi, psi))) D V C ntC
          )
|

(* Rule star n *)
  r_Star_n : forall (T: Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                      (p : CPM_exp) (phi : cDL_exp) (psi : cDL_exp),
          (
            Seq T pls1
                    (
                      exp (phi \/' << p ; p^* >> (phi, psi) )
                    )
                      D V C ntC
          )
          ->
          (
            Seq T pls1 (exp (<< p^* >> (phi, psi))) D V C ntC
          )
|
(* Rule << star >> *)
  r_Star_dia : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                  (p : CPM_exp) (phi : cDL_exp) (psi : cDL_exp),
          (
            exists (inv : e_exp -> cDL_exp), (* invariant has to be manually provided *)
              (
                let X := var (NewId (V ++ (cdl_V_f inv V))) in
                (
                Seq T pls1
                        (exp (ext X , (X >=' 0 /\' (inv X))))
                            D
                              (V ++ (cdl_V (ext X , (X >=' 0 /\' (inv X))) V))
                                  C
                                    ntC
                )
              )
              /\
              (
                let X := var (NewId
                                (
                                  cdl_V ((inv (var 0)) ->' << p >> (inv ((var 0) -' 1), psi)) nil)
                                ) in
                (
                Seq nil pls1
                          (exp (
                                  all X, (X >' 0 ->' ((inv X) ->' << p >> (inv (X -' 1), psi)))
                               )
                          )
                            nil
                              (cdl_V (
                                        all X, (X >' 0 ->' ((inv X) ->' << p >> (inv (X -' 1), psi)))
                                     ) nil)
                                  C
                                    ntC
                )
              )
              /\
              (
                let X := var (NewId (cdl_V_f inv nil)) in
                (
                Seq nil pls1
                          (exp (
                                  (ext X, X <=' 0 /\' (inv X)) ->' phi
                               )
                          )
                            nil
                              (cdl_V ((ext X, X <=' 0 /\' (inv X)) ->' phi) nil)
                                  C
                                    ntC
                )
              )
          )
          ->
          (
            Seq T pls1
                    (exp (<< p^* >> (phi, psi))) D V C ntC
          )
|

(* ****************************** rules of FOL *********************** *)
(* Rule (o) *)
  r_o : forall (T : Gamma) (pls1 : place) (pls2 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName),
        (
          let fof := (Seq_2_CDLexp T pls1 pls2 D) in
          (
            forall (st : Var -> nat) (fn : CName -> nat) (gn : CName -> nat) , (CDLexp_2_Arith fof st fn gn)
            (* the Prop formula corresponding to the sequent: `Seq T empty empty D V' *)
          )
        )
        ->
        (
          Seq T pls1 pls2 D V C ntC
        )
|

(* Rule (ax) *)
  r_ax : forall (T : Gamma) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                      (phi : cDL_exp),
        (
          True
        )
        ->
        (
          Seq T (exp phi) (exp phi) D V C ntC
        )
|

(* Rule (cut) *)
  r_cut : forall (T : Gamma) (pls1 : place) (pls2 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName),
        (
          forall (phi : cDL_exp),
            (
              Seq T pls1 pls2 (phi :: D) (V ++ (cdl_V phi V)) C ntC
            )
            /\
            (
              Seq (phi :: T) pls1 pls2 D (V ++ (cdl_V phi V)) C ntC
            )
        )
        ->
        (
          Seq T pls1 pls2 D V C ntC
        )
|

(* Rule (~ r) *)
  r_negR : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                (phi : cDL_exp),
        (
          Seq ((~' phi):: T) pls1 empty D V C ntC
        )
        ->
        (
          Seq T pls1 (exp phi) D V C ntC
        )
|

(* Rule (~ l) *)
  r_negL : forall (T : Gamma) (pls2 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                (phi : cDL_exp),
        (
          Seq T empty pls2 ((~' phi)::D) V C ntC
        )
        ->
        (
          Seq T (exp phi) pls2 D V C ntC
        )
|

(* Rule (/\ r) *)
  r_andR : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                (phi1 : cDL_exp) (phi2 : cDL_exp),
        (
          (
            Seq T pls1 (exp phi1) D V C ntC
          )
          /\
          (
            Seq T pls1 (exp phi2) D V C ntC
          )
        )
        ->
        (
          Seq T pls1 (exp (phi1 /\' phi2)) D V C ntC
        )
|

(* Rule (/\ l 1) *)
  r_andL_1 : forall (T : Gamma) (pls2 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                (phi1 : cDL_exp) (phi2 : cDL_exp),
        (
          Seq T
                (exp phi1) pls2 D V C ntC
        )
        ->
        (
          Seq T (exp (phi1 /\' phi2)) pls2 D V C ntC
        )
|

(* Rule (/\ l 2) *)
  r_andL_2 : forall (T : Gamma) (pls2 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                (phi1 : cDL_exp) (phi2 : cDL_exp),
        (
          Seq T
                (exp phi2) pls2 D V C ntC
        )
        ->
        (
          Seq T (exp (phi1 /\' phi2)) pls2 D V C ntC
        )
|

(* Rule (all r) *)
  r_allR : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                (phi : cDL_exp) (x : Var),
        (
          let n := NewId V in
          (
            Seq T pls1
                    (
                      exp (phi [(var n) subs &x])
                    )
                        D
                          ((var n) :: V)
                              C ntC
          )
        )
        ->
        (
          Seq T pls1 (exp (all x , phi)) D V C ntC
        )
|

(* Rule (all l) *)

  r_allL : forall (T : Gamma) (pls2 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                (phi : cDL_exp) (x : Var),
        (
          exists (E : e_exp),
          (
            (cdl_chk phi (e_exp_V E nil) (&x) nil) (* make sure that the substitution phi[E / x] is admissible *)
            /\
            (
              Seq ((all x , phi) :: T)
                      (
                        exp (phi [E subs &x])
                      )
                        pls2
                          D
                            (V ++ (e_exp_V E V)) C ntC
            )
          )
        )
        ->
        (
          Seq T (exp (all x , phi)) pls2 D V C ntC
        )
|

(* Rule (\/ r 1) *)
  r_orR_1 : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                 (phi1 : cDL_exp) (phi2 : cDL_exp),
        (
          Seq T pls1 (exp phi1) D V C ntC
        )
        ->
        (
          Seq T pls1 (exp (phi1 \/' phi2)) D V C ntC
        )
|

(* Rule (\/ r 2) *)
  r_orR_2 : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                 (phi1 : cDL_exp) (phi2 : cDL_exp),
        (
          Seq T pls1 (exp phi2) D V C ntC
        )
        ->
        (
          Seq T pls1 (exp (phi1 \/' phi2)) D V C ntC
        )
|

(* Rule (\/ l) *)
  r_orL : forall (T : Gamma) (pls2 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                (phi1 : cDL_exp) (phi2 : cDL_exp),
        (
          (
            Seq T (exp phi1) pls2 D V C ntC
          )
          /\
          (
            Seq T (exp phi2) pls2 D V C ntC
          )
        )
        ->
        (
          Seq T (exp (phi1 \/' phi2)) pls2 D V C ntC
        )
|

(* Rule (-> r) *)
  r_impR : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                  (phi1 : cDL_exp) (phi2 : cDL_exp),
        (
          Seq (phi1 :: T) pls1 (exp phi2) D V C ntC
        )
        ->
        (
          Seq T pls1 (exp (phi1 ->' phi2)) D V C ntC
        )
|

(* Rule (-> l) *)
  r_impL : forall (T : Gamma) (pls2 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                  (phi1 : cDL_exp) (phi2 : cDL_exp),
        (
          (
            Seq T empty pls2 (phi1 :: D) V C ntC
          )
          /\
          (
            Seq T (exp phi2) pls2 D V C ntC
          )
        )
        ->
        (
          Seq T (exp (phi1 ->' phi2)) pls2 D V C ntC
        )
|

(* Rule (ext r) *)
  r_extR : forall (T : Gamma) (pls1 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                  (phi : cDL_exp) (x : Var),
        (
          exists (E : e_exp),
            (cdl_chk phi (e_exp_V E nil) (&x) nil) (* make sure that the substitution phi[E / x] is admissible *)
            /\
            (
              Seq T pls1
                      (exp (phi [ E subs &x ]))
                        D
                          (V ++ (e_exp_V E V)) C ntC
            )
        )
        ->
        (
          Seq T pls1 (exp (ext x , phi)) D V C ntC
        )
|

(* Rule (ext l) *)
  r_extL : forall (T : Gamma) (pls2 : place) (D : Delta) (V : list Var) (C : list CName) (ntC : list CName)
                (phi : cDL_exp) (x : Var),
        (
          let n := NewId V in
          (
            Seq ((ext x, phi) :: T)
                    (
                      exp (phi [(var n) subs &x])
                    )
                      pls2
                        D
                          ((var n) :: V) C ntC
          )
        )
        ->
        (
          Seq T (exp (ext x , phi)) pls2 D V C ntC
        )
(* define the notation at the end *)
where "<| T , p1  ==>  p2 , D  //  V , C , ntC |>" := (Seq T p1 p2 D V C ntC)
.

Locate "//".

Theorem tst1 : <| nil, (exp tt')  ==>  (exp tt') , nil  //  nil , nil , nil |>.
Proof.
apply r_ax.
auto.
Qed.

Theorem tst4 : forall (a b c : nat),
(a = b + 1 /\ b = 0) -> (False \/ a >= 1).
Proof.
intros.
omega.
Qed.

Theorem tstsb : Eexp_2_exp (4 -' (var 2)) st0 fn0 gn0 = 0.
Proof.
  compute [Eexp_2_exp]. cbv.

(*
Theorem tst5 : True.
Proof.

Qed.

Theorem tst3 : forall (a b c : nat),
(a = b + 1 /\ b = 0) -> (False \/ (a >= 1 /\ True)).
Proof.
intros a b c.
intros.
omega.
Qed.
*)

(*
Theorem tst2 : forall (st : Var -> nat) (fn gn : CName -> nat),
(fn (clk 1) = st (var 1) + 1 /\ st (var 1) = 0) -> False \/ fn(clk 1) >= 0 /\ True.
Proof.
intros. auto.
omega.
Qed.
*)

Theorem tst6 : (True /\ True) /\ (True /\ True).
Proof.
  auto.
Qed.

Theorem tst9 : forall (st : Var -> nat) (fn gn : CName -> nat),
(
     (st (var 3) - fn (clk 2)) + st (var 2) = 4 /\
     fn (clk 1) = st (var 3) + 1
) -> (
(fn (clk 1) - fn (clk 2)) + (st (var 2) - 1) = 4
).
Proof.
  intros. omega.

Theorem tst8 : forall (st : Var -> nat) (fn gn : CName -> nat),
(
(gn (clk 3) = 0 /\
     gn (clk 2) = 0 /\
     fn (clk 1) = st (var 3) + 1 /\
     gn (clk 1) = 1 /\
     ((st (var 3) - fn (clk 2)) + st (var 2) = 4 /\ st (var 3) - fn (clk 3) >= 0 /\ fn (clk 3) - fn (clk 2) >= 0) /\
     st (var 2) > 0 /\ 0 = 0) /\ 0 = 0
) -> (
((fn (clk 1) - fn (clk 2)) + (st (var 2) - 1) = 4 /\ fn (clk 1) - fn (clk 3) >= 0 /\ fn (clk 3) - fn (clk 2) >= 0) /\
((fn (clk 1) > fn (clk 3) \/ fn (clk 1) = fn (clk 3) /\ gn (clk 3) = 0) /\ fn (clk 3) >= fn (clk 2)) /\
(gn (clk 1) = 1 \/ gn (clk 2) = 1 \/ gn (clk 3) = 1) \/ 0 > 0
).

Proof.
  intros. simpl. omega.
Qed.

(*
Theorem tst7 : forall (st : Var -> nat) (fn : CName -> nat),
((fn (clk 1) - fn (clk 2) = match st (var 2) with
                              |0 => 4
                              |1 => 3
                              |2 => 2
                              |3 => 1
                              |S (S (S (S _))) => 0
                            end
/\ fn(clk 1) - fn (clk 3) >=0 /\ fn (clk 3) - fn (clk 2) >= 0 /\
st (var 2) > 0 /\ 0 = 0) /\ 0 = 0) ->
(fn (clk 1) - fn (clk 2) < 4 \/ 0 > 0).
Proof.
  intros. simpl. cbn. omega.
Qed.
*)

Theorem tstThm0 : <| ((h(c) =' 0 /\' y(c) =' 0):: nil) , empty  ==>  exp (<< @ {c} >> (h(c) >=' 1, tt')) , nil  //
                 nil , c :: nil , c:: nil |>.
Proof.
apply r_Alpha_c. cbv.
apply r_Alpha_idle1. cbv.
apply r_placeR_rmv.
apply r_o. cbn.
intros.
omega.

Theorem tstThm1 : <| ((h(c) =' 0 /\' y(c) =' 0):: nil) , empty  ==>  exp (<< @ {c | c} >> (h(c) >=' 2, tt')) , nil  //
                 nil , c :: nil , c:: nil |>.
Proof.
apply r_Alpha_c. cbv.
apply r_Alpha_c. cbv.
apply r_Alpha_idle1. cbv.
apply r_placeR_rmv. apply r_o. cbn.
intros.
omega.
Qed.

(* %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% *)
(* the example in the paper*)
(* clocks v1, u1 and v3*)
Definition v1 : CName := (clk 1).
Definition u1 : CName := (clk 2).
Definition v3 : CName := (clk 3).

(* program p *)
(* g1, g2*)
Definition g1 : g_exp := D(v1, u1) < 4.
Definition g2 : g_exp := D(v1, u1) == 4.
Print g1.
Print g2.
(* p2, p3, p4*)
Definition p2 : CPM_exp := @ nil U g1?{v1} U  g1?{v1|v3}.
Print p2.
Definition p3 : CPM_exp := @ nil U g2?{v1} U g2?{v1|v3}.
Print p3.
Definition p4 : CPM_exp := @ nil U @ {v1|u1} U @ {v1|u1|v3}.
Print p4.
(* p *)
Definition p : CPM_exp := p2^w U (p2^* ; p3 ; p4^w).
Print p.

(* initial condition I *)
Definition I : cDL_exp := (h(v1) =' 0 /\' y(v1) =' 0) /\'
                          (h(u1) =' 0 /\' y(u1) =' 0) /\'
                          (h(v3) =' 0 /\' y(v3) =' 0).
Print I.
(* formula psi *)
(* formula expressing the specification *)
Definition psi_sp1 := (h(v1) >' h(v3) \/' (h(v1) =' h(v3) /\' y(v3) =' 0)) /\' h(v3) >=' h(u1).
(* formula for expressing `at least one clock ticks at each instant of a schedule' *)
Definition psi_es := y(v1) =' 1 \/' y(u1) =' 1 \/' y(v3) =' 1.
(* psi *)
Definition Psi := psi_sp1 /\' psi_es.
Compute Psi.

(* Other components in the sequent *)
Definition Gamma0 : Gamma := nil.
Definition Delta0 : Delta := nil.
Definition V0 : list Var := nil.
Definition C0 : list CName := v1 :: u1 :: v3 :: nil.
Definition ntC0 : list CName := C0.

Theorem Example : <| Gamma0 , empty ==> exp ( I ->' << p >> (tt' , Psi) ), Delta0 //
                     V0, C0, ntC0 |>.

Definition inv1 (k : e_exp) : cDL_exp := (h(v1) -' h(u1)) +' k =' 4 /\'
                                         h(v1) -' h(v3) >=' 0 /\'
                                         h(v3) -' h(u1) >=' 0.

Proof.
  apply r_impR. (* rule -> r *)
  apply r_Choice. (* rule choice *)
  apply r_orR_2. (* rule \/ r 2 *)
  apply r_Seq. (* rule sequence *)
  apply r_Star_dia; exists inv1; split; [|split]. (* rule << star >> *)
  - apply r_extR. exists 4. simpl. split. (* rule ext r *)
    + intuition.
    + apply r_o. cbn. intros. omega. (* rule o *)
  - apply r_allR. apply r_impR; apply r_impR. cbn. (* rule all r, rule -> r *)
    apply r_Choice. apply r_orR_2. apply r_Choice. apply r_orR_1. (* rule cho, \/ r 2, cho, \/ r 2 *)
    apply r_Guard. apply r_andR; split.
    + cbv. apply r_o;cbn. intros. omega. (* rule o *)
    + cbv. apply r_Alpha_c. apply r_Alpha_idle2; apply r_Alpha_idle2; apply r_Alpha_idle1; cbv. (* rule alpha *)
      apply r_o. cbn. intros. omega.

(* program p2 *)
Definition P1 : P_exp := (x '= 2) '/\ (f '= 0).
Definition P2 : P_exp := (x '< 2) '/\ (f '= 0).

Definition a2 : Evt := { p ! 0 | f :=' 1 }.
Definition a3 : Evt := { p ! 0 | x :=' x '+ 1 }.
Print a3.

Definition p2 : SEP_exp := P1 ? a2 U P2 ? a3.
Print p2.

(* Gamma2 *)
Definition Gamma2 : Gamma := (Y >=' n(o)) :: (n(r) =' Y +' 1) :: (s(r) =' 1) :: (x =' 1) ::
                             (f =' 0) :: (s(e) =' 0) :: (s(p) =' 0) :: (s(o) =' 0) :: nil.
Print Gamma2.

Theorem example : <| Gamma2 , empty ==> (exp ([[ p2 ]]' r << o)) , nil //
                     (x :: f :: Y :: e :: p :: r :: o :: nil),
                     (e :: p :: r :: o :: nil),
                     (e :: p :: r :: o :: nil)
                  |>.

Proof.
  apply r_PiCho_all_int.
  apply r_andR_int. split.
  Focus 2.
  - apply r_Test_all_rel_int.
    apply r_impR_int.
    apply r_placeL_rmv_int.
    apply r_Pi_all_int2; cbv.
    apply r_Pi_all_int1; cbv.
    apply r_Pi_all_int_idle2;apply r_Pi_all_int_idle2;apply r_Pi_all_int_idle2; cbv.
    apply r_Pi_all_int_idle1; cbv.
    apply r_placeR_rmv_int.
    apply r_o_int. cbn.
    intros H1 H2 H3.
    omega.
  Admitted.


Require Import Coq.ZArith.ZArith.
Require Import Coq.micromega.Psatz.
Require Import Coq.Strings.String.
Require Import Coq.Classes.Morphisms.
Require Import Coq.Classes.Morphisms_Prop.
Require Import Coq.Classes.RelationClasses.
Require Import SetsClass.SetsClass. Import SetsNotation.
Require Import compcert.lib.Integers.
Require Import PV.Syntax.
Require Import PV.PracticalDenotations.
Import Lang_While DntSem_While.
Import EDenote CDenote.
Local Open Scope string.
Local Open Scope Z.
Local Open Scope sets.

(** * 定义与例子 *)

Definition EVar': string -> expr := EVar.
(* Declare Custom Entry expr_entry. *)
Coercion EConst: Z >-> expr.
Coercion EVar: var_name >-> expr.
Coercion EVar': string >-> expr.
Notation "[[ e ]]" := e
  (at level 0, e custom expr_entry at level 99).
Notation "( x )" := x
  (in custom expr_entry, x custom expr_entry at level 99).
Notation "x" := x
  (in custom expr_entry at level 0, x constr at level 0).
Notation "f x" := (f x)
  (in custom expr_entry at level 1, only parsing,
   f custom expr_entry,
   x custom expr_entry at level 0).
Notation "x + y" := (EBinop OPlus x y)
  (in custom expr_entry at level 12, left associativity).
Notation "x - y" := (EBinop OMinus x y)
  (in custom expr_entry at level 12, left associativity).
Notation "x * y" := (EBinop OMul x y)
  (in custom expr_entry at level 11, left associativity).
Notation "x / y" := (EBinop ODiv x y)
  (in custom expr_entry at level 11, left associativity).
Notation "x % y" := (EBinop OMod x y)
  (in custom expr_entry at level 11, left associativity).
Notation "x <= y" := (EBinop OLe x y)
  (in custom expr_entry at level 13, no associativity).
Notation "x < y" := (EBinop OLt x y)
  (in custom expr_entry at level 13, no associativity).
Notation "x >= y" := (EBinop OGe x y)
  (in custom expr_entry at level 13, no associativity).
Notation "x > y" := (EBinop OGt x y)
  (in custom expr_entry at level 13, no associativity).
Notation "x == y" := (EBinop OEq x y)
  (in custom expr_entry at level 13, no associativity).
Notation "x != y" := (EBinop ONe x y)
  (in custom expr_entry at level 13, no associativity).
Notation "x && y" := (EBinop OAnd x y)
  (in custom expr_entry at level 14, left associativity).
Notation "x || y" := (EBinop OOr x y)
  (in custom expr_entry at level 15, left associativity).
Notation "! x" := (EUnop ONot x)
  (in custom expr_entry at level 10).
Notation "- x" := (EUnop ONeg x)
  (in custom expr_entry at level 10).
Notation "c1 ; c2" := (CSeq c1 c2)
  (in custom expr_entry at level 20, right associativity).
Notation "'skip'" := (CSkip)
  (in custom expr_entry at level 10).
Notation "'if' e 'then' '{' c1 '}' 'else' '{' c2 '}'" := (CIf e c1 c2)
  (in custom expr_entry at level 19,
   e custom expr_entry at level 5,
   c1 custom expr_entry at level 99,
   c2 custom expr_entry at level 99,
   format  "'if'  e  'then'  '{'  c1  '}'  'else'  '{'  c2  '}'").
Notation "'while' e 'do' '{' c1 '}'" := (CWhile e c1)
  (in custom expr_entry at level 19,
   e custom expr_entry at level 5,
   c1 custom expr_entry at level 99).

Arguments Rels.id: simpl never.
Arguments Rels.test: simpl never.
Arguments Rels.concat: simpl never.

Notation "⟦ e ⟧" := (eval_expr e)
  (at level 0, only printing, e custom expr_entry at level 99).
Notation "⟦ c ⟧" := (eval_com c)
  (at level 0, only printing, c custom expr_entry at level 99).

Ltac any_eval x :=
  match goal with
  | |- EDenote => exact (eval_expr x)
  | |- CDenote => exact (eval_com x)
  | _ => match type of x with
         | expr => exact (eval_expr x)
         | com => exact (eval_com x)
         end
  end.

Notation "⟦ x ⟧" := (ltac:(any_eval x))
  (at level 0, only parsing, x at level 99).

Notation "x × y" := (@Sets.test1 _ (y -> Prop) _ x)
  (no associativity, at level 61): sets_scope.

(** 表达式语义等价 *)

Record eequiv (e1 e2: expr): Prop := {
  nrm_eequiv:
    ⟦ e1 ⟧.(nrm) == ⟦ e2 ⟧.(nrm);
  err_eequiv:
    ⟦ e1 ⟧.(err) == ⟦ e2 ⟧.(err);
}.

(** 表达式精化关系 *)

Record erefine (e1 e2: expr): Prop := {
  nrm_erefine:
    ⟦ e1 ⟧.(nrm) ⊆ ⟦ e2 ⟧.(nrm) ∪ (⟦ e2 ⟧.(err) × int64);
  err_erefine:
    ⟦ e1 ⟧.(err) ⊆ ⟦ e2 ⟧.(err);
}.

(** 程序语句语义等价 *)

Record cequiv (c1 c2: com): Prop := {
  nrm_cequiv: ⟦ c1 ⟧.(nrm) == ⟦ c2 ⟧.(nrm);
  err_cequiv: ⟦ c1 ⟧.(err) == ⟦ c2 ⟧.(err);
  inf_cequiv: ⟦ c1 ⟧.(inf) == ⟦ c2 ⟧.(inf);
}.

(** 程序语句精化关系 *)

Record crefine (c1 c2: com): Prop := {
  nrm_crefine:
    ⟦ c1 ⟧.(nrm) ⊆ ⟦ c2 ⟧.(nrm) ∪ (⟦ c2 ⟧.(err) × state);
  err_crefine:
    ⟦ c1 ⟧.(err) ⊆ ⟦ c2 ⟧.(err);
  inf_crefine:
    ⟦ c1 ⟧.(inf) ⊆ ⟦ c2 ⟧.(inf) ∪ ⟦ c2 ⟧.(err);
}.

Notation "e1 '~=~' e2" := (eequiv e1 e2)
  (at level 69, only printing, no associativity).
Notation "e1 '<<=' e2" := (erefine e1 e2)
  (at level 69, only printing, no associativity).
Notation "c1 '~=~' c2" := (cequiv c1 c2)
  (at level 69, only printing, no associativity).
Notation "c1 '<<=' c2" := (crefine c1 c2)
  (at level 69, only printing, no associativity).

Ltac any_equiv x y :=
  match type of x with
  | expr => exact (eequiv x y)
  | com => exact (cequiv x y)
  | _ => match type of y with
         | expr => exact (eequiv x y)
         | com => exact (cequiv x y)
         end
  end.

Ltac any_refine x y :=
  match type of x with
  | expr => exact (erefine x y)
  | com => exact (crefine x y)
  | _ => match type of y with
         | expr => exact (erefine x y)
         | com => exact (crefine x y)
         end
  end.

Notation "x '~=~' y" := (ltac:(any_equiv x y))
  (at level 69, only parsing, no associativity).
Notation "x '<<=' y" := (ltac:(any_refine x y))
  (at level 69, only parsing, no associativity).

Notation "H '.(nrm_eequiv)'" := (nrm_eequiv _ _ H)
  (at level 1).
Notation "H '.(err_eequiv)'" := (err_eequiv _ _ H)
  (at level 1).
Notation "H '.(nrm_erefine)'" := (nrm_erefine _ _ H)
  (at level 1).
Notation "H '.(err_erefine)'" := (err_erefine _ _ H)
  (at level 1).
Notation "H '.(nrm_cequiv)'" := (nrm_cequiv _ _ H)
  (at level 1).
Notation "H '.(err_cequiv)'" := (err_cequiv _ _ H)
  (at level 1).
Notation "H '.(nrm_crefine)'" := (nrm_crefine _ _ H)
  (at level 1).
Notation "H '.(err_crefine)'" := (err_crefine _ _ H)
  (at level 1).

(** 精化的例子 *)

Lemma const_plus_const_refine: forall n m: Z,
  EConst (n + m) <<= [[n + m]].
(** 证明见Coq代码。*)
Proof.
  intros.
  assert (Int64.min_signed <= n <= Int64.max_signed \/
          n < Int64.min_signed \/
          n > Int64.max_signed) as Hn by lia.
  assert (Int64.min_signed <= m <= Int64.max_signed \/
          m < Int64.min_signed \/
          m > Int64.max_signed) as Hm by lia.
  split.
  + sets_unfold; intros s i ?.
    simpl in H.
    destruct H.
    destruct Hn;
    [destruct Hm |];
    [left | right | right];
    simpl;
    sets_unfold;
    try tauto.
    unfold arith_sem1_nrm, arith_compute1_nrm.
    exists (Int64.repr n), (Int64.repr m).
    pose proof Int64.signed_repr _ H1.
    pose proof Int64.signed_repr _ H2.
    rewrite H3, H4.
    tauto.
  + sets_unfold; intros s ?.
    simpl in H.
    simpl; sets_unfold.
    unfold arith_sem1_err, arith_compute1_err.
    destruct Hn;
    [destruct Hm |];
    [right | left | left];
    simpl;
    sets_unfold;
    try tauto.
    exists (Int64.repr n), (Int64.repr m).
    pose proof Int64.signed_repr _ H0.
    pose proof Int64.signed_repr _ H1.
    rewrite H2, H3.
    tauto.
Qed.

(** 语义等价的例子：顺序执行有结合律 *)

Theorem CSeq_assoc: forall (c1 c2 c3: com),
  [[c1; (c2; c3)]] ~=~ [[(c1; c2); c3]].
Proof.
  intros.
  split.
  + simpl.
    rewrite Rels_concat_assoc.
    reflexivity.
  + simpl.
    rewrite Rels_concat_union_distr_l.
    rewrite Sets_union_assoc.
    rewrite Rels_concat_assoc.
    reflexivity.
  + simpl.
    rewrite Rels_concat_union_distr_l.
    rewrite Sets_union_assoc.
    rewrite Rels_concat_assoc.
    reflexivity.
Qed.

Theorem CIf_CSeq: forall e c1 c2 c3,
  [[ if e then { c1 } else { c2 }; c3 ]] ~=~
  [[ if e then { c1; c3 } else { c2; c3 } ]].
Proof.
  intros.
  split.
  + simpl.
    rewrite <- ! Rels_concat_assoc.
    apply Rels_concat_union_distr_r.
  + simpl.
    rewrite ! Rels_concat_union_distr_r.
    rewrite ! Rels_concat_union_distr_l.
    rewrite <- ! Rels_concat_assoc.
    sets_unfold; intros s; tauto.
  + simpl.
    rewrite ! Rels_concat_union_distr_r.
    rewrite ! Rels_concat_union_distr_l.
    rewrite <- ! Rels_concat_assoc.
    sets_unfold; intros s; tauto.
Qed.

(** * 语义等价于精化的性质 *)

(** 接下去，我们介绍语义等价的两条重要性质。其一：语义等价是一种等价关系。*)

(** 在Coq标准库中，_[Reflexive]_、_[Symmetric]_、_[Transitive]_以及
    _[Equivalence]_定义了自反性、对称性、传递性以及等价关系。下面证明中，我们统
    一使用了_[Instance]_关键字，而非之前证明中常用的_[Theorem]_与_[Lemma]_，我们
    将稍后再解释_[Instance]_关键字的特殊作用。*)

#[export]
Instance eequiv_refl: Reflexive eequiv.
Proof.
  unfold Reflexive; intros.
  split.
  + reflexivity.
  + reflexivity.
Qed.

#[export]
Instance eequiv_sym: Symmetric eequiv.
Proof.
  unfold Symmetric; intros.
  split.
  + rewrite H.(nrm_eequiv).
    reflexivity.
  + rewrite H.(err_eequiv).
    reflexivity.
Qed.

#[export]
Instance eequiv_trans: Transitive eequiv.
Proof.
  unfold Transitive; intros.
  split.
  + rewrite H.(nrm_eequiv), H0.(nrm_eequiv).
    reflexivity.
  + rewrite H.(err_eequiv), H0.(err_eequiv).
    reflexivity.
Qed.

#[export]
Instance eequiv_equiv: Equivalence eequiv.
Proof.
  split.
  + apply eequiv_refl.
  + apply eequiv_sym.
  + apply eequiv_trans.
Qed.

(** 下面还可以证明精化关系也具有自反性和传递性。*)

#[export]
Instance erefine_refl: Reflexive erefine.
Proof.
  unfold Reflexive; intros.
  split.
  + apply Sets_included_union1.
  + reflexivity.
Qed.

#[export]
Instance erefine_trans: Transitive erefine.
Proof.
  unfold Transitive; intros.
  split.
  + rewrite H.(nrm_erefine).
    rewrite H0.(nrm_erefine).
    rewrite H0.(err_erefine).
    sets_unfold; intros s1 s2; tauto.
  + rewrite H.(err_erefine).
    rewrite H0.(err_erefine).
    reflexivity.
Qed.

(** 并且精化关系在语义等价变换下不变。*)

#[export]
Instance erefine_well_defined:
  Proper (eequiv ==> eequiv ==> iff) erefine.
Proof.
  unfold Proper, respectful; intros.
  split; intros.
  + split.
    - rewrite <- H.(nrm_eequiv).
      rewrite <- H0.(nrm_eequiv).
      rewrite <- H0.(err_eequiv).
      apply H1.(nrm_erefine).
    - rewrite <- H.(err_eequiv).
      rewrite <- H0.(err_eequiv).
      apply H1.(err_erefine).
  + split.
    - rewrite H.(nrm_eequiv).
      rewrite H0.(nrm_eequiv).
      rewrite H0.(err_eequiv).
      apply H1.(nrm_erefine).
    - rewrite H.(err_eequiv).
      rewrite H0.(err_eequiv).
      apply H1.(err_erefine).
Qed.

(** 两条重要性质之二是：三种语法连接词能保持语义等价关系（congruence）。下面先证
    明加法、减法、乘法的情况。*)

Lemma arith_sem1_nrm_congr: forall Zfun D11 D12 D21 D22,
  D11 == D12 ->
  D21 == D22 ->
  arith_sem1_nrm Zfun D11 D21 ==
  arith_sem1_nrm Zfun D12 D22.
Proof.
  sets_unfold.
  intros ? ? ? ? ? ? ? s1 s2.
  unfold arith_sem1_nrm.
  apply ex_iff_morphism; intros i1.
  apply ex_iff_morphism; intros i2.
  rewrite H, H0.
  reflexivity.
Qed.

(** 很多其它情况的证明是类似的。*)

Lemma arith_sem2_nrm_congr: forall int64fun D11 D12 D21 D22,
  D11 == D12 ->
  D21 == D22 ->
  arith_sem2_nrm int64fun D11 D21 ==
  arith_sem2_nrm int64fun D12 D22.
Proof.
  sets_unfold.
  intros ? ? ? ? ? ? ? s1 s2.
  unfold arith_sem2_nrm.
  apply ex_iff_morphism; intros i1.
  apply ex_iff_morphism; intros i2.
  rewrite H, H0.
  reflexivity.
Qed.

Lemma cmp_sem2_nrm_congr: forall cmp D11 D12 D21 D22,
  D11 == D12 ->
  D21 == D22 ->
  cmp_sem_nrm cmp D11 D21 ==
  cmp_sem_nrm cmp D12 D22.
Proof.
  sets_unfold.
  intros ? ? ? ? ? ? ? s1 s2.
  unfold cmp_sem_nrm.
  apply ex_iff_morphism; intros i1.
  apply ex_iff_morphism; intros i2.
  rewrite H, H0.
  reflexivity.
Qed.


Load LFindLoad.
From lfind Require Import LFind.
From adtind Require Import goal35.

Set Printing Depth 1000.
Definition lfind_eval  z x:=
plus (mult x z) z.

Compute lfind_eval  (Succ Zero) (Zero).

Compute lfind_eval  (Succ Zero) (Zero).

Compute lfind_eval  (Succ (Succ (Succ Zero))) (Succ (Succ (Succ Zero))).

Compute lfind_eval  (Zero) (Succ (Succ (Succ Zero))).

Compute lfind_eval  (Succ (Succ (Succ Zero))) (Zero).

Compute lfind_eval  (Succ Zero) (Succ (Succ Zero)).

Compute lfind_eval  (Zero) (Succ Zero).

Compute lfind_eval  (Zero) (Succ (Succ Zero)).

Compute lfind_eval  (Succ Zero) (Succ Zero).

Compute lfind_eval  (Succ Zero) (Succ Zero).

Compute lfind_eval  (Zero) (Zero).

Compute lfind_eval  (Succ (Succ (Succ (Succ Zero)))) (Succ (Succ Zero)).

Compute lfind_eval  (Zero) (Zero).

Compute lfind_eval  (Succ (Succ Zero)) (Succ (Succ Zero)).

Compute lfind_eval  (Zero) (Zero).

Compute lfind_eval  (Succ Zero) (Succ (Succ (Succ (Succ Zero)))).

Compute lfind_eval  (Succ Zero) (Succ (Succ (Succ (Succ (Succ Zero))))).

Compute lfind_eval  (Succ (Succ (Succ Zero))) (Zero).

Compute lfind_eval  (Succ Zero) (Succ Zero).

Compute lfind_eval  (Succ (Succ Zero)) (Zero).

Compute lfind_eval  (Succ Zero) (Zero).

Compute lfind_eval  (Zero) (Succ Zero).

Compute lfind_eval  (Succ (Succ Zero)) (Succ Zero).

Compute lfind_eval  (Zero) (Zero).


Require Import VST.floyd.proofauto.
Require Import Coq.Classes.EquivDec.
Require Import CertiGraph.lib.List_ext.
Require Import CertiGraph.graph.graph_model.
Require Import CertiGraph.graph.path_lemmas.

Local Open Scope Z_scope.

Section PathCost.

  Context {V DV DG : Type}.

  Definition E : Type := prod V V.

  Context {V_EqDec : EqDec V eq}.
  Context {E_EqDec : EqDec E eq}.

  Definition path_cost (g: LabeledGraph V E DV Z DG) (path: @path V E) : Z :=
    fold_left Z.add (map (elabel g) (snd path)) 0.

  Lemma path_cost_zero:
    forall (g: LabeledGraph V E DV Z DG) src,
      path_cost g (src, []) = 0.
  Proof.
    intros. unfold path_cost; trivial.
  Qed.

  Lemma one_step_path_Znth:
    forall (g: LabeledGraph V E DV Z DG) s e,
      path_cost g (s, e :: nil) = elabel g e.
  Proof.
    intros. unfold path_cost; simpl.
    apply Z.add_0_l.
  Qed.

  Lemma acc_pos: forall (g: LabeledGraph V E DV Z DG) l z,
      (forall e : E, In e l -> 0 <= elabel g e) ->
      0 <= z ->
      0 <= fold_left Z.add (map (elabel g) l) z.
  Proof.
    intro. induction l; intros; simpl; auto. apply IHl.
    - intros. apply H. now apply in_cons.
    - assert (In a (a :: l)) by apply in_eq.
      specialize (H _ H1). lia.
  Qed.

  Lemma path_cost_init:
    forall l init s,
      fold_left Z.add l (init + s) =
      init + (fold_left Z.add l s).
  Proof.
    intros.
    generalize dependent s.
    induction l.
    - intros; simpl. trivial.
    - intros; simpl.
      rewrite <- Z.add_assoc.
      rewrite IHl. lia.
  Qed.

  Lemma path_cost_path_glue:
    forall (g: LabeledGraph V E DV Z DG) p1 p2,
      path_cost g (path_glue p1 p2) =
      path_cost g p1 + path_cost g p2.
  Proof.
    intros.
    unfold path_cost at 1, path_glue at 1.
    simpl. rewrite map_app.
    rewrite fold_left_app.
    assert ((fold_left Z.add (map (elabel g) (snd p1)) 0) = (path_cost g p1))
      by now unfold path_cost.
    rewrite H.
    unfold path_cost at 3.
    remember (map (elabel g) (snd p2)) as l2.
    remember (path_cost g p1) as c1.
    replace c1 with (c1 + 0) at 1 by lia.
    rewrite path_cost_init; trivial.
  Qed.

    Lemma path_cost_app_cons:
    forall (g: LabeledGraph V E DV Z DG) path e,
      path_cost g (fst path, snd path +:: e) =
      path_cost g path + elabel g e.
  Proof.
    intros.
    replace (fst path, snd path +:: e) with
        (path_glue path (fst e, [e])).
    rewrite path_cost_path_glue.
    rewrite one_step_path_Znth; trivial.
    unfold path_glue. simpl. trivial.
  Qed.

  Lemma path_cost_glue_one_step:
    forall (g: LabeledGraph V E DV Z DG) p2m u i,
      path_cost g (path_glue p2m (u, [(u, i)])) = path_cost g p2m + elabel g (u, i).
  Proof.
    intros.
    rewrite path_cost_path_glue, one_step_path_Znth; trivial.
  Qed.

  Lemma path_cost_cons:
    forall (g: LabeledGraph V E DV Z DG) src links a,
      path_cost g (src, a :: links) = elabel g a + path_cost g (src, links).
  Proof.
    intros.
    pose proof (path_cost_path_glue g (src, [a]) (src, links)).
    unfold path_glue in H. simpl in H. rewrite H. f_equal.
  Qed.

  Lemma path_cost_upper_bound:
    forall (g: LabeledGraph V E DV Z DG) src links upper,
      0 <= upper ->
      (forall e, In e links -> elabel g e <= upper) ->
      path_cost g (src, links) <= Zlength links * upper.
  Proof.
    intros.
    induction links.
    - rewrite (path_cost_zero g).
      apply Z.mul_nonneg_nonneg; rep_lia.
    - rewrite path_cost_cons.
      rewrite Zlength_cons.
      spec IHlinks.
      1: intros; apply H0; right; trivial.
      specialize (H0 a). spec H0.
      1: left; trivial. lia.
  Qed.

End PathCost.


Require Export euclidean__axioms.
Require Export euclidean__defs.
Require Export logic.
Require Export proposition__31.
Definition proposition__31short : forall A B C D, (euclidean__axioms.BetS B D C) -> ((euclidean__axioms.nCol B C A) -> (exists X Y Z, (euclidean__axioms.BetS X A Y) /\ ((euclidean__defs.CongA X A D A D C) /\ ((euclidean__defs.Par X Y B C) /\ ((euclidean__axioms.BetS X Z C) /\ (euclidean__axioms.BetS A Z D)))))).
Proof.
intro A.
intro B.
intro C.
intro D.
intro H.
intro H0.
assert (* Cut *) (exists E F S, (euclidean__axioms.BetS E A F) /\ ((euclidean__defs.CongA F A D A D B) /\ ((euclidean__defs.CongA F A D B D A) /\ ((euclidean__defs.CongA D A F B D A) /\ ((euclidean__defs.CongA E A D A D C) /\ ((euclidean__defs.CongA E A D C D A) /\ ((euclidean__defs.CongA D A E C D A) /\ ((euclidean__defs.Par E F B C) /\ ((euclidean__axioms.Cong E A D C) /\ ((euclidean__axioms.Cong A F B D) /\ ((euclidean__axioms.Cong A S S D) /\ ((euclidean__axioms.Cong E S S C) /\ ((euclidean__axioms.Cong B S S F) /\ ((euclidean__axioms.BetS E S C) /\ ((euclidean__axioms.BetS B S F) /\ (euclidean__axioms.BetS A S D)))))))))))))))) as H1.
- apply (@proposition__31.proposition__31 A B C D H H0).
- destruct H1 as [E H2].
destruct H2 as [F H3].
destruct H3 as [S H4].
destruct H4 as [H5 H6].
destruct H6 as [H7 H8].
destruct H8 as [H9 H10].
destruct H10 as [H11 H12].
destruct H12 as [H13 H14].
destruct H14 as [H15 H16].
destruct H16 as [H17 H18].
destruct H18 as [H19 H20].
destruct H20 as [H21 H22].
destruct H22 as [H23 H24].
destruct H24 as [H25 H26].
destruct H26 as [H27 H28].
destruct H28 as [H29 H30].
destruct H30 as [H31 H32].
destruct H32 as [H33 H34].
exists E.
exists F.
exists S.
split.
-- exact H5.
-- split.
--- exact H13.
--- split.
---- exact H19.
---- split.
----- exact H31.
----- exact H34.
Qed.


Definition NNPP : Prop:=forall P:Prop,~~P->P.

Theorem T11:
forall P:Set->Prop,
(forall x:Set,P x)
->~(exists x:Set,~P x).
intros.
intro.
elim H0.
intros.
elim H1.
apply H.
Qed.

Theorem T12:
NNPP->
forall P:Set->Prop,
~(exists x:Set,~P x)
->(forall x:Set,P x).
intros.
apply H.
intro.
elim H0.
exists x.
apply H1.
Qed.

Theorem T15:
forall P:Set->Prop,
NNPP->
~(forall x:Set,P x)
->(exists x:Set,~P x).
intros.
apply H.
intro.
elim H0.
intro.
apply H.
intro.
elim H1.
exists x.
tauto.
Qed.