header {*An example on CTCS mode and level conversions.*}

theory CTCS_Conversion
  imports HHL
begin

(*First define the whole process, which is composed of a set of sub-processes.*)

type_synonym  segT = "exp * exp * exp * exp" (*Each segment contains v1, v2, s, and mode.*)
type_synonym  MAT = "segT list"

consts
chw :: "cname" (*Channel CH_win*)
chd :: "cname" (*Channel CH_DC*)
bw  :: "string"   (*Variable b_win*)
MA_n :: "MAT"
t_delay :: real
minA :: real (*Min acceleration, CONSTANT*)
maxA :: real (*Max acc, CONSTANT*)

axioms
assumpMinA: "minA > 0"
assumpMaxA: "maxA > 0"

(****************)
(* The variables*)
(****************)
(*Variable level*)
definition level :: "exp" where
"level == RVar ''le''"
 (*Displacement, variable s, the position of the train*)
definition sf :: "exp" where
"sf == RVar ''s''"
(*Variable x2*)
definition x2 :: "exp" where
"x2 == RVar ''x2''"
(*MA*)
definition seg1 :: "segT" where
"seg1 == (RVar ''v11'', RVar ''v12'', RVar ''x2'', String ''FS'')"
definition seg2 :: "segT" where
"seg2 == (RVar ''v21'', RVar ''v22'', RVar ''e2'', String ''CO'')"
definition MA :: "MAT" where
"MA == seg1#seg2#MA_n"
(*Temp_t0*)
definition Temp_t0 :: "exp" where
"Temp_t0 == RVar ''t0''"
(*Temp_t1*)
definition Temp_t1 :: "exp" where
"Temp_t1 == RVar ''t1''"
(*Temp_t2*)
definition Temp_t2 :: "exp" where
"Temp_t2 == RVar ''t2''"
(*clock time*)
definition ct :: "exp" where
"ct == RVar ''ct''"
 (*Velocity of the Train*)
definition vel :: "exp"
where "vel == RVar ''v''"
 (*Acceleation of the Train*)
definition acc :: "exp" where
"acc == RVar ''a''"
(*Mode of train*)
definition md :: "exp" where
"md == SVar ''md''"
(*Variable b_rConf*)
definition br :: "exp" where
"br == BVar ''br''"

(****************)
(* The driver process*)
(****************)
definition P :: "proc" where
"P ==  (IF ((BVar bw) [=] (Bool True))
      ((chd !! (Bool True)) [[ (chd !! (Bool False))))"

definition Driver :: "proc" where
"Driver ==  (Skip; (WTrue, l [=] Real 0); chw ?? (BVar bw));
     (((BVar bw) [=] (Bool False)), (l [=] Real 0) [|] (high (WTrue))); P"

(****************)
(* The train process*)
(****************)

(*checkV1, checkV2: check the given speed is less than all v1 and v2 of MAT.*)
primrec checkV1 :: "MAT => exp => fform" where
"checkV1 ([], v) = WTrue" |
"checkV1 ((a # ma), v) = ((v [<] (fst (a))) [&] (checkV1 (ma, v)))"
primrec checkV2 :: "MAT => exp => fform" where
"checkV2 ([], v) = WTrue" |
"checkV2 ((a # ma), v) = ((v [<] (fst (snd (a)))) [&] (checkV2 (ma, v)))"

(*checkS: checks the given speed is less than all the dynamic curves of MAT.*)
primrec checkS :: "MAT => exp => exp => fform" where
"checkS ([], v, s) = WTrue" |
"checkS (a#ma, v, s) = ((((v[*]v)[+](((Real 2)[*](Real minA))[*]s)) [<]
                   ( (((fst(a)))[*]((fst(a)))) [+]
                   (((Real 2)[*](Real minA))[*]((fst (snd (snd (a))))))))
                   [&] (checkS ((ma), v, s)))"

definition B0 :: "fform" where
"B0 == ((vel[>=] Real 0) [|] ((acc) [>=] Real 0) [|] (( ct) [<] (( Temp_t0) [+] (Real t_delay))))"

definition B1 :: "fform" where
"B1 == ( (checkV2 (MA, vel)) [|] ((acc) [<] Real 0) [|] (( ct) [<] (( Temp_t1) [+] (Real t_delay))))"

definition B2 :: "fform" where
"B2 ==  ((checkV1 (MA, vel)) [&] (checkS (MA, vel, sf))) [|]  (acc [=] Real (- (minA))) "

definition B4 :: "fform" where
"B4 == (([~](level [=] (Real 2.5))) [|] (sf [<=] x2))"

(*Use pre-defined function hd.*)
definition B5 :: "fform" where
"B5 == (md [=] (snd ( snd ( snd (hd(MA))))))"

definition B6 :: "fform" where
"B6 == (([~](level [=] (Real 3)))
    [|] ([~] (String ''CO'' [=]  (snd ( snd ( snd (hd( tl (MA))))))))
    [|] (br [=] Bool True)
    [|] ((((fst (snd (snd (hd (MA))))) [-] sf) [>] Real 0) [&]
           (((fst (snd (snd (hd (MA))))) [-] sf) [<] Real 300))
    [|] ((ct) [<] (Temp_t2 [+] Real t_delay)))"

definition B :: fform where
"B == (B1 [&] B2 [&] B4 [&] B5 [&] B6)"

(*Invariant for Train movement*)
definition inv :: fform where
"inv == (checkS (MA, vel, sf))"

(*Precondition*)
definition Pre :: fform where
"Pre == (level [=] Real 2.5)
      [&] (((fst (snd (snd (seg1))))) [=] x2)
      [&] (((snd (snd (snd (seg1))))) [=] (String ''FS''))
      [&] (((snd (snd (snd (seg2))))) [=] (String ''CO''))
      [&] (((fst (seg1))) [=] Real 0)"
definition Init :: fform where
"Init == (x2 [-] sf [>] Real 300) [&] B1 [&] B2
      [&] (checkS (MA, vel, sf)) "

(*The following presents the proof of the example.*)

(*The continuous part*)
definition Move :: proc where
"Move == <inv && B> : (l [>] Real 0)"

(*P_train includes six sub-processes in sequence.*)
definition P1 :: proc where
"P1 == (IF B6 chw !! (Bool False)); (WTrue, WTrue); (IF ([~] B6) chw!! (Bool True))"

(*For this case, B6 is True.*)
(*Add {*assert B6*} before this process. This is proved in Assert1*)
definition SP1 :: proc where
"SP1 ==  chw !! (Bool False)"

(*Variable c, used in Q12.*)
definition cv :: "exp" where
"cv == RVar ''cv''"
definition Q11 :: proc where
"Q11 == (IF ([~]B0) ( ((Temp_t0 := ct); (Pre [&] sf [<=] x2, l [=] (Real 0));
         NON R ''cv'' : (cv [>] Real 0 [&] (cv [<] Real maxA)) acc := cv) ))"

definition Q12 :: proc where
"Q12 == (IF ([~] B1) ((Temp_t1 := ct); (Pre [&] sf [<=] x2, l [=] (Real 0));
         NON R ''cv'' : ((cv [>] Real (-minA)) [&] (cv [<] Real maxA)) acc := (cv)) )"

definition Q13 :: proc where
"Q13 == (IF ([~] B2) acc := (Real (- minA)))"

definition Q3 :: proc where
"Q3 == (IF ([~] B4) level := (Real 3))"

definition Q4 :: proc where
"Q4 == (IF ([~] B5) ((md) := ((snd (snd (snd (hd (MA))))))))"

definition Q5 :: proc where
"Q5 == (IF ([~] B6) ((Temp_t2) := (ct); (WTrue, WTrue);chd ?? br; (WTrue, WTrue);
       (IF (br [=] Bool True) ((fst (hd (tl (MA)))) := (Real 40)))))"

definition Imd :: mid where
"Imd == (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))))"

definition Train :: proc where
"Train == ((Move; (Pre [&] sf [<=] x2,  (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
          (Q11; Imd; Q12; Imd; Q13; Imd; Q3; Imd; Q4)); Imd; SP1);
          (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));Q5"

definition System :: proc where
"System == (Train)* || (Driver)*"

(***********************************************************)
(***********************************************************)
(* Process definition finished, proof part starts. *)
(***********************************************************)
(***********************************************************)

(*********************************)
(**for differential equation**)

lemma assist_cont_1 : "|- Init [-->] inv"
apply (simp add:Init_def inv_def)
apply (rule impR)
apply fast
done

lemma assist_cont_2_a: "[|s <= t; t < (u::real)|] ==> (s < u)"
apply (auto)
done

lemma assist_cont_2_b: "[|s <= t; s ~=u; t = (u::real)|] ==> (s < u)"
apply (auto)
done

lemma assist_cont_2_c: "2 * minA * rvar(''s'') <= rvar(''v'') * rvar(''v'') + 2 * minA * rvar(''s'')"
apply (auto)
done

lemma assist_cont_2: "close(checkS(MA, vel, sf)), Pre |- sf [<=] x2"
apply (unfold MA_def Pre_def,auto)
apply (rule conjL)+
apply (cut_tac P="vel [*] vel [+] (Real 2 [*] Real minA) [*] sf [<]
    fst(seg2) [*] fst(seg2) [+] (Real 2 [*] Real minA) [*] fst(snd(snd(seg2))) [|]
    vel [*] vel [+] (Real 2 [*] Real minA) [*] sf [=]
    fst(seg2) [*] fst(seg2) [+] (Real 2 [*] Real minA) [*] fst(snd(snd(seg2)))" in thinL,auto)
apply (cut_tac P="close(checkS(MA_n, vel, sf))" in thinL,auto)
apply (cut_tac P="level [=] Real 5 / 2" in thinL,auto)
apply (cut_tac P="fst(snd(snd(seg1))) [=] x2" in thinL,auto)
apply (cut_tac P="snd(snd(snd(seg1))) [=] String ''FS''" in thinL,auto)
apply (cut_tac P="snd(snd(snd(seg2))) [=] String ''CO''" in thinL,auto)
apply (unfold seg1_def seg2_def level_def x2_def sf_def vel_def equal_less_def)
apply (rule Trans2,auto)
apply (subgoal_tac "2 * minA * rvar(''s'') < 2 * minA * rvar(''x2'') & minA >0",auto)
apply (cut_tac s="2 * minA * rvar(''s'')"
    and t="rvar(''v'') * rvar(''v'') + 2 * minA * rvar(''s'')"
    and u="2 * minA * rvar(''x2'')" in assist_cont_2_a,auto)
apply (rule assumpMinA)
apply (subgoal_tac "2 * minA * rvar(''s'') < 2 * minA * rvar(''x2'')")
apply (subgoal_tac "minA >0", simp)
apply (rule assumpMinA)
apply (cut_tac s="2 * minA * rvar(''s'')"
    and t="rvar(''v'') * rvar(''v'') + 2 * minA * rvar(''s'')"
    and u="2*minA * rvar(''x2'')" in assist_cont_2_b)
apply (rule assist_cont_2_c, auto)
apply (subgoal_tac "minA >0", simp)
apply (rule assumpMinA)
done

lemma step_continuous: "{Init [&] Pre} Move {Pre [&] sf [<=] x2; (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))}"
apply (simp add:Move_def)
apply (cut_tac Init = "Init" and p = "Pre" and F = "inv" and b = "B" and
               Rg = "(l [>] Real 0)" and q = "Pre [&] sf [<=] x2" and
               G = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" in Continue,auto)
apply (rule conjR)
apply (rule assist_cont_1)
apply (rule conjR)
apply (rule impR)
apply (rule conjR)
apply fast
apply (rule conjL)+
apply (cut_tac P="NotForm(B)" in thinL,auto)
apply (simp add: inv_def)
apply (rule exchL)
apply (rule assist_cont_2)
apply (rule impR)
apply (rule conjL)
apply (rule disjL)
apply fast
apply (rule exchL)
apply (rule thinL)
apply (rule disjR)
apply (rule thinR)
apply (cut_tac s = "close(inv) [&] Pre [&] close(B)" and t= "Pre [&] sf [<=] x2" in DC18,auto)
apply (rule conjL)+
apply (rule conjR)
apply fast
apply (cut_tac P="close(B)" in thinL,auto)
apply (simp add:inv_def)
apply (rule assist_cont_2)
done

(**********************************)
(**for Q11****)

lemma assist_Q11_1_a : "substF([(Temp_t0, ct)], Pre) = Pre"
apply (simp add: Temp_t0_def ct_def Pre_def seg1_def)
apply (simp add: level_def x2_def seg2_def)
done

lemma assist_Q11_1_b : "substF([(Temp_t0, ct)], sf [<=] x2) = (sf [<=] x2)"
apply (simp add: Temp_t0_def ct_def equal_less_def)
apply (simp add: sf_def x2_def)
done

lemma assist_Q11_1 : "{Pre [&] sf [<=] x2}(Temp_t0) := (ct) {Pre [&] sf [<=] x2; l [=]Real 0}"
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and e = "Temp_t0" and
               f = "ct" and q = "Pre [&] sf [<=] x2" and
               G = "l [=] Real 0" in Assign,auto)
prefer 3
apply (rule conjR)
apply (simp add: assist_Q11_1_a assist_Q11_1_b)
apply fast+
apply (unfold Pre_def sf_def x2_def equal_less_def inPairForm_def inPairL_def inPairR_def inExp_def,auto)
done

lemma assist_Q11_2_a : "substF([(acc, cv)], Pre) = Pre"
apply (simp add:acc_def cv_def Pre_def)
apply (simp add:level_def x2_def seg1_def seg2_def)
done

lemma assist_Q11_2_b : "substF([(acc, cv)], sf [<=] x2) = (sf [<=] x2)"
apply (simp add:acc_def cv_def equal_less_def)
apply (simp add:sf_def x2_def)
done

lemma assist_Q11_2 : "{Pre [&] sf [<=] x2} acc := (cv){Pre [&] sf [<=] x2; l [=] Real 0}"
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and e = "acc" and
               f = "cv" and q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in Assign,auto)
prefer 3
apply (simp add: assist_Q11_2_a assist_Q11_2_b)
apply fast
apply (unfold Pre_def sf_def x2_def equal_less_def inPairForm_def inPairL_def inPairR_def inExp_def,auto)
done

lemma assist_Q11_3 : "{Pre [&] sf [<=] x2} NON R ''cv'': (cv [>] Real 0 [&] cv [<]  Real maxA)
       CTCS_Conversion.acc := cv{Pre [&] sf [<=] x2;l [=] Real 0}"
apply (cut_tac p = "Pre [&] sf [<=] x2" and q = "Pre [&] sf [<=] x2" and
               G = "l [=] Real 0" and b = "cv [>] Real 0 [&] cv [<]  Real maxA"and
               P = "acc := (cv)" in Nondeterministic,auto)
apply (cut_tac p = "(Pre [&] sf [<=] x2) [&] cv [>] Real 0 [&] cv [<] Real maxA" and
               q = "Pre [&] sf [<=] x2" and H= "l [=] Real 0" and
               px = "(Pre [&] sf [<=] x2)" and qx = "Pre [&] sf [<=] x2" and
               Hx = "l [=] Real 0" and P = "acc := (cv)" in ConsequenceS, auto)
apply (rule assist_Q11_2)
apply fast
done

lemma step_Q11 : "{Pre [&] sf [<=] x2} Q11 {Pre [&] sf [<=] x2; (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))} "
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and q = "Pre [&] sf [<=] x2" and
               H = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
               px = "(Pre [&] sf [<=] x2)" and qx = "Pre [&] sf [<=] x2" and
               Hx = "(l [=] Real 0)" and
               P = "Q11" in ConsequenceS, auto)
prefer 2
apply (fast)
apply (simp add:Q11_def)
apply (cut_tac p = "Pre [&] sf [<=] x2" and b = "[~] B0" and
P = "Temp_t0 := ct; (Pre [&] sf [<=] x2, l [=] Real 0) ; NON R ''cv'' : (cv [>]
        Real 0 [&] (cv [<] Real maxA)) CTCS_Conversion.acc := cv"
and q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in Condition, auto)
apply (cut_tac p = "(Pre [&] sf [<=] x2) [&] [~] B0" and b = "[~] B0"
           and P = "(Temp_t0 := ct; (Pre [&] sf [<=] x2, l [=] Real 0);
             NON R ''cv'' : (cv [>] Real 0 [&] (cv [<] Real maxA)) CTCS_Conversion.acc := cv)"
           and q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in ConditionT, auto)
apply fast
apply (cut_tac p = "(Pre [&] sf [<=] x2) [&] [~] B0" and q = "Pre [&] sf [<=] x2" and
               H = "l [=] Real 0" and px = "(Pre [&] sf [<=] x2)" and
               qx = "Pre [&] sf [<=] x2" and Hx = "l [=] Real 0" and
               P = "Temp_t0 := ct; (Pre [&] sf [<=] x2, l [=] Real 0) ;
                NON R ''cv'' : (cv [>] Real 0 [&] (cv [<] Real maxA)) CTCS_Conversion.acc := cv"
                in ConsequenceS, auto)
apply (cut_tac P = "(Temp_t0) := (ct)" and Q = "NON R ''cv'' : (cv [>] Real 0 [&] cv [<] Real maxA)
                 acc := (cv)" and p = "Pre [&] sf [<=] x2" and m = "Pre [&] sf [<=] x2" and
               H = "l [=] Real 0" and q = "Pre [&] sf [<=] x2" and
               G = "l [=] Real 0" in Sequence )
apply (rule assist_Q11_1)
apply (rule assist_Q11_3)
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and q = "Pre [&] sf [<=] x2" and
               H = "l [=] Real 0" and px = "(Pre [&] sf [<=] x2)" and
               qx = "Pre [&] sf [<=] x2" and Hx = "l [=] Real 0 [^] l [=] Real 0" and
               P = "Temp_t0 := ct; (Pre [&] sf [<=] x2, l [=] Real 0) ;
                NON R ''cv'' : (cv [>] Real 0 [&] (cv [<] Real maxA)) CTCS_Conversion.acc := cv"
                in ConsequenceS, auto)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule impR)
apply (rule LL4)
apply (rule basic)
apply fast
apply (cut_tac p = "(Pre [&] sf [<=] x2) [&] [~] [~] B0" and b = "[~] B0"
           and P = "((Temp_t0) := (ct); (Pre [&] sf [<=] x2,l [=] Real 0) ;
                NON R ''cv'' : (cv [>] Real 0 [&] cv [<] Real maxA) acc := (cv))"
           and q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in ConditionF, auto)
apply fast+
done

(*************************************)
(*for Q12*)

lemma assist_Q12_1_a : "substF([(Temp_t1, ct)], Pre) = Pre"
apply (simp add: Temp_t1_def ct_def Pre_def seg1_def)
apply (simp add: level_def x2_def seg2_def)
done

lemma assist_Q12_1_b : "substF([(Temp_t1, ct)], sf [<=] x2) = (sf [<=] x2)"
apply (simp add: Temp_t1_def ct_def equal_less_def)
apply (simp add: sf_def x2_def)
done

lemma assist_Q12_1 : "{Pre [&] sf [<=] x2}(Temp_t1) := (ct) {Pre [&] sf [<=] x2; l [=]Real 0}"
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and e = "Temp_t1" and
               f = "ct" and q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in Assign,auto)
prefer 3
apply (rule conjR)
apply (simp add: assist_Q12_1_a assist_Q12_1_b)
apply fast+
apply (unfold Pre_def sf_def x2_def equal_less_def inPairForm_def inPairL_def inPairR_def inExp_def,auto)
done

lemma assist_Q12_2 : "{Pre [&] sf [<=] x2} NON R ''cv'': (cv [>] Real - minA [&] cv [<] Real maxA) acc := (cv){Pre [&] sf [<=] x2;l [=] Real 0}"
apply (cut_tac p = "Pre [&] sf [<=] x2" and q = "Pre [&] sf [<=] x2" and
               G = "l [=] Real 0" and b = "cv [>] Real - minA [&] cv [<] Real maxA" and
               P = "acc := (cv)" in Nondeterministic,auto)
apply (cut_tac p = "(Pre [&] sf [<=] x2) [&] cv [>] Real - minA [&] cv [<] Real maxA" and
               q = "Pre [&] sf [<=] x2" and H= "l [=] Real 0" and
               px = "(Pre [&] sf [<=] x2)" and qx = "Pre [&] sf [<=] x2" and
               Hx = "l [=] Real 0" and P = "acc := (cv)" in ConsequenceS, auto)
apply (rule assist_Q11_2)
apply fast
done

lemma step_Q12 : "{Pre [&] sf [<=] x2} Q12 {Pre [&] sf [<=] x2; (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))} "
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and q = "Pre [&] sf [<=] x2" and
               H = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
               px = "(Pre [&] sf [<=] x2)" and qx = "Pre [&] sf [<=] x2" and
               Hx = "(l [=] Real 0)" and
               P = "Q12" in ConsequenceS, auto)
prefer 2
apply (fast)
apply (simp add:Q12_def)
apply (cut_tac p = "Pre [&] sf [<=] x2" and b = "[~] B1" and P = "((Temp_t1) := (ct);
                 (Pre [&] sf [<=] x2, l [=] Real 0) ; NON R ''cv'': (cv [>] Real - minA [&]
                 cv [<] Real maxA) acc := cv)" and q = "Pre [&] sf [<=] x2" and
               G = "l [=] Real 0" in Condition, auto)
apply (cut_tac p = "(Pre [&] sf [<=] x2) [&] [~] B1" and b = "[~] B1" and
               P = "((Temp_t1) := (ct); (Pre [&] sf [<=] x2,l [=] Real 0);
                 NON R ''cv'': (cv [>] Real - minA [&] cv [<] Real maxA) acc := (cv))"
           and q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in ConditionT, auto)
apply fast
apply (cut_tac p = "(Pre [&] sf [<=] x2) [&] [~] B1" and q = "Pre [&] sf [<=] x2" and
               H= "l [=] Real 0" and px = "(Pre [&] sf [<=] x2)" and
               qx = "Pre [&] sf [<=] x2" and Hx = "l [=] Real 0" and
               P = "(Temp_t1) := (ct); (Pre [&] sf [<=] x2,l [=] Real 0);
                 NON R ''cv'': (cv [>] Real - minA [&] cv [<] Real maxA) acc := (cv)"
                 in ConsequenceS, auto)
apply (cut_tac P = "(Temp_t1) := (ct)" and Q = "NON R ''cv'': (cv [>] Real - minA [&]
                 cv [<] Real maxA) acc := (cv)" and p = "Pre [&] sf [<=] x2" and
               m = "Pre [&] sf [<=] x2" and H = "l [=] Real 0" and
               q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in Sequence )
apply (rule assist_Q12_1)
apply (rule assist_Q12_2)
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and q = "Pre [&] sf [<=] x2" and
               H = "l [=] Real 0" and px = "(Pre [&] sf [<=] x2)" and
               qx = "Pre [&] sf [<=] x2" and Hx = "l [=] Real 0 [^] l [=] Real 0" and
               P = "Temp_t1 := ct; (Pre [&] sf [<=] x2, l [=] Real 0) ;
                NON R ''cv'' : (cv [>] Real - minA [&] (cv [<] Real maxA)) CTCS_Conversion.acc := cv"
                in ConsequenceS, auto)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule impR)
apply (rule LL4)
apply (rule basic)
apply fast
apply (cut_tac p = "(Pre [&] sf [<=] x2) [&] [~] [~] B1" and b = "[~] B1" and
               P = "((Temp_t1) := (ct); (Pre [&] sf [<=] x2,l [=] Real 0);
                 NON R ''cv'': (cv [>] Real - minA [&] cv [<] Real maxA) acc := (cv))" and
               q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in ConditionF, auto)
apply fast+
done

(**********************************)
(**for Q13****)

lemma assist_Q13_1_a : "substF([(acc, Real - minA)], Pre) = Pre"
apply (simp add:acc_def Pre_def)
apply (simp add:level_def x2_def seg1_def seg2_def)
done

lemma assist_Q13_1_b : "substF([(acc, Real - minA)], sf [<=] x2) = (sf [<=] x2)"
apply (simp add:acc_def equal_less_def)
apply (simp add:sf_def x2_def)
done

lemma assist_Q13_1 : " {(Pre [&] sf [<=] x2)} acc := (Real - minA) {Pre [&] sf [<=] x2;l [=] Real 0}"
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and e = "acc" and
               f = "(Real - minA)" and q = "Pre [&] sf [<=] x2" and
               G = "l [=] Real 0" in Assign)
apply (simp add: Pre_def sf_def x2_def equal_less_def inPairForm_def inPairL_def inPairR_def inExp_def)
apply (simp add: assist_Q13_1_a assist_Q13_1_b)
apply fast
apply assumption
done

lemma step_Q13 : "{Pre [&] sf [<=] x2} Q13 {Pre [&] sf [<=] x2; (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))} "
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and q = "Pre [&] sf [<=] x2" and
               H = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
               px = "(Pre [&] sf [<=] x2)" and qx = "Pre [&] sf [<=] x2" and
               Hx = "(l [=] Real 0)" and
               P = "Q13" in ConsequenceS, auto)
prefer 2
apply (fast)
apply (simp add:Q13_def)
apply (cut_tac p = "Pre [&] sf [<=] x2" and b = "[~] B2" and P = "acc := (Real - minA)" and
               q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in Condition, auto)
apply (cut_tac p = "(Pre [&] sf [<=] x2)  [&] [~] B2" and b = "[~] B2" and
               P = "acc := (Real - minA)" and q = "Pre [&] sf [<=] x2" and
               G = "l [=] Real 0" in ConditionT, auto)
apply fast
apply (cut_tac p = "(Pre [&] sf [<=] x2) [&] [~] B2" and q = "Pre [&] sf [<=] x2" and
               H= "l [=] Real 0" and px = "(Pre [&] sf [<=] x2)" and
               qx = "Pre [&] sf [<=] x2" and Hx = "l [=] Real 0" and
               P = "acc := (Real - minA)" in ConsequenceS, auto)
apply (rule assist_Q13_1)
apply fast
apply (cut_tac p = "(Pre [&] sf [<=] x2)  [&] [~] [~] B2" and b = "[~] B2" and
               P = "acc := (Real - minA)" and
               q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in ConditionF,auto)
apply fast+
done

(**********************)
(* for Q3 *)

lemma assist_Q3 : "|- Pre [&] sf [<=] x2 [-->] [~] [~] B4"
apply (simp add:Pre_def B4_def)
apply (rule impR)
apply (rule notR)
apply (rule notL)
apply (rule disjR)
apply (rule thinR)
apply fast
done

lemma step_Q3 : "{Pre [&] sf [<=] x2} Q3 {Pre [&] sf [<=] x2; (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))}"
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and q = "Pre [&] sf [<=] x2" and
               H = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
               px = "(Pre [&] sf [<=] x2)" and qx = "Pre [&] sf [<=] x2" and
               Hx = "(l [=] Real 0)" and
               P = "Q3" in ConsequenceS, auto)
prefer 2
apply (fast)
apply (simp add:Q3_def)
apply (cut_tac p = "Pre [&] sf [<=] x2" and b = "[~] B4" and P = "level := (Real 3)"
           and q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in ConditionF)
apply (rule assist_Q3)
apply (fast)+
apply assumption
done

(**************)
(** for Q4**)

lemma assist_Q4_a : "(substF([(md, snd(snd(snd(hd(MA)))))], Pre)) = (Pre)"
apply (unfold Pre_def md_def)
apply (unfold level_def x2_def MA_def seg1_def seg2_def, auto)
done

lemma assist_Q4_b : "substF([(md, snd(snd(snd(hd(MA)))))], sf [<=] x2) = (sf [<=] x2)"
apply (unfold md_def equal_less_def)
apply (unfold sf_def x2_def MA_def, auto)
done

lemma assist_Q4 : "{(Pre [&] sf [<=] x2)} md := (snd(snd(snd(hd(MA)))))
                     {Pre [&] sf [<=] x2;l [=] Real 0}"
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and e = "md" and
               f = "snd(snd(snd(hd(MA))))" and q = "Pre [&] sf [<=] x2" and
               G = "l [=] Real 0" in Assign)
apply (simp add: Pre_def sf_def x2_def equal_less_def inPairForm_def inPairL_def inPairR_def inExp_def)
apply (rule conjR)
apply (simp add: assist_Q4_a assist_Q4_b)
apply fast+
apply assumption
done

lemma step_Q4 : "{Pre [&] sf [<=] x2} Q4 {Pre [&] sf [<=] x2; (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))}"
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and q = "Pre [&] sf [<=] x2" and
               H = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
               px = "(Pre [&] sf [<=] x2)" and qx = "Pre [&] sf [<=] x2" and
               Hx = "(l [=] Real 0)" and
               P = "Q4" in ConsequenceS, auto)
prefer 2
apply (fast)
apply (simp add:Q4_def)
apply (cut_tac p = "Pre [&] sf [<=] x2" and b = "[~] B5" and
               P = "(md) := (snd(snd(snd(hd(MA)))))" and q = "Pre [&] sf [<=] x2" and
               G = "l [=] Real 0" in Condition, auto)
apply (cut_tac p = "(Pre [&] sf [<=] x2)  [&] [~] B5" and b = "[~] B5" and
               P = "(md) := (snd(snd(snd(hd(MA)))))" and
               q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in ConditionT, auto)
apply fast
apply (cut_tac p = "(Pre [&] sf [<=] x2) [&] [~] B5" and q = "Pre [&] sf [<=] x2" and
               H= "l [=] Real 0" and px = "(Pre [&] sf [<=] x2)" and
               qx = "Pre [&] sf [<=] x2" and Hx = "l [=] Real 0" and
               P = "md := (snd(snd(snd (hd(MA)))))" in ConsequenceS, auto)
apply (rule assist_Q4)
apply fast
apply (cut_tac p = "(Pre [&] sf [<=] x2)  [&] [~] [~] B5" and b = "[~] B5" and
               P = "(md) := (snd(snd(snd(hd(MA)))))" and
               q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in ConditionF,auto)
apply fast+
done
(************************)
(** composite: move and Q11-Q4**)

lemma DCR3_assist: "(high D) [^] (high D) |- (high D) [^] (high D),$E ==> (high D) [^] (high D) |- (high D),$E"
apply (rule DCR3)
apply fast
done

lemma step_part1_comp_assist: "|- (l [=] Real 0 [|] high(Pre [&] sf [<=] x2)) [^]
                      (l [=] Real 0 [|] high(Pre [&] sf [<=] x2))
                    [-->] l [=] Real 0 [|] high(Pre [&] sf [<=] x2)"
apply (rule impR)
apply (rule LT1)
apply (rule LT1a)
apply (rule LL4)
apply (rule disjR)
apply fast
apply (rule LL3a)
apply (rule disjR)
apply fast
apply (rule LT1a)
apply (rule LL4)
apply (rule disjR)
apply fast
apply (rule disjR)
apply (rule thinR)
apply (cut_tac D="(Pre [&] sf [<=] x2)" in DCR3_assist,auto)
apply fast
done

lemma step_part1_comp : "{Init [&] Pre}
        Move; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q11; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))) ;
        Q12; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q13; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q3; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q4 {Pre [&] sf [<=] x2; (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))}"
apply (cut_tac p = "Init [&] Pre" and P = "Move" and
        m = "Pre [&] sf [<=] x2" and
        H = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
        Q = "Q11; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))) ;
        Q12; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q13; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q3; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q4" and q = "Pre [&] sf [<=] x2" and
        G = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" in Sequence)
apply (rule step_continuous)
apply (cut_tac p = "Pre [&] sf [<=] x2" and P = "Q11" and
        m = "Pre [&] sf [<=] x2" and
        H = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
        Q = "Q12; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q13; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q3; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q4" and q = "Pre [&] sf [<=] x2" and
        G = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" in Sequence)
apply (rule step_Q11)
apply (cut_tac p = "Pre [&] sf [<=] x2" and P = "Q12" and
        m = "Pre [&] sf [<=] x2" and
        H = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
        Q = "Q13; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q3; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q4" and q = "Pre [&] sf [<=] x2" and
        G = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" in Sequence)
apply (rule step_Q12)
apply (cut_tac p = "Pre [&] sf [<=] x2" and P = "Q13" and
        m = "Pre [&] sf [<=] x2" and
        H = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
        Q = "Q3; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q4" and q = "Pre [&] sf [<=] x2" and
        G = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" in Sequence)
apply (rule step_Q13)
apply (cut_tac p = "Pre [&] sf [<=] x2" and P = "Q3" and
        m = "Pre [&] sf [<=] x2" and
        H = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
        Q = "Q4" and q = "Pre [&] sf [<=] x2" and
        G = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" in Sequence)
apply (rule step_Q3)
apply (rule step_Q4)
apply (rule ConsequenceS,auto)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule step_part1_comp_assist)
apply (rule ConsequenceS,auto)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule step_part1_comp_assist)
apply (rule ConsequenceS,auto)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule step_part1_comp_assist)
apply (rule ConsequenceS,auto)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule step_part1_comp_assist)
apply (rule ConsequenceS,auto)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule conjR)
apply (rule impR)
apply (rule basic)
apply (rule step_part1_comp_assist)
done

(*********************************)
(**with the communication**)

(*Assert B6 holds.*)
lemma Assert1 : "(Pre [&] sf [<=] x2)|- B6"
apply (rule conjL)
apply (rule exchL)
apply (rule thinL)
apply (simp add:Pre_def B6_def seg1_def level_def x2_def)
apply (rule conjL)
apply (rule exchL)
apply (rule thinL)
apply (rule disjR)
apply (rule exchR)
apply (rule thinR)
apply (rule Trans1,auto)
done

lemma step_parallel: "{Init [&] Pre, WTrue}
        ((Move; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q11; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))) ;
        Q12; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q13; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q3; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q4) || Skip) {Pre [&] sf [<=] x2, WTrue;
                 (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))), (l [=] Real 0)}"
apply (cut_tac px = "Init [&] Pre" and py = "WTrue" and
        Px = "(Move; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q11; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))) ;
        Q12; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q13; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q3; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q4)" and Py = "Skip" and
        qx = "Pre [&] sf [<=] x2" and qy = "WTrue" and
        Hx = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
        Hy = "(l [=] Real 0)" in Parallel2, auto)
apply (rule step_part1_comp)
apply (rule Skip)
done

(*********************************)
(**communication with sequential composition**)

lemma assist_comm_sequential : "substF([((BVar bw), Bool False)], (BVar bw) [=] (Bool False)) = (Bool False [=] Bool False)"
apply (unfold substF_def, auto)
done

lemma step_comm_sequential: "{Init [&] Pre, WTrue}
        (((Move; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q11; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))) ;
        Q12; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q13; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q3; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q4); (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
       (chw !! (Bool False))) || (Skip; (WTrue, l [=] Real 0); chw ?? (BVar bw)))
       {Pre [&] sf [<=] x2, ((BVar bw) [=] (Bool False));
       (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))), (l [=] Real 0) [|] (high (WTrue))}"
apply (cut_tac
        Px = "((Move; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q11; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))) ;
        Q12; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q13; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q3; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q4); (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        (chw !! (Bool False)))" and
        Py = "Skip; (WTrue, l [=]  Real 0) ; chw??(BVar bw)" and
        p = "Init [&] Pre" and r = "WTrue" and
        q = "Pre [&] sf [<=] x2" and s = "BVar bw [=] Bool False" and
        H = "l [=] Real 0 [|] (high (Pre [&] sf [<=] x2))" and
        G = "l [=] Real 0 [|] high WTrue" and
        px = "Init [&] Pre" and py = "WTrue" and
        qx = "Pre [&] sf [<=] x2" and qy = "BVar bw [=] Bool False" and
        Hx = " (l [=] Real 0 [|] (high (Pre [&] sf [<=] x2))) [&] WTrue" and
        Hy = "(l [=] Real 0 [|] high WTrue) [&] WTrue" in ConsequenceP, auto)
apply (cut_tac px = "Init [&] Pre" and py = " WTrue" and
        Px = "Move; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q11; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))) ;
        Q12; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q13; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q3; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q4" and qx = "Pre [&] sf [<=] x2" and
        Hx = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
        Py = " Skip" and qy = "WTrue" and
        Hy = "l [=] Real 0" and ch = "chw" and x = "(BVar bw)" and e = "Bool False" and
        rx = "Pre [&] sf [<=] x2" and ry = "((BVar bw) [=] (Bool False))" and
        Gx = " (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
        Gy = "(l [=] Real 0) [|] (high (WTrue))" and
        H = "WTrue" in Communication)
defer
apply (rule step_parallel)
apply (rule conjR)
apply fast
apply (rule impR)
apply (simp add:assist_comm_sequential)
apply fast
apply (rule conjR)
apply (rule impR)
apply (rule disjR)
apply (rule thinR)
apply (rule LT1)
apply (rule LL3a)
apply fast
apply (cut_tac S = "Pre [&] sf [<=] x2" in DCL3,auto)
apply (rule basic)
apply (rule impR)
apply (rule disjR)
apply (rule LL3a)
apply (fast)
apply (rule impR)
apply fast
apply (rule conjR)
apply fast
apply (rule conjR)
apply fast
apply (rule conjR)
apply fast
apply (rule conjR)
apply fast
apply (rule conjR)
apply fast+
done

(**************)
(** for Q5**)

lemma assist_Q5 : "|- Pre [&] sf [<=] x2 [-->] [~] [~] B6"
apply (rule impR)
apply (rule notR)
apply (rule notL)
apply (simp add:Pre_def B6_def level_def)
apply (rule disjR)
apply (rule exchR)
apply (rule thinR)
apply (rule conjL)
apply (rule exchL)
apply (rule conjL)
apply (rule thinL)
apply (rule exchL)
apply (rule thinL)
apply (rule Trans1,auto)
done

lemma step_Q5 : "{Pre [&] sf [<=] x2} Q5 {Pre [&] sf [<=] x2; (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))} "
apply (cut_tac p = "(Pre [&] sf [<=] x2)" and q = "Pre [&] sf [<=] x2" and
               H = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
               px = "(Pre [&] sf [<=] x2)" and qx = "Pre [&] sf [<=] x2" and
               Hx = "(l [=] Real 0)" and
               P = "Q5" in ConsequenceS, auto)
prefer 2
apply (fast)
apply (simp add:Q5_def)
apply (cut_tac p = "Pre [&] sf [<=] x2" and b = "[~] B6" and
               P = "((Temp_t2) := (ct); (WTrue, WTrue) ; chd??br; (WTrue,
                       WTrue) ; IF (br [=] Bool True) (fst(hd(tl(MA)))) := (Real 40))"
           and q = "Pre [&] sf [<=] x2" and G = "l [=] Real 0" in ConditionF,auto)
apply (rule assist_Q5)
apply fast+
done

(*************************)
(**for driver process**)

lemma step_driver : "{BVar bw [=] (Bool False)} P {BVar bw [=] (Bool False); (l [=] Real 0) [|] (high WTrue)}"
apply (cut_tac p = "BVar bw [=] (Bool False)" and q = "BVar bw [=] (Bool False)" and
               H = "(l [=] Real 0) [|] (high WTrue)" and
               px = "BVar bw [=] (Bool False)" and qx = "BVar bw [=] (Bool False)" and
               Hx = "(l [=] Real 0)" and
               P = "P" in ConsequenceS, auto)
prefer 2
apply (fast)
apply (simp add:P_def)
apply (cut_tac p = "BVar bw [=] Bool False" and b = "(BVar bw [=] Bool True)" and
               P = "(chd!!(Bool True)[[chd!!(Bool False))" and
               q = "BVar bw [=] Bool False" and G = "l [=] Real 0" in ConditionF)
apply (rule impR)
apply (rule Trans1,auto)
apply fast+
done

(***************************)
(**for once, repetition in the following**)

lemma assist_System_proof : "|- (l [=] Real 0 [|] high (p)) [^] (l [=] Real 0 [|] high (p)) [-->] (l [=] Real 0 [|] high (p))"
apply (rule impR)
apply (rule LT1)
apply (rule LT1a)
apply (rule LL4)
apply fast
apply (rule LL3a)
apply fast
apply (rule LT1a)
apply (rule LL4)
apply fast
apply (rule disjR)
apply (rule thinR)
apply (cut_tac S = "p" in DCL3,auto)
apply (rule basic)
done

lemma step_System_once : "{Init [&] Pre, WTrue} Train||Driver {Pre [&] sf [<=] x2, WTrue;
                     (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))), (l [=] Real 0) [|] (high (WTrue))}"
apply (cut_tac p = "Init [&] Pre" and r = "WTrue" and
               Px = "Train" and Py = "Driver" and
               q = "Pre [&] sf [<=] x2" and s = "WTrue" and
               H = "l [=] Real 0 [|] high (Pre [&] sf [<=] x2)" and
               G = "l [=] Real 0 [|] high (WTrue)" and px = "Init [&] Pre" and
               py = "WTrue" and qx = "Pre [&] sf [<=] x2" and
               qy = "BVar bw [=] Bool False" and
               Hx = "(l [=] Real 0 [|] high (Pre [&] sf [<=] x2)) [^]
                     (l [=] Real 0 [|] high (Pre [&] sf [<=] x2))" and
               Hy = "(l [=] Real 0 [|] high (WTrue)) [^] (l [=] Real 0 [|] high (WTrue))"
               in ConsequenceP,auto)
apply (simp add:Train_def Driver_def Imd_def SP1_def)
apply (cut_tac px = "Init [&] Pre" and py = "WTrue" and
        Px = "((Move; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q11; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q12; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q13; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q3; (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
        Q4); (Pre [&] sf [<=] x2, (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))));
       (chw !! (Bool False)))" and
        qx = "Pre [&] sf [<=] x2" and
        Hx = "l [=] Real 0 [|] high (Pre [&] sf [<=] x2)" and Qx = "Q5" and
        Py = "Skip; (WTrue, l [=] Real 0) ; chw??(BVar bw)" and
        qy = "BVar bw [=] Bool False" and
               Hy = " l [=] Real 0 [|] high (WTrue)" and Qy = "P" and
               rx = "Pre [&] sf [<=] x2" and ry = "BVar bw [=] Bool False" and
               Gx = "l [=] Real 0 [|] high (Pre [&] sf [<=] x2)" and
               Gy = " l [=] Real 0 [|] high (WTrue)" in Parallel1)
apply (rule step_comm_sequential)
apply (rule step_Q5)
apply (rule step_driver)
apply assumption
apply (rule conjR)
apply fast
apply (rule conjR)
apply fast
apply (rule conjR)
apply fast
apply (rule conjR)
apply fast
apply (rule conjR)
apply (rule assist_System_proof)
apply (rule assist_System_proof)
done

(***************************)
(**for repetition**)

(* All the fact* are create to support the steps, and all the 10 steps fforms the proof.*)
lemma System_proof : "{Init [&] Pre, WTrue} System {Pre [&] sf [<=] x2,
       WTrue; (l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2))),
       (l [=] Real 0) [|] (high (WTrue))}"
apply (simp add:System_def)
apply (cut_tac px = "Init [&] Pre" and py = "WTrue" and
               Px = "Train" and Py = "Driver" and
               qx = "Pre [&] sf [<=] x2" and qy = "WTrue" and
               Hx = "(l [=] Real 0) [|] (high (Pre [&] (sf [<=] x2)))" and
               Hy = "l [=] Real 0 [|] high WTrue" in Repetition,auto)
apply (rule step_System_once)
apply (unfold Init_def Pre_def sf_def x2_def equal_less_def)
apply (rule Trans,auto)
apply fast
apply (rule assist_System_proof)
apply (rule assist_System_proof)
done


theory Ebackup imports Main       (* Aqvist's System E: C. Benzmüller & X. Parent, 2019 *)
begin      nitpick_params [sat_solver = MiniSat_JNI]
typedecl i (*Possible worlds.*) type_synonym \<sigma> = "(i\<Rightarrow>bool)"
consts aw::i (*Actual world.*)
abbreviation etrue  :: "\<sigma>" ("\<^bold>\<top>") where "\<^bold>\<top> \<equiv> \<lambda>w. True"
abbreviation efalse :: "\<sigma>" ("\<^bold>\<bottom>")  where "\<^bold>\<bottom> \<equiv> \<lambda>w. False"
abbreviation enot :: "\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<not>_"[52]53)  where "\<^bold>\<not>\<phi> \<equiv> \<lambda>w. \<not>\<phi>(w)"
abbreviation eand :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<and>"51) where "\<phi>\<^bold>\<and>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<and>\<psi>(w)"
abbreviation eor  :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<or>"50) where "\<phi>\<^bold>\<or>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<or>\<psi>(w)"
abbreviation eimp :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<rightarrow>"49) where "\<phi>\<^bold>\<rightarrow>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<longrightarrow>\<psi>(w)"
abbreviation eequ :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" (infixr"\<^bold>\<leftrightarrow>"48) where "\<phi>\<^bold>\<leftrightarrow>\<psi> \<equiv> \<lambda>w. \<phi>(w)\<longleftrightarrow>\<psi>(w)"

(*Possibilist--constant domain--quantification.*)
abbreviation eforall ("\<^bold>\<forall>") where "\<^bold>\<forall>\<Phi> \<equiv> \<lambda>w.\<forall>x. (\<Phi> x w)"
abbreviation eforallB (binder"\<^bold>\<forall>"[8]9) where "\<^bold>\<forall>x. \<phi>(x) \<equiv> \<^bold>\<forall>\<phi>"
abbreviation eexists ("\<^bold>\<exists>") where "\<^bold>\<exists>\<Phi> \<equiv> \<lambda>w.\<exists>x. (\<Phi> x w)"
abbreviation eexistsB (binder"\<^bold>\<exists>"[8]9) where "\<^bold>\<exists>x. \<phi>(x) \<equiv> \<^bold>\<exists>\<phi>"

abbreviation ebox :: "\<sigma>\<Rightarrow>\<sigma>" ("\<box>") where "\<box> \<equiv> \<lambda>\<phi> w.  \<forall>v. \<phi>(v)"
consts R :: "i\<Rightarrow>\<sigma>" (infixr "R" 70) (*Betterness relation, cf. def. of \<circle><_|_>.*)
abbreviation eopt  :: "\<sigma>\<Rightarrow>\<sigma>" ("opt<_>")
  where "opt<\<phi>> \<equiv> (\<lambda>v. ( (\<phi>)(v) \<and> (\<forall>x. ((\<phi>)(x)  \<longrightarrow>  v R x) )) )"
abbreviation esubset :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>bool" (infix "\<^bold>\<subseteq>" 53)
  where "\<phi> \<^bold>\<subseteq> \<psi> \<equiv> \<forall>x. \<phi> x \<longrightarrow> \<psi> x"
abbreviation econd  :: "\<sigma>\<Rightarrow>\<sigma>\<Rightarrow>\<sigma>" ("\<circle><_|_>")
  where "\<circle><\<psi>|\<phi>> \<equiv>  \<lambda>w. opt<\<phi>> \<^bold>\<subseteq> \<psi>"
abbreviation euncobl :: "\<sigma>\<Rightarrow>\<sigma>" ("\<^bold>\<circle><_>")
  where "\<^bold>\<circle><\<phi>> \<equiv> \<circle><\<phi>|\<^bold>\<top>>"

abbreviation evalid :: "\<sigma>\<Rightarrow>bool" ("\<lfloor>_\<rfloor>"[8]109)  (*Global validity.*)
  where "\<lfloor>p\<rfloor> \<equiv> \<forall>w. p w"
abbreviation ecjactual :: "\<sigma>\<Rightarrow>bool" ("\<lfloor>_\<rfloor>\<^sub>l"[7]105) (*Local validity — in world aw.*)
  where "\<lfloor>p\<rfloor>\<^sub>l \<equiv> p(aw)"

lemma True nitpick [satisfy,user_axioms,expect=genuine] oops (*Consistency conf.*)

(*Correspondence theory.*)
lemma assumes "\<forall>x y z. x R y \<and> y R z \<longrightarrow> x R z"
      shows "\<lfloor>((\<circle><\<psi>|\<phi>>) \<^bold>\<and> \<^bold>\<not>(\<circle><\<^bold>\<not>\<xi>|\<phi>>)) \<^bold>\<rightarrow> \<circle><\<psi>|\<phi>\<^bold>\<and>\<xi>>\<rfloor>"
  sledgehammer oops

lemma assumes "\<lfloor>((\<circle><\<psi>|\<phi>>) \<^bold>\<and> \<^bold>\<not>(\<circle><\<^bold>\<not>\<xi>|\<phi>>)) \<^bold>\<rightarrow> \<circle><\<psi>|\<phi>\<^bold>\<and>\<xi>>\<rfloor>"
      shows "\<forall>x y z. x R y \<and> y R z \<longrightarrow> x R z"
  nitpick [show_all,format=2]  (*Countermodel presented by Nitpick.*)

end


section "Small-Step Semantics of Commands"

theory Small_Step imports Star Big_Step begin

subsection "The transition relation"

inductive
  small_step :: "com * state \<Rightarrow> com * state \<Rightarrow> bool" (infix "\<rightarrow>" 55)
where
Assign:  "(x ::= a, s) \<rightarrow> (SKIP, s(x := aval a s))" |

Seq1:    "(SKIP;;c\<^sub>2,s) \<rightarrow> (c\<^sub>2,s)" |
Seq2:    "(c\<^sub>1,s) \<rightarrow> (c\<^sub>1',s') \<Longrightarrow> (c\<^sub>1;;c\<^sub>2,s) \<rightarrow> (c\<^sub>1';;c\<^sub>2,s')" |

IfTrue:  "bval b s \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2,s) \<rightarrow> (c\<^sub>1,s)" |
IfFalse: "\<not>bval b s \<Longrightarrow> (IF b THEN c\<^sub>1 ELSE c\<^sub>2,s) \<rightarrow> (c\<^sub>2,s)" |

While:   "(WHILE b DO c,s) \<rightarrow>
            (IF b THEN c;; WHILE b DO c ELSE SKIP,s)"

abbreviation
  small_steps :: "com * state \<Rightarrow> com * state \<Rightarrow> bool" (infix "\<rightarrow>*" 55)
where "x \<rightarrow>* y == star small_step x y"

subsection{* Executability *}

code_pred small_step .

values "{(c',map t [''x'',''y'',''z'']) |c' t.
   (''x'' ::= V ''z'';; ''y'' ::= V ''x'',
    <''x'' := 3, ''y'' := 7, ''z'' := 5>) \<rightarrow>* (c',t)}"

subsection{* Proof infrastructure *}

subsubsection{* Induction rules *}

text{* The default induction rule @{thm[source] small_step.induct} only works
for lemmas of the form @{text"a \<rightarrow> b \<Longrightarrow> \<dots>"} where @{text a} and @{text b} are
not already pairs @{text"(DUMMY,DUMMY)"}. We can generate a suitable variant
of @{thm[source] small_step.induct} for pairs by ``splitting'' the arguments
@{text"\<rightarrow>"} into pairs: *}
lemmas small_step_induct = small_step.induct[split_format(complete)]

subsubsection{* Proof automation *}

declare small_step.intros[simp,intro]

text{* Rule inversion: *}

inductive_cases SkipE[elim!]: "(SKIP,s) \<rightarrow> ct"
thm SkipE
inductive_cases AssignE[elim!]: "(x::=a,s) \<rightarrow> ct"
thm AssignE
inductive_cases SeqE[elim]: "(c1;;c2,s) \<rightarrow> ct"
thm SeqE
inductive_cases IfE[elim!]: "(IF b THEN c1 ELSE c2,s) \<rightarrow> ct"
inductive_cases WhileE[elim]: "(WHILE b DO c, s) \<rightarrow> ct"

text{* A simple property: *}
lemma deterministic:
  "cs \<rightarrow> cs' \<Longrightarrow> cs \<rightarrow> cs'' \<Longrightarrow> cs'' = cs'"
apply(induction arbitrary: cs'' rule: small_step.induct)
apply blast+
done

subsection "Equivalence with big-step semantics"

lemma star_seq2: "(c1,s) \<rightarrow>* (c1',s') \<Longrightarrow> (c1;;c2,s) \<rightarrow>* (c1';;c2,s')"
proof(induction rule: star_induct)
  case refl thus ?case by simp
next
  case step
  thus ?case by (metis Seq2 star.step)
qed

lemma seq_comp:
  "\<lbrakk> (c1,s1) \<rightarrow>* (SKIP,s2); (c2,s2) \<rightarrow>* (SKIP,s3) \<rbrakk>
   \<Longrightarrow> (c1;;c2, s1) \<rightarrow>* (SKIP,s3)"
by(blast intro: star.step star_seq2 star_trans)

text{* The following proof corresponds to one on the board where one would
show chains of @{text "\<rightarrow>"} and @{text "\<rightarrow>*"} steps. *}

lemma big_to_small:
  "cs \<Rightarrow> t \<Longrightarrow> cs \<rightarrow>* (SKIP,t)"
proof (induction rule: big_step.induct)
  fix s show "(SKIP,s) \<rightarrow>* (SKIP,s)" by simp
next
  fix x a s show "(x ::= a,s) \<rightarrow>* (SKIP, s(x := aval a s))" by auto
next
  fix c1 c2 s1 s2 s3
  assume "(c1,s1) \<rightarrow>* (SKIP,s2)" and "(c2,s2) \<rightarrow>* (SKIP,s3)"
  thus "(c1;;c2, s1) \<rightarrow>* (SKIP,s3)" by (rule seq_comp)
next
  fix s::state and b c0 c1 t
  assume "bval b s"
  hence "(IF b THEN c0 ELSE c1,s) \<rightarrow> (c0,s)" by simp
  moreover assume "(c0,s) \<rightarrow>* (SKIP,t)"
  ultimately
  show "(IF b THEN c0 ELSE c1,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
next
  fix s::state and b c0 c1 t
  assume "\<not>bval b s"
  hence "(IF b THEN c0 ELSE c1,s) \<rightarrow> (c1,s)" by simp
  moreover assume "(c1,s) \<rightarrow>* (SKIP,t)"
  ultimately
  show "(IF b THEN c0 ELSE c1,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
next
  fix b c and s::state
  assume b: "\<not>bval b s"
  let ?if = "IF b THEN c;; WHILE b DO c ELSE SKIP"
  have "(WHILE b DO c,s) \<rightarrow> (?if, s)" by blast
  moreover have "(?if,s) \<rightarrow> (SKIP, s)" by (simp add: b)
  ultimately show "(WHILE b DO c,s) \<rightarrow>* (SKIP,s)" by(metis star.refl star.step)
next
  fix b c s s' t
  let ?w  = "WHILE b DO c"
  let ?if = "IF b THEN c;; ?w ELSE SKIP"
  assume w: "(?w,s') \<rightarrow>* (SKIP,t)"
  assume c: "(c,s) \<rightarrow>* (SKIP,s')"
  assume b: "bval b s"
  have "(?w,s) \<rightarrow> (?if, s)" by blast
  moreover have "(?if, s) \<rightarrow> (c;; ?w, s)" by (simp add: b)
  moreover have "(c;; ?w,s) \<rightarrow>* (SKIP,t)" by(rule seq_comp[OF c w])
  ultimately show "(WHILE b DO c,s) \<rightarrow>* (SKIP,t)" by (metis star.simps)
qed

text{* Each case of the induction can be proved automatically: *}
lemma  "cs \<Rightarrow> t \<Longrightarrow> cs \<rightarrow>* (SKIP,t)"
proof (induction rule: big_step.induct)
  case Skip show ?case by blast
next
  case Assign show ?case by blast
next
  case Seq thus ?case by (blast intro: seq_comp)
next
  case IfTrue thus ?case by (blast intro: star.step)
next
  case IfFalse thus ?case by (blast intro: star.step)
next
  case WhileFalse thus ?case
    by (metis star.step star_step1 small_step.IfFalse small_step.While)
next
  case WhileTrue
  thus ?case
    by(metis While seq_comp small_step.IfTrue star.step[of small_step])
qed

lemma small1_big_continue:
  "cs \<rightarrow> cs' \<Longrightarrow> cs' \<Rightarrow> t \<Longrightarrow> cs \<Rightarrow> t"
apply (induction arbitrary: t rule: small_step.induct)
apply auto
done

lemma small_to_big:
  "cs \<rightarrow>* (SKIP,t) \<Longrightarrow> cs \<Rightarrow> t"
apply (induction cs "(SKIP,t)" rule: star.induct)
apply (auto intro: small1_big_continue)
done

text {*
  Finally, the equivalence theorem:
*}
theorem big_iff_small:
  "cs \<Rightarrow> t = cs \<rightarrow>* (SKIP,t)"
by(metis big_to_small small_to_big)

subsection "Final configurations and infinite reductions"

definition "final cs \<longleftrightarrow> \<not>(EX cs'. cs \<rightarrow> cs')"

lemma finalD: "final (c,s) \<Longrightarrow> c = SKIP"
apply(simp add: final_def)
apply(induction c)
apply blast+
done

lemma final_iff_SKIP: "final (c,s) = (c = SKIP)"
by (metis SkipE finalD final_def)

text{* Now we can show that @{text"\<Rightarrow>"} yields a final state iff @{text"\<rightarrow>"}
terminates: *}

lemma big_iff_small_termination:
  "(EX t. cs \<Rightarrow> t) \<longleftrightarrow> (EX cs'. cs \<rightarrow>* cs' \<and> final cs')"
by(simp add: big_iff_small final_iff_SKIP)

text{* This is the same as saying that the absence of a big step result is
equivalent with absence of a terminating small step sequence, i.e.\ with
nontermination.  Since @{text"\<rightarrow>"} is determininistic, there is no difference
between may and must terminate. *}

end