Section Automatas_TCG.
(* System TCG: Especification *)
(* Set of Labels *)
Inductive Label : Set :=
| Approach : Label
| In : Label
| Exit : Label
| Lower : Label
| Raise : Label
| Up : Label
| Down : Label
| Tick : Label.
(* Tick represent temporal transitions *)
(* Locations: ST (Train), SC (Controller) and SG (Gate) *)
Inductive ST : Set :=
| Far : ST
| Near : ST
| Inside : ST.
Inductive SC : Set :=
| Sc1 : SC
| Sc2 : SC
| Sc3 : SC
| Sc4 : SC.
Inductive SG : Set :=
| Open : SG
| Lowering : SG
| Closed : SG
| Raising : SG.
(* States with one clock *)
Definition S_Ck (S : Set) := (S * Clock)%type.
(* TCG constants *)
Definition kt1 : Instant := 8.
Definition kt2 : Instant := 20.
Definition kc1 : Instant := 4.
Definition kc2 : Instant := 4.
Definition kg1 : Instant := 4.
Definition kg2 : Instant := 4.
Definition kg3 : Instant := 8.
(* Invariants of locations for the Train *)
Inductive InvT : S_Ck ST -> Prop :=
| Ifar : forall x : Clock, InvT (Far, x)
| Inear : forall x : Clock, lt_Ck x kt2 -> InvT (Near, x)
| Iinside : forall x : Clock, lt_Ck x kt2 -> InvT (Inside, x).
(* Invariants of locations for the Controller *)
Inductive InvC : S_Ck SC -> Prop :=
| Isc1 : forall y : Clock, InvC (Sc1, y)
| Isc2 : forall y : Clock, le_Ck y kc1 -> InvC (Sc2, y)
| Isc3 : forall y : Clock, InvC (Sc3, y)
| Isc4 : forall y : Clock, lt_Ck y kc2 -> InvC (Sc4, y).
(* Invariants of locations for the Gate *)
Inductive InvG : S_Ck SG -> Prop :=
| Iopen : forall z : Clock, InvG (Open, z)
| Ilowering : forall z : Clock, lt_Ck z kg1 -> InvG (Lowering, z)
| Iclosed : forall z : Clock, InvG (Closed, z)
| Iraising : forall z : Clock, lt_Ck z kg3 -> InvG (Raising, z).
(* Train transitions *)
Inductive TrT : S_Ck ST -> Label -> S_Ck ST -> Prop :=
| ttApproach : forall x : Clock, TrT (Far, x) Approach (Near, Reset)
| ttIn :
forall x : Clock,
gt_Ck x kt1 -> lt_Ck x kt2 -> TrT (Near, x) In (Inside, x)
| ttExit : forall x : Clock, lt_Ck x kt2 -> TrT (Inside, x) Exit (Far, x)
| ttTick :
forall (x : Clock) (s : ST),
InvT (s, Inc x) -> TrT (s, x) Tick (s, Inc x).
(* Controller transitions *)
Inductive TrC : S_Ck SC -> Label -> S_Ck SC -> Prop :=
| tcApproach : forall y : Clock, TrC (Sc1, y) Approach (Sc2, Reset)
| tcLower : forall y : Clock, eq_Ck y kc1 -> TrC (Sc2, y) Lower (Sc3, y)
| tcExit : forall y : Clock, TrC (Sc3, y) Exit (Sc4, Reset)
| tcRaise : forall y : Clock, lt_Ck y kc2 -> TrC (Sc4, y) Raise (Sc1, y)
| tcTick :
forall (y : Clock) (s : SC),
InvC (s, Inc y) -> TrC (s, y) Tick (s, Inc y).
(* Gate transitions *)
Inductive TrG : S_Ck SG -> Label -> S_Ck SG -> Prop :=
| tgLower : forall z : Clock, TrG (Open, z) Lower (Lowering, Reset)
| tgDown :
forall z : Clock, lt_Ck z kg1 -> TrG (Lowering, z) Down (Closed, z)
| tgRaise : forall z : Clock, TrG (Closed, z) Raise (Raising, Reset)
| tgUp :
forall z : Clock,
ge_Ck z kg2 -> lt_Ck z kg3 -> TrG (Raising, z) Up (Open, z)
| tgTick :
forall (z : Clock) (s : SG),
InvG (s, Inc z) -> TrG (s, z) Tick (s, Inc z).
(* States for the system: train||controller||gate *)
Definition StGlobal := (S_Ck ST * (S_Ck SC * S_Ck SG))%type.
(* Transitions for the system: train||controller||gate *)
Inductive TrGlobal : StGlobal -> Label -> StGlobal -> Prop :=
| tGl_In :
forall st1 st2 : S_Ck ST,
TrT st1 In st2 ->
forall (sc : S_Ck SC) (sg : S_Ck SG),
TrGlobal (st1, (sc, sg)) In (st2, (sc, sg))
| tGl_Down :
forall sg1 sg2 : S_Ck SG,
TrG sg1 Down sg2 ->
forall (st : S_Ck ST) (sc : S_Ck SC),
TrGlobal (st, (sc, sg1)) Down (st, (sc, sg2))
| tGl_Up :
forall sg1 sg2 : S_Ck SG,
TrG sg1 Up sg2 ->
forall (st : S_Ck ST) (sc : S_Ck SC),
TrGlobal (st, (sc, sg1)) Up (st, (sc, sg2))
| tGl_Approach :
forall (st1 st2 : S_Ck ST) (sc1 sc2 : S_Ck SC),
TrT st1 Approach st2 ->
TrC sc1 Approach sc2 ->
forall sg : S_Ck SG,
TrGlobal (st1, (sc1, sg)) Approach (st2, (sc2, sg))
| tGl_Exit :
forall (st1 st2 : S_Ck ST) (sc1 sc2 : S_Ck SC),
TrT st1 Exit st2 ->
TrC sc1 Exit sc2 ->
forall sg : S_Ck SG, TrGlobal (st1, (sc1, sg)) Exit (st2, (sc2, sg))
| tGl_Lower :
forall (sc1 sc2 : S_Ck SC) (sg1 sg2 : S_Ck SG),
TrC sc1 Lower sc2 ->
TrG sg1 Lower sg2 ->
forall st : S_Ck ST, TrGlobal (st, (sc1, sg1)) Lower (st, (sc2, sg2))
| tGl_Raise :
forall (sc1 sc2 : S_Ck SC) (sg1 sg2 : S_Ck SG),
TrC sc1 Raise sc2 ->
TrG sg1 Raise sg2 ->
forall st : S_Ck ST, TrGlobal (st, (sc1, sg1)) Raise (st, (sc2, sg2))
| tGl_Tick :
forall (st1 st2 : S_Ck ST) (sc1 sc2 : S_Ck SC) (sg1 sg2 : S_Ck SG),
TrT st1 Tick st2 ->
TrC sc1 Tick sc2 ->
TrG sg1 Tick sg2 -> TrGlobal (st1, (sc1, sg1)) Tick (st2, (sc2, sg2)).
(* Initial states *)
Definition ini_CkT := 0.
Definition ini_CkC := 0.
Definition ini_CkG := 0.
Definition SiniT : S_Ck ST := (Far, ini_CkT).
Definition SiniC : S_Ck SC := (Sc1, ini_CkC).
Definition SiniG : S_Ck SG := (Open, ini_CkG).
Definition SiniTCG : StGlobal := (SiniT, (SiniC, SiniG)).
End Automatas_TCG.
Hint Constructors InvT: sysTCG.
Hint Constructors InvC: sysTCG.
Hint Constructors InvG: sysTCG.
Hint Constructors TrT: sysTCG.
Hint Constructors TrC: sysTCG.
Hint Constructors TrG: sysTCG.
Hint Constructors TrGlobal: sysTCG.
(****************************************************************************)
(*                               System TCG: Analysis                       *)
(****************************************************************************)
Load "TemporalOperators.v".
(* Temporal operators. CTL -computation tree logic- and TCTL -timed computation tree logic- *)
(* Elemental properties of clocks and constants of the System TCG *)
unfold lt_Ck, Reset, kc2 in |- *; auto with *.
Qed.
(* Invertion principles for transitions and location invariants *)
Derive Inversion_clear cl_TRT_APPROACH with
(forall st1 st2 : S_Ck ST, TrT st1 Approach st2) Sort Prop.
Derive Inversion_clear cl_TRT_IN with
(forall st1 st2 : S_Ck ST, TrT st1 In st2) Sort Prop.
Derive Inversion_clear cl_TRT_EXIT with
(forall st1 st2 : S_Ck ST, TrT st1 Exit st2) Sort Prop.
Derive Inversion_clear cl_TRT_INC_TIME with
(forall st1 st2 : S_Ck ST, TrT st1 Tick st2) Sort Prop.
Derive Inversion_clear cl_TRC_APPROACH with
(forall sc1 sc2 : S_Ck SC, TrC sc1 Approach sc2) Sort Prop.
Derive Inversion_clear cl_TRC_LOWER with
(forall sc1 sc2 : S_Ck SC, TrC sc1 Lower sc2) Sort Prop.
Derive Inversion_clear cl_TRC_EXIT with
(forall sc1 sc2 : S_Ck SC, TrC sc1 Exit sc2) Sort Prop.
Derive Inversion_clear cl_TRC_RAISE with
(forall sc1 sc2 : S_Ck SC, TrC sc1 Raise sc2) Sort Prop.
Derive Inversion_clear cl_TRC_INC_TIME with
(forall sc1 sc2 : S_Ck SC, TrC sc1 Tick sc2) Sort Prop.
Derive Inversion_clear cl_TRG_LOWER with
(forall sg1 sg2 : S_Ck SG, TrG sg1 Lower sg2) Sort Prop.
Derive Inversion_clear cl_TRG_DOWN with
(forall sg1 sg2 : S_Ck SG, TrG sg1 Down sg2) Sort Prop.
Derive Inversion_clear cl_TRG_RAISE with
(forall sg1 sg2 : S_Ck SG, TrG sg1 Raise sg2) Sort Prop.
Derive Inversion_clear cl_TRG_UP with
(forall sg1 sg2 : S_Ck SG, TrG sg1 Up sg2) Sort Prop.
Derive Inversion_clear cl_TRG_INC_TIME with
(forall sg1 sg2 : S_Ck SG, TrG sg1 Tick sg2) Sort Prop.
Derive Inversion_clear cl_Ifar with (forall x : Clock, InvT (Far, x)) Sort
Prop.
Derive Inversion_clear cl_Inear with (forall x : Clock, InvT (Near, x)) Sort
Prop.
Derive Inversion_clear cl_Iinside with (forall x : Clock, InvT (Inside, x))
Sort Prop.
Derive Inversion_clear cl_Isc1 with (forall y : Clock, InvC (Sc1, y)) Sort
Prop.
Derive Inversion_clear cl_Isc2 with (forall y : Clock, InvC (Sc2, y)) Sort
Prop.
Derive Inversion_clear cl_Isc3 with (forall y : Clock, InvC (Sc3, y)) Sort
Prop.
Derive Inversion_clear cl_Isc4 with (forall y : Clock, InvC (Sc4, y)) Sort
Prop.
Derive Inversion_clear cl_Iopen with (forall z : Clock, InvG (Open, z)) Sort
Prop.
Derive Inversion_clear cl_Ilowering with
(forall z : Clock, InvG (Lowering, z)) Sort Prop.
Derive Inversion_clear cl_Iclosed with (forall z : Clock, InvG (Closed, z))
Sort Prop.
Derive Inversion_clear cl_Iraising with (forall z : Clock, InvG (Raising, z))
Sort Prop.
(* Some tactics *)
Ltac Easy := try discriminate; auto with *.
Ltac Easy2 := intros; try discriminate; auto with *.
Ltac Simpl_or eq := elim eq; intro; Easy.
Ltac Simpl_and eq := elim eq; intros; Easy.
Ltac Generalize_Easy eq := generalize eq; intro; Easy.
Ltac Split3_Trivial := split; [ auto with * | split; auto with * ].
Ltac BeginForAll :=
unfold ForAll in |- *; simple induction 1;
[ simpl in |- *; intros; Easy | idtac ].
Ltac SplitTrans :=
intros s1 s2 l rs_s1 p_s1 tr_gl; generalize rs_s1; clear rs_s1;
generalize p_s1; clear p_s1; elim tr_gl.
Ltac SplitTrans_Simpl :=
SplitTrans;
[ Simpl_In
| Simpl_Down
| Simpl_Up
| Simpl_Approach
| Simpl_Exit
| Simpl_Lower
| Simpl_Raise
| Simpl_Tick ]
with Simpl_In :=
intros st1 st2 trt_In; inversion trt_In using cl_TRT_IN;
intros x gt_x_kt1 lt_x_kt2 sc sg; elim sc; elim sg;
simpl in |- *; intros; Easy
with Simpl_Down :=
intros sg1 sg2 trg_Down; inversion trg_Down using cl_TRG_DOWN;
intros z lt_z_kg1 st sc; elim st; elim sc; simpl in |- *;
intros; Easy
with Simpl_Up :=
intros sg1 sg2 trg_Up; inversion trg_Up using cl_TRG_UP;
intros z ge_z_kg2 lt_z_kg3 st sc; elim st; elim sc;
simpl in |- *; intros; Easy
with Simpl_Approach :=
intros st1 st2 sc1 sc2 trt_Approach trc_Approach;
inversion trt_Approach using cl_TRT_APPROACH;
inversion trc_Approach using cl_TRC_APPROACH; intros y x sg;
elim sg; simpl in |- *; intros; Easy
with Simpl_Exit :=
intros st1 st2 sc1 sc2 trt_Exit trc_Exit;
inversion trt_Exit using cl_TRT_EXIT; inversion trc_Exit using cl_TRC_EXIT;
intros y x lt_x_kt2 sg; elim sg; simpl in |- *;
intros; Easy
with Simpl_Lower :=
intros sc1 sc2 sg1 sg2 trc_Lower trg_Lower;
inversion trc_Lower using cl_TRC_LOWER;
inversion trg_Lower using cl_TRG_LOWER; intros z y eq_y_kc1 st;
elim st; simpl in |- *; intros; Easy
with Simpl_Raise :=
intros sc1 sc2 sg1 sg2 trc_Raise trg_Raise;
inversion trc_Raise using cl_TRC_RAISE;
inversion trg_Raise using cl_TRG_RAISE; intros z y lt_y_kc2 st;
elim st; simpl in |- *; intros; Easy
with Simpl_Tick :=
intros st1 st2 sc1 sc2 sg1 sg2 trt_Tick trc_Tick trg_Tick;
inversion trt_Tick using cl_TRT_INC_TIME;
inversion trc_Tick using cl_TRC_INC_TIME;
inversion trg_Tick using cl_TRG_INC_TIME; simpl in |- *;
intros; Easy.
Notation InvTCG :=
(fun s : StGlobal =>
match s with
| (st_x, (sc_y, sg_z)) => InvT st_x /\ InvC sc_y /\ InvG sg_z
end) (only parsing).
Notation ForAll_TCG := (ForAll TrGlobal) (only parsing).
Notation Exists_TCG := (Exists TrGlobal) (only parsing).
(* The initial state of the system TCG satisfy the location invariants *)
(* Some invariants of the system TCG *)
Definition Inv1 (s : StGlobal) :=
match s with
| ((st, _), ((sc, _), (sg, _))) =>
st = Near \/ st = Inside -> sc = Sc3 -> sg = Closed \/ sg = Lowering
end.
Definition Inv2 (s : StGlobal) :=
match s with
| ((st, _), ((sc, _), (sg, _))) =>
st = Far -> sg = Open \/ sg = Raising -> sc = Sc1
end.
Definition Inv3 (s : StGlobal) :=
match s with
| ((st, x), ((_, y), _)) => st = Near \/ st = Inside -> eq_Ck x y
end.
Definition Inv4 (s : StGlobal) :=
match s with
| ((st, _), ((sc, _), _)) => st = Near -> sc = Sc2 \/ sc = Sc3
end.
Definition Inv5 (s : StGlobal) :=
match s with
| ((st, _), ((sc, y), (_, z))) =>
st = Near -> sc = Sc3 -> eq_Ck y (plus_Ck z kc1)
end.
Definition Inv6 (s : StGlobal) :=
match s with
| ((st, x), ((sc, _), _)) =>
st = Near /\ gt_Ck x kc1 \/ st = Inside -> sc = Sc3
end.
Definition Inv7 (s : StGlobal) :=
match s with
| ((st, _), ((sc, _), (sg, _))) =>
st = Near \/ st = Inside -> sc = Sc3 -> sg = Lowering \/ sg = Closed
end.
Definition Inv8 (s : StGlobal) :=
match s with
| ((st, x), ((sc, _), (sg, _))) =>
st = Near /\ gt_Ck x kt1 \/ st = Inside -> sg = Closed
end.
Definition safeTCG (s : StGlobal) :=
match s with
| ((st, _), (_, (sg, _))) => st = Inside -> sg = Closed
end.
(* The safety property of the system TCG *)
Definition Inv9 (s : StGlobal) :=
match s with
| ((st, x), ((_, y), (_, z))) =>
st = Near /\ gt_Ck x kc1 \/ st = Inside -> eq_Ck y (plus_Ck z kc1)
end.
Definition Inv10 (s : StGlobal) :=
match s with
| (_, ((sc, _), (sg, _))) =>
sc = Sc1 \/ sc = Sc2 -> sg = Open \/ sg = Raising
end.
Definition Inv11 (s : StGlobal) :=
match s with
| (_, ((sc, _), (sg, _))) =>
sg = Lowering \/ sg = Closed -> sc = Sc3 \/ sc = Sc4
end.
Definition Inv12 (s : StGlobal) :=
match s with
| (_, ((sc, y), (_, z))) => sc = Sc2 -> ge_Ck z y
end.
Definition Inv13 (s : StGlobal) :=
match s with
| ((st, _), ((sc, _), _)) => sc = Sc2 -> st = Near
end.
Definition Inv14 (s : StGlobal) :=
match s with
| ((st, _), ((sc, _), (sg, _))) => sc = Sc4 -> st = Far /\ sg = Closed
end.
Definition InvSc3 (s : StGlobal) :=
match s with
| (_, ((sc, y), _)) => sc = Sc3 -> ge_Ck y kc1
end.
Definition InvInside (s : StGlobal) :=
match s with
| ((st, x), _) => st = Inside -> gt_Ck x kt1
end.
(* Lemmas, definitions and auxiliar tactics for the NonZeno property *)
Notation no_invT :=
(fun s : S_Ck ST =>
match s with
| (st, x) => st = Near /\ ~ lt_Ck x kt2 \/ st = Inside /\ ~ lt_Ck x kt2
end) (only parsing).
Notation no_invC :=
(fun s : S_Ck SC =>
match s with
| (sc, y) => sc = Sc2 /\ ~ le_Ck y kc1 \/ sc = Sc4 /\ ~ lt_Ck y kc2
end) (only parsing).
Notation no_invG :=
(fun s : S_Ck SG =>
match s with
| (sg, z) =>
sg = Lowering /\ ~ lt_Ck z kg1 \/ sg = Raising /\ ~ lt_Ck z kg3
end) (only parsing).
Definition InvTick (s : StGlobal) :=
match s with
| ((st, x), ((sc, y), (sg, z))) =>
(fun s : StGlobal =>
match s with
| (st_x, (sc_y, sg_z)) => InvT st_x /\ InvC sc_y /\ InvG sg_z
end) (st, Inc x, (sc, Inc y, (sg, Inc z)))
end.
Definition noInvTick (s : StGlobal) :=
match s with
| ((st, x), ((sc, y), (sg, z))) =>
~ InvTick (st, x, (sc, y, (sg, z))) ->
RState TrGlobal SiniTCG (st, x, (sc, y, (sg, z))) ->
(st = Near /\ gt_Ck x kt1 \/ st = Inside) \/
InvT (st, Inc x) /\ (sc = Sc2 /\ eq_Ck y kc1 \/ sc = Sc4) \/
InvT (st, Inc x) /\
InvC (sc, Inc y) /\ (sg = Lowering \/ sg = Raising /\ ge_Ck z kg2)
end.
Notation rsNext_In :=
(fun (x : Clock) (gt_x_kt1 : gt_Ck x kt1) (lt_x_kt2 : lt_Ck x kt2)
(sc_y : S_Ck SC) (sg_z : S_Ck SG) =>
rsNext (rsIni TrGlobal (Near, x, (sc_y, sg_z)))
(tGl_In (ttIn (x:=x) gt_x_kt1 lt_x_kt2) sc_y sg_z))
(only parsing).
Notation rsNext_Down :=
(fun (z : Clock) (lt_z_kg1 : lt_Ck z kg1) (st_x : S_Ck ST) (sc_y : S_Ck SC) =>
rsNext (rsIni TrGlobal (st_x, (sc_y, (Lowering, z))))
(tGl_Down (tgDown lt_z_kg1) st_x sc_y)) (only parsing).
Notation rsNext_Up :=
(fun (z : Clock) (ge_z_kg2 : ge_Ck z kg2) (lt_z_kg3 : lt_Ck z kg3)
(st_x : S_Ck ST) (sc_y : S_Ck SC) =>
rsNext (rsIni TrGlobal (st_x, (sc_y, (Raising, z))))
(tGl_Up (tgUp ge_z_kg2 lt_z_kg3) st_x sc_y)) (only parsing).
Notation rs_Next_Approach :=
(fun (x y : Clock) (sg_z : S_Ck SG) =>
rsNext StGlobal (rsIni StGlobal TrGlobal (Far, x, (Sc1, y, sg_z)))
(tGl_Approach (ttApproach x) (tcApproach y) sg_z))
(only parsing).
Notation rsNext_Exit :=
(fun (x y : Clock) (lt_x_kt2 : lt_Ck x kt2) (sg_z : S_Ck SG) =>
rsNext (rsIni TrGlobal (Inside, x, (Sc3, y, sg_z)))
(tGl_Exit (ttExit lt_x_kt2) (tcExit y) sg_z))
(only parsing).
Notation rsNext_Lower :=
(fun (y z : Clock) (eq_y_kc1 : eq_Ck y kc1) (st_x : S_Ck ST) =>
rsNext (rsIni TrGlobal (st_x, (Sc2, y, (Open, z))))
(tGl_Lower (tcLower eq_y_kc1) (tgLower z) st_x))
(only parsing).
Notation rsNext_Raise :=
(fun (y z : Clock) (lt_y_kc2 : lt_Ck y kc2) (st_x : S_Ck ST) =>
rsNext (rsIni TrGlobal (st_x, (Sc4, y, (Closed, z))))
(tGl_Raise (tcRaise lt_y_kc2) (tgRaise z) st_x))
(only parsing).
Ltac SplitTrans' :=
intros s1 s2 l rs_s1 p_s1 tr_gl; generalize (rsNext rs_s1 tr_gl);
generalize rs_s1; clear rs_s1; generalize p_s1;
clear p_s1; elim tr_gl.
Ltac SplitTrans'_Simpl :=
SplitTrans';
[ Simpl_In
| Simpl_Down
| Simpl_Up
| Simpl_Approach
| Simpl_Exit
| Simpl_Lower
| Simpl_Raise
| Simpl_Tick ].
Ltac ExistsHere_ITick s :=
apply exists_ with (tr := TrGlobal) (P := InvTick) (1 := rsIni TrGlobal s).
(* NonZeno proof for the system TCG *)

Lemma NonZeno :
ForAll TrGlobal SiniTCG (fun s : StGlobal => Exists TrGlobal s InvTick).