(*  Title:      HOL/TLA/Memory/MemoryImplementation.thy
    Author:     Stephan Merz, University of Munich
*)

section \<open>RPC-Memory example: Memory implementation\<close>

theory MemoryImplementation
imports Memory RPC MemClerk
begin

datatype histState = histA | histB

type_synonym histType = "(PrIds \<Rightarrow> histState) stfun"  (* the type of the history variable *)

consts
  (* the specification *)
     (* channel (external) *)
  memCh         :: "memChType"
     (* internal variables *)
  mm            :: "memType"

  (* the state variables of the implementation *)
     (* channels *)
  (* same interface channel memCh *)
  crCh          :: "rpcSndChType"
  rmCh          :: "rpcRcvChType"
     (* internal variables *)
  (* identity refinement mapping for mm -- simply reused *)
  rst           :: "rpcStType"
  cst           :: "mClkStType"
  ires          :: "resType"

definition
  (* auxiliary predicates *)
  MVOKBARF      :: "Vals \<Rightarrow> bool"
  where "MVOKBARF v \<longleftrightarrow> (v \<in> MemVal) \<or> (v = OK) \<or> (v = BadArg) \<or> (v = RPCFailure)"

definition
  MVOKBA        :: "Vals \<Rightarrow> bool"
  where "MVOKBA v \<longleftrightarrow> (v \<in> MemVal) \<or> (v = OK) \<or> (v = BadArg)"

definition
  MVNROKBA      :: "Vals \<Rightarrow> bool"
  where "MVNROKBA v \<longleftrightarrow> (v \<in> MemVal) \<or> (v = NotAResult) \<or> (v = OK) \<or> (v = BadArg)"

definition
  (* tuples of state functions changed by the various components *)
  e             :: "PrIds => (bit * memOp) stfun"
  where "e p = PRED (caller memCh!p)"

definition
  c             :: "PrIds \<Rightarrow> (mClkState * (bit * Vals) * (bit * rpcOp)) stfun"
  where "c p = PRED (cst!p, rtrner memCh!p, caller crCh!p)"

definition
  r             :: "PrIds \<Rightarrow> (rpcState * (bit * Vals) * (bit * memOp)) stfun"
  where "r p = PRED (rst!p, rtrner crCh!p, caller rmCh!p)"

definition
  m             :: "PrIds \<Rightarrow> ((bit * Vals) * Vals) stfun"
  where "m p = PRED (rtrner rmCh!p, ires!p)"

definition
  (* the environment action *)
  ENext         :: "PrIds \<Rightarrow> action"
  where "ENext p = ACT (\<exists>l. #l \<in> #MemLoc \<and> Call memCh p #(read l))"

definition
  (* specification of the history variable *)
  HInit         :: "histType \<Rightarrow> PrIds \<Rightarrow> stpred"
  where "HInit rmhist p = PRED rmhist!p = #histA"

definition
  HNext         :: "histType \<Rightarrow> PrIds \<Rightarrow> action"
  where "HNext rmhist p = ACT (rmhist!p)$ =
                     (if (MemReturn rmCh ires p \<or> RPCFail crCh rmCh rst p)
                      then #histB
                      else if (MClkReply memCh crCh cst p)
                           then #histA
                           else $(rmhist!p))"

definition
  HistP         :: "histType \<Rightarrow> PrIds \<Rightarrow> temporal"
  where "HistP rmhist p = (TEMP Init HInit rmhist p
                           \<and> \<box>[HNext rmhist p]_(c p,r p,m p, rmhist!p))"

definition
  Hist          :: "histType \<Rightarrow> temporal"
  where "Hist rmhist = TEMP (\<forall>p. HistP rmhist p)"

definition
  (* the implementation *)
  IPImp          :: "PrIds \<Rightarrow> temporal"
  where "IPImp p = (TEMP (  Init \<not>Calling memCh p \<and> \<box>[ENext p]_(e p)
                       \<and> MClkIPSpec memCh crCh cst p
                       \<and> RPCIPSpec crCh rmCh rst p
                       \<and> RPSpec rmCh mm ires p
                       \<and> (\<forall>l. #l \<in> #MemLoc \<longrightarrow> MSpec rmCh mm ires l)))"

definition
  ImpInit        :: "PrIds \<Rightarrow> stpred"
  where "ImpInit p = PRED (  \<not>Calling memCh p
                          \<and> MClkInit crCh cst p
                          \<and> RPCInit rmCh rst p
                          \<and> PInit ires p)"

definition
  ImpNext        :: "PrIds \<Rightarrow> action"
  where "ImpNext p = (ACT  [ENext p]_(e p)
                       \<and> [MClkNext memCh crCh cst p]_(c p)
                       \<and> [RPCNext crCh rmCh rst p]_(r p)
                       \<and> [RNext rmCh mm ires p]_(m p))"

definition
  ImpLive        :: "PrIds \<Rightarrow> temporal"
  where "ImpLive p = (TEMP  WF(MClkFwd memCh crCh cst p)_(c p)
                        \<and> SF(MClkReply memCh crCh cst p)_(c p)
                        \<and> WF(RPCNext crCh rmCh rst p)_(r p)
                        \<and> WF(RNext rmCh mm ires p)_(m p)
                        \<and> WF(MemReturn rmCh ires p)_(m p))"

definition
  Implementation :: "temporal"
  where "Implementation = (TEMP ( (\<forall>p. Init (\<not>Calling memCh p) \<and> \<box>[ENext p]_(e p))
                               \<and> MClkISpec memCh crCh cst
                               \<and> RPCISpec crCh rmCh rst
                               \<and> IRSpec rmCh mm ires))"

definition
  (* the predicate S describes the states of the implementation.
     slight simplification: two "histState" parameters instead of a
     (one- or two-element) set.
     NB: The second conjunct of the definition in the paper is taken care of by
     the type definitions. The last conjunct is asserted separately as the memory
     invariant MemInv, proved in Memory.thy. *)
  S :: "histType \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> bool \<Rightarrow> mClkState \<Rightarrow> rpcState \<Rightarrow> histState \<Rightarrow> histState \<Rightarrow> PrIds \<Rightarrow> stpred"
  where "S rmhist ecalling ccalling rcalling cs rs hs1 hs2 p = (PRED
                Calling memCh p = #ecalling
              \<and> Calling crCh p  = #ccalling
              \<and> (#ccalling \<longrightarrow> arg<crCh!p> = MClkRelayArg<arg<memCh!p>>)
              \<and> (\<not> #ccalling \<and> cst!p = #clkB \<longrightarrow> MVOKBARF<res<crCh!p>>)
              \<and> Calling rmCh p  = #rcalling
              \<and> (#rcalling \<longrightarrow> arg<rmCh!p> = RPCRelayArg<arg<crCh!p>>)
              \<and> (\<not> #rcalling \<longrightarrow> ires!p = #NotAResult)
              \<and> (\<not> #rcalling \<and> rst!p = #rpcB \<longrightarrow> MVOKBA<res<rmCh!p>>)
              \<and> cst!p = #cs
              \<and> rst!p = #rs
              \<and> (rmhist!p = #hs1 \<or> rmhist!p = #hs2)
              \<and> MVNROKBA<ires!p>)"

definition
  (* predicates S1 -- S6 define special instances of S *)
  S1            :: "histType \<Rightarrow> PrIds \<Rightarrow> stpred"
  where "S1 rmhist p = S rmhist False False False clkA rpcA histA histA p"

definition
  S2            :: "histType \<Rightarrow> PrIds \<Rightarrow> stpred"
  where "S2 rmhist p = S rmhist True False False clkA rpcA histA histA p"

definition
  S3            :: "histType \<Rightarrow> PrIds \<Rightarrow> stpred"
  where "S3 rmhist p = S rmhist True True False clkB rpcA histA histB p"

definition
  S4            :: "histType \<Rightarrow> PrIds \<Rightarrow> stpred"
  where "S4 rmhist p = S rmhist True True True clkB rpcB histA histB p"

definition
  S5            :: "histType \<Rightarrow> PrIds \<Rightarrow> stpred"
  where "S5 rmhist p = S rmhist True True False clkB rpcB histB histB p"

definition
  S6            :: "histType \<Rightarrow> PrIds \<Rightarrow> stpred"
  where "S6 rmhist p = S rmhist True False False clkB rpcA histB histB p"

definition
  (* The invariant asserts that the system is always in one of S1 - S6, for every p *)
  ImpInv         :: "histType \<Rightarrow> PrIds \<Rightarrow> stpred"
  where "ImpInv rmhist p = (PRED (S1 rmhist p \<or> S2 rmhist p \<or> S3 rmhist p
                                \<or> S4 rmhist p \<or> S5 rmhist p \<or> S6 rmhist p))"

definition
  resbar        :: "histType \<Rightarrow> resType"        (* refinement mapping *)
  where"resbar rmhist s p =
                  (if (S1 rmhist p s | S2 rmhist p s)
                   then ires s p
                   else if S3 rmhist p s
                   then if rmhist s p = histA
                        then ires s p else MemFailure
                   else if S4 rmhist p s
                   then if (rmhist s p = histB & ires s p = NotAResult)
                        then MemFailure else ires s p
                   else if S5 rmhist p s
                   then res (rmCh s p)
                   else if S6 rmhist p s
                   then if res (crCh s p) = RPCFailure
                        then MemFailure else res (crCh s p)
                   else NotAResult)" (* dummy value *)

axiomatization where
  (* the "base" variables: everything except resbar and hist (for any index) *)
  MI_base:       "basevars (caller memCh!p,
                           (rtrner memCh!p, caller crCh!p, cst!p),
                           (rtrner crCh!p, caller rmCh!p, rst!p),
                           (mm!l, rtrner rmCh!p, ires!p))"

(*
    The main theorem is theorem "Implementation" at the end of this file,
    which shows that the composition of a reliable memory, an RPC component, and
    a memory clerk implements an unreliable memory. The files "MIsafe.thy" and
    "MIlive.thy" contain lower-level lemmas for the safety and liveness parts.

    Steps are (roughly) numbered as in the hand proof.
*)

(* --------------------------- automatic prover --------------------------- *)

declare if_weak_cong [cong del]

(* A more aggressive variant that tries to solve subgoals by assumption
   or contradiction during the simplification.
   THIS IS UNSAFE, BECAUSE IT DOESN'T RECORD THE CHOICES!!
   (but it can be a lot faster than the default setup)
*)
ML \<open>
  val config_fast_solver = Attrib.setup_config_bool \<^binding>\<open>fast_solver\<close> (K false);
  val fast_solver = mk_solver "fast_solver" (fn ctxt =>
    if Config.get ctxt config_fast_solver
    then assume_tac ctxt ORELSE' (eresolve_tac ctxt [notE])
    else K no_tac);
\<close>

setup \<open>map_theory_simpset (fn ctxt => ctxt addSSolver fast_solver)\<close>

ML \<open>val temp_elim = make_elim oo temp_use\<close>

(****************************** The history variable ******************************)

section "History variable"

lemma HistoryLemma: "\<turnstile> Init(\<forall>p. ImpInit p) \<and> \<box>(\<forall>p. ImpNext p)
         \<longrightarrow> (\<exists>\<exists>rmhist. Init(\<forall>p. HInit rmhist p)
                          \<and> \<box>(\<forall>p. [HNext rmhist p]_(c p, r p, m p, rmhist!p)))"
  apply clarsimp
  apply (rule historyI)
      apply assumption+
  apply (rule MI_base)
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm HInit_def}]) [] [] 1\<close>)
   apply (erule fun_cong)
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm HNext_def}])
    [@{thm busy_squareI}] [] 1\<close>)
  apply (erule fun_cong)
  done

lemma History: "\<turnstile> Implementation \<longrightarrow> (\<exists>\<exists>rmhist. Hist rmhist)"
  apply clarsimp
  apply (rule HistoryLemma [temp_use, THEN eex_mono])
    prefer 3
    apply (force simp: Hist_def HistP_def Init_def all_box [try_rewrite]
      split_box_conj [try_rewrite])
   apply (auto simp: Implementation_def MClkISpec_def RPCISpec_def
     IRSpec_def MClkIPSpec_def RPCIPSpec_def RPSpec_def ImpInit_def
     Init_def ImpNext_def c_def r_def m_def all_box [temp_use] split_box_conj [temp_use])
  done

(******************************** The safety part *********************************)

section "The safety part"

(* ------------------------- Include lower-level lemmas ------------------------- *)

(* RPCFailure notin MemVals U {OK,BadArg} *)

lemma MVOKBAnotRF: "MVOKBA x \<Longrightarrow> x \<noteq> RPCFailure"
  apply (unfold MVOKBA_def)
  apply auto
  done

(* NotAResult notin MemVals U {OK,BadArg,RPCFailure} *)

lemma MVOKBARFnotNR: "MVOKBARF x \<Longrightarrow> x \<noteq> NotAResult"
  apply (unfold MVOKBARF_def)
  apply auto
  done

(* ================ Si's are mutually exclusive ================================ *)
(* Si and Sj are mutually exclusive for i # j. This helps to simplify the big
   conditional in the definition of resbar when doing the step-simulation proof.
   We prove a weaker result, which suffices for our purposes:
   Si implies (not Sj), for j<i.
*)

(* --- not used ---
lemma S1_excl: "\<turnstile> S1 rmhist p \<longrightarrow> S1 rmhist p & \<not>S2 rmhist p & \<not>S3 rmhist p &
    \<not>S4 rmhist p & \<not>S5 rmhist p & \<not>S6 rmhist p"
  by (auto simp: S_def S1_def S2_def S3_def S4_def S5_def S6_def)
*)

lemma S2_excl: "\<turnstile> S2 rmhist p \<longrightarrow> S2 rmhist p \<and> \<not>S1 rmhist p"
  by (auto simp: S_def S1_def S2_def)

lemma S3_excl: "\<turnstile> S3 rmhist p \<longrightarrow> S3 rmhist p \<and> \<not>S1 rmhist p \<and> \<not>S2 rmhist p"
  by (auto simp: S_def S1_def S2_def S3_def)

lemma S4_excl: "\<turnstile> S4 rmhist p \<longrightarrow> S4 rmhist p \<and> \<not>S1 rmhist p \<and> \<not>S2 rmhist p \<and> \<not>S3 rmhist p"
  by (auto simp: S_def S1_def S2_def S3_def S4_def)

lemma S5_excl: "\<turnstile> S5 rmhist p \<longrightarrow> S5 rmhist p \<and> \<not>S1 rmhist p \<and> \<not>S2 rmhist p
                         \<and> \<not>S3 rmhist p \<and> \<not>S4 rmhist p"
  by (auto simp: S_def S1_def S2_def S3_def S4_def S5_def)

lemma S6_excl: "\<turnstile> S6 rmhist p \<longrightarrow> S6 rmhist p \<and> \<not>S1 rmhist p \<and> \<not>S2 rmhist p
                         \<and> \<not>S3 rmhist p \<and> \<not>S4 rmhist p \<and> \<not>S5 rmhist p"
  by (auto simp: S_def S1_def S2_def S3_def S4_def S5_def S6_def)

(* ==================== Lemmas about the environment ============================== *)

lemma Envbusy: "\<turnstile> $(Calling memCh p) \<longrightarrow> \<not>ENext p"
  by (auto simp: ENext_def ACall_def)

(* ==================== Lemmas about the implementation's states ==================== *)

(* The following series of lemmas are used in establishing the implementation's
   next-state relation (Step 1.2 of the proof in the paper). For each state Si, we
   determine which component actions are possible and what state they result in.
*)

(* ------------------------------ State S1 ---------------------------------------- *)

lemma S1Env: "\<turnstile> ENext p \<and> $(S1 rmhist p) \<and> unchanged (c p, r p, m p, rmhist!p)
         \<longrightarrow> (S2 rmhist p)$"
  by (force simp: ENext_def ACall_def c_def r_def m_def
    caller_def rtrner_def MVNROKBA_def S_def S1_def S2_def Calling_def)

lemma S1ClerkUnch: "\<turnstile> [MClkNext memCh crCh cst p]_(c p) \<and> $(S1 rmhist p) \<longrightarrow> unchanged (c p)"
  using [[fast_solver]]
  by (auto elim!: squareE [temp_use] dest!: MClkidle [temp_use] simp: S_def S1_def)

lemma S1RPCUnch: "\<turnstile> [RPCNext crCh rmCh rst p]_(r p) \<and> $(S1 rmhist p) \<longrightarrow> unchanged (r p)"
  using [[fast_solver]]
  by (auto elim!: squareE [temp_use] dest!: RPCidle [temp_use] simp: S_def S1_def)

lemma S1MemUnch: "\<turnstile> [RNext rmCh mm ires p]_(m p) \<and> $(S1 rmhist p) \<longrightarrow> unchanged (m p)"
  using [[fast_solver]]
  by (auto elim!: squareE [temp_use] dest!: Memoryidle [temp_use] simp: S_def S1_def)

lemma S1Hist: "\<turnstile> [HNext rmhist p]_(c p,r p,m p,rmhist!p) \<and> $(S1 rmhist p)
         \<longrightarrow> unchanged (rmhist!p)"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm HNext_def}, @{thm S_def},
    @{thm S1_def}, @{thm MemReturn_def}, @{thm RPCFail_def}, @{thm MClkReply_def},
    @{thm AReturn_def}]) [] [temp_use \<^context> @{thm squareE}] 1\<close>)

(* ------------------------------ State S2 ---------------------------------------- *)

lemma S2EnvUnch: "\<turnstile> [ENext p]_(e p) \<and> $(S2 rmhist p) \<longrightarrow> unchanged (e p)"
  by (auto dest!: Envbusy [temp_use] simp: S_def S2_def)

lemma S2Clerk: "\<turnstile> MClkNext memCh crCh cst p \<and> $(S2 rmhist p) \<longrightarrow> MClkFwd memCh crCh cst p"
  by (auto simp: MClkNext_def MClkRetry_def MClkReply_def S_def S2_def)

lemma S2Forward: "\<turnstile> $(S2 rmhist p) \<and> MClkFwd memCh crCh cst p
         \<and> unchanged (e p, r p, m p, rmhist!p)
         \<longrightarrow> (S3 rmhist p)$"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm MClkFwd_def},
    @{thm ACall_def}, @{thm e_def}, @{thm r_def}, @{thm m_def}, @{thm caller_def},
    @{thm rtrner_def}, @{thm S_def}, @{thm S2_def}, @{thm S3_def}, @{thm Calling_def}]) [] [] 1\<close>)

lemma S2RPCUnch: "\<turnstile> [RPCNext crCh rmCh rst p]_(r p) \<and> $(S2 rmhist p) \<longrightarrow> unchanged (r p)"
  by (auto simp: S_def S2_def dest!: RPCidle [temp_use])

lemma S2MemUnch: "\<turnstile> [RNext rmCh mm ires p]_(m p) \<and> $(S2 rmhist p) \<longrightarrow> unchanged (m p)"
  by (auto simp: S_def S2_def dest!: Memoryidle [temp_use])

lemma S2Hist: "\<turnstile> [HNext rmhist p]_(c p,r p,m p,rmhist!p) \<and> $(S2 rmhist p)
         \<longrightarrow> unchanged (rmhist!p)"
  using [[fast_solver]]
  by (auto elim!: squareE [temp_use] simp: HNext_def MemReturn_def RPCFail_def
    MClkReply_def AReturn_def S_def S2_def)

(* ------------------------------ State S3 ---------------------------------------- *)

lemma S3EnvUnch: "\<turnstile> [ENext p]_(e p) \<and> $(S3 rmhist p) \<longrightarrow> unchanged (e p)"
  by (auto dest!: Envbusy [temp_use] simp: S_def S3_def)

lemma S3ClerkUnch: "\<turnstile> [MClkNext memCh crCh cst p]_(c p) \<and> $(S3 rmhist p) \<longrightarrow> unchanged (c p)"
  by (auto dest!: MClkbusy [temp_use] simp: square_def S_def S3_def)

lemma S3LegalRcvArg: "\<turnstile> S3 rmhist p \<longrightarrow> IsLegalRcvArg<arg<crCh!p>>"
  by (auto simp: IsLegalRcvArg_def MClkRelayArg_def S_def S3_def)

lemma S3RPC: "\<turnstile> RPCNext crCh rmCh rst p \<and> $(S3 rmhist p)
         \<longrightarrow> RPCFwd crCh rmCh rst p \<or> RPCFail crCh rmCh rst p"
  apply clarsimp
  apply (frule S3LegalRcvArg [action_use])
  apply (auto simp: RPCNext_def RPCReject_def RPCReply_def S_def S3_def)
  done

lemma S3Forward: "\<turnstile> RPCFwd crCh rmCh rst p \<and> HNext rmhist p \<and> $(S3 rmhist p)
         \<and> unchanged (e p, c p, m p)
         \<longrightarrow> (S4 rmhist p)$ \<and> unchanged (rmhist!p)"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm RPCFwd_def},
    @{thm HNext_def}, @{thm MemReturn_def}, @{thm RPCFail_def},
    @{thm MClkReply_def}, @{thm AReturn_def}, @{thm ACall_def}, @{thm e_def},
    @{thm c_def}, @{thm m_def}, @{thm caller_def}, @{thm rtrner_def}, @{thm S_def},
    @{thm S3_def}, @{thm S4_def}, @{thm Calling_def}]) [] [] 1\<close>)

lemma S3Fail: "\<turnstile> RPCFail crCh rmCh rst p \<and> $(S3 rmhist p) \<and> HNext rmhist p
         \<and> unchanged (e p, c p, m p)
         \<longrightarrow> (S6 rmhist p)$"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm HNext_def},
    @{thm RPCFail_def}, @{thm AReturn_def}, @{thm e_def}, @{thm c_def},
    @{thm m_def}, @{thm caller_def}, @{thm rtrner_def}, @{thm MVOKBARF_def},
    @{thm S_def}, @{thm S3_def}, @{thm S6_def}, @{thm Calling_def}]) [] [] 1\<close>)

lemma S3MemUnch: "\<turnstile> [RNext rmCh mm ires p]_(m p) \<and> $(S3 rmhist p) \<longrightarrow> unchanged (m p)"
  by (auto simp: S_def S3_def dest!: Memoryidle [temp_use])

lemma S3Hist: "\<turnstile> HNext rmhist p \<and> $(S3 rmhist p) \<and> unchanged (r p) \<longrightarrow> unchanged (rmhist!p)"
  by (auto simp: HNext_def MemReturn_def RPCFail_def MClkReply_def
    AReturn_def r_def rtrner_def S_def S3_def Calling_def)

(* ------------------------------ State S4 ---------------------------------------- *)

lemma S4EnvUnch: "\<turnstile> [ENext p]_(e p) \<and> $(S4 rmhist p) \<longrightarrow> unchanged (e p)"
  by (auto simp: S_def S4_def dest!: Envbusy [temp_use])

lemma S4ClerkUnch: "\<turnstile> [MClkNext memCh crCh cst p]_(c p) \<and> $(S4 rmhist p) \<longrightarrow> unchanged (c p)"
  by (auto simp: S_def S4_def dest!: MClkbusy [temp_use])

lemma S4RPCUnch: "\<turnstile> [RPCNext crCh rmCh rst p]_(r p) \<and> $(S4 rmhist p) \<longrightarrow> unchanged (r p)"
  using [[fast_solver]]
  by (auto elim!: squareE [temp_use] dest!: RPCbusy [temp_use] simp: S_def S4_def)

lemma S4ReadInner: "\<turnstile> ReadInner rmCh mm ires p l \<and> $(S4 rmhist p) \<and> unchanged (e p, c p, r p)
         \<and> HNext rmhist p \<and> $(MemInv mm l)
         \<longrightarrow> (S4 rmhist p)$ \<and> unchanged (rmhist!p)"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm ReadInner_def},
    @{thm GoodRead_def}, @{thm BadRead_def}, @{thm HNext_def}, @{thm MemReturn_def},
    @{thm RPCFail_def}, @{thm MClkReply_def}, @{thm AReturn_def}, @{thm e_def},
    @{thm c_def}, @{thm r_def}, @{thm rtrner_def}, @{thm caller_def},
    @{thm MVNROKBA_def}, @{thm S_def}, @{thm S4_def}, @{thm RdRequest_def},
    @{thm Calling_def}, @{thm MemInv_def}]) [] [] 1\<close>)

lemma S4Read: "\<turnstile> Read rmCh mm ires p \<and> $(S4 rmhist p) \<and> unchanged (e p, c p, r p)
         \<and> HNext rmhist p \<and> (\<forall>l. $MemInv mm l)
         \<longrightarrow> (S4 rmhist p)$ \<and> unchanged (rmhist!p)"
  by (auto simp: Read_def dest!: S4ReadInner [temp_use])

lemma S4WriteInner: "\<turnstile> WriteInner rmCh mm ires p l v \<and> $(S4 rmhist p) \<and> unchanged (e p, c p, r p) \<and> HNext rmhist p
         \<longrightarrow> (S4 rmhist p)$ \<and> unchanged (rmhist!p)"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm WriteInner_def},
    @{thm GoodWrite_def}, @{thm BadWrite_def}, @{thm HNext_def}, @{thm MemReturn_def},
    @{thm RPCFail_def}, @{thm MClkReply_def}, @{thm AReturn_def}, @{thm e_def},
    @{thm c_def}, @{thm r_def}, @{thm rtrner_def}, @{thm caller_def}, @{thm MVNROKBA_def},
    @{thm S_def}, @{thm S4_def}, @{thm WrRequest_def}, @{thm Calling_def}]) [] [] 1\<close>)

lemma S4Write: "\<turnstile> Write rmCh mm ires p l \<and> $(S4 rmhist p) \<and> unchanged (e p, c p, r p)
         \<and> (HNext rmhist p)
         \<longrightarrow> (S4 rmhist p)$ \<and> unchanged (rmhist!p)"
  by (auto simp: Write_def dest!: S4WriteInner [temp_use])

lemma WriteS4: "\<turnstile> $ImpInv rmhist p \<and> Write rmCh mm ires p l \<longrightarrow> $S4 rmhist p"
  by (auto simp: Write_def WriteInner_def ImpInv_def
    WrRequest_def S_def S1_def S2_def S3_def S4_def S5_def S6_def)

lemma S4Return: "\<turnstile> MemReturn rmCh ires p \<and> $S4 rmhist p \<and> unchanged (e p, c p, r p)
         \<and> HNext rmhist p
         \<longrightarrow> (S5 rmhist p)$"
  by (auto simp: HNext_def MemReturn_def AReturn_def e_def c_def r_def
    rtrner_def caller_def MVNROKBA_def MVOKBA_def S_def S4_def S5_def Calling_def)

lemma S4Hist: "\<turnstile> HNext rmhist p \<and> $S4 rmhist p \<and> (m p)$ = $(m p) \<longrightarrow> (rmhist!p)$ = $(rmhist!p)"
  by (auto simp: HNext_def MemReturn_def RPCFail_def MClkReply_def
    AReturn_def m_def rtrner_def S_def S4_def Calling_def)

(* ------------------------------ State S5 ---------------------------------------- *)

lemma S5EnvUnch: "\<turnstile> [ENext p]_(e p) \<and> $(S5 rmhist p) \<longrightarrow> unchanged (e p)"
  by (auto simp: S_def S5_def dest!: Envbusy [temp_use])

lemma S5ClerkUnch: "\<turnstile> [MClkNext memCh crCh cst p]_(c p) \<and> $(S5 rmhist p) \<longrightarrow> unchanged (c p)"
  by (auto simp: S_def S5_def dest!: MClkbusy [temp_use])

lemma S5RPC: "\<turnstile> RPCNext crCh rmCh rst p \<and> $(S5 rmhist p)
         \<longrightarrow> RPCReply crCh rmCh rst p \<or> RPCFail crCh rmCh rst p"
  by (auto simp: RPCNext_def RPCReject_def RPCFwd_def S_def S5_def)

lemma S5Reply: "\<turnstile> RPCReply crCh rmCh rst p \<and> $(S5 rmhist p) \<and> unchanged (e p, c p, m p,rmhist!p)
       \<longrightarrow> (S6 rmhist p)$"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm RPCReply_def},
    @{thm AReturn_def}, @{thm e_def}, @{thm c_def}, @{thm m_def}, @{thm MVOKBA_def},
    @{thm MVOKBARF_def}, @{thm caller_def}, @{thm rtrner_def}, @{thm S_def},
    @{thm S5_def}, @{thm S6_def}, @{thm Calling_def}]) [] [] 1\<close>)

lemma S5Fail: "\<turnstile> RPCFail crCh rmCh rst p \<and> $(S5 rmhist p) \<and> unchanged (e p, c p, m p,rmhist!p)
         \<longrightarrow> (S6 rmhist p)$"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm RPCFail_def},
    @{thm AReturn_def}, @{thm e_def}, @{thm c_def}, @{thm m_def},
    @{thm MVOKBARF_def}, @{thm caller_def}, @{thm rtrner_def},
    @{thm S_def}, @{thm S5_def}, @{thm S6_def}, @{thm Calling_def}]) [] [] 1\<close>)

lemma S5MemUnch: "\<turnstile> [RNext rmCh mm ires p]_(m p) \<and> $(S5 rmhist p) \<longrightarrow> unchanged (m p)"
  by (auto simp: S_def S5_def dest!: Memoryidle [temp_use])

lemma S5Hist: "\<turnstile> [HNext rmhist p]_(c p, r p, m p, rmhist!p) \<and> $(S5 rmhist p)
         \<longrightarrow> (rmhist!p)$ = $(rmhist!p)"
  using [[fast_solver]]
  by (auto elim!: squareE [temp_use] simp: HNext_def MemReturn_def RPCFail_def
    MClkReply_def AReturn_def S_def S5_def)

(* ------------------------------ State S6 ---------------------------------------- *)

lemma S6EnvUnch: "\<turnstile> [ENext p]_(e p) \<and> $(S6 rmhist p) \<longrightarrow> unchanged (e p)"
  by (auto simp: S_def S6_def dest!: Envbusy [temp_use])

lemma S6Clerk: "\<turnstile> MClkNext memCh crCh cst p \<and> $(S6 rmhist p)
         \<longrightarrow> MClkRetry memCh crCh cst p \<or> MClkReply memCh crCh cst p"
  by (auto simp: MClkNext_def MClkFwd_def S_def S6_def)

lemma S6Retry: "\<turnstile> MClkRetry memCh crCh cst p \<and> HNext rmhist p \<and> $S6 rmhist p
         \<and> unchanged (e p,r p,m p)
         \<longrightarrow> (S3 rmhist p)$ \<and> unchanged (rmhist!p)"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm HNext_def},
    @{thm MClkReply_def}, @{thm MClkRetry_def}, @{thm ACall_def}, @{thm AReturn_def},
    @{thm e_def}, @{thm r_def}, @{thm m_def}, @{thm caller_def}, @{thm rtrner_def},
    @{thm S_def}, @{thm S6_def}, @{thm S3_def}, @{thm Calling_def}]) [] [] 1\<close>)

lemma S6Reply: "\<turnstile> MClkReply memCh crCh cst p \<and> HNext rmhist p \<and> $S6 rmhist p
         \<and> unchanged (e p,r p,m p)
         \<longrightarrow> (S1 rmhist p)$"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm HNext_def},
    @{thm MemReturn_def}, @{thm RPCFail_def}, @{thm AReturn_def}, @{thm MClkReply_def},
    @{thm e_def}, @{thm r_def}, @{thm m_def}, @{thm caller_def}, @{thm rtrner_def},
    @{thm S_def}, @{thm S6_def}, @{thm S1_def}, @{thm Calling_def}]) [] [] 1\<close>)

lemma S6RPCUnch: "\<turnstile> [RPCNext crCh rmCh rst p]_(r p) \<and> $S6 rmhist p \<longrightarrow> unchanged (r p)"
  by (auto simp: S_def S6_def dest!: RPCidle [temp_use])

lemma S6MemUnch: "\<turnstile> [RNext rmCh mm ires p]_(m p) \<and> $(S6 rmhist p) \<longrightarrow> unchanged (m p)"
  by (auto simp: S_def S6_def dest!: Memoryidle [temp_use])

lemma S6Hist: "\<turnstile> HNext rmhist p \<and> $S6 rmhist p \<and> (c p)$ = $(c p) \<longrightarrow> (rmhist!p)$ = $(rmhist!p)"
  by (auto simp: HNext_def MClkReply_def AReturn_def c_def rtrner_def S_def S6_def Calling_def)

section "Correctness of predicate-action diagram"

(* ========== Step 1.1 ================================================= *)
(* The implementation's initial condition implies the state predicate S1 *)

lemma Step1_1: "\<turnstile> ImpInit p \<and> HInit rmhist p \<longrightarrow> S1 rmhist p"
  using [[fast_solver]]
  by (auto elim!: squareE [temp_use] simp: MVNROKBA_def
    MClkInit_def RPCInit_def PInit_def HInit_def ImpInit_def S_def S1_def)

(* ========== Step 1.2 ================================================== *)
(* Figure 16 is a predicate-action diagram for the implementation. *)

lemma Step1_2_1: "\<turnstile> [HNext rmhist p]_(c p,r p,m p, rmhist!p) \<and> ImpNext p
         \<and> \<not>unchanged (e p, c p, r p, m p, rmhist!p)  \<and> $S1 rmhist p
         \<longrightarrow> (S2 rmhist p)$ \<and> ENext p \<and> unchanged (c p, r p, m p)"
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm ImpNext_def}]) []
      (map (temp_elim \<^context>)
        [@{thm S1ClerkUnch}, @{thm S1RPCUnch}, @{thm S1MemUnch}, @{thm S1Hist}]) 1\<close>)
   using [[fast_solver]]
   apply (auto elim!: squareE [temp_use] intro!: S1Env [temp_use])
  done

lemma Step1_2_2: "\<turnstile> [HNext rmhist p]_(c p,r p,m p, rmhist!p) \<and> ImpNext p
         \<and> \<not>unchanged (e p, c p, r p, m p, rmhist!p) \<and> $S2 rmhist p
         \<longrightarrow> (S3 rmhist p)$ \<and> MClkFwd memCh crCh cst p
             \<and> unchanged (e p, r p, m p, rmhist!p)"
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm ImpNext_def}]) []
    (map (temp_elim \<^context>)
      [@{thm S2EnvUnch}, @{thm S2RPCUnch}, @{thm S2MemUnch}, @{thm S2Hist}]) 1\<close>)
   using [[fast_solver]]
   apply (auto elim!: squareE [temp_use] intro!: S2Clerk [temp_use] S2Forward [temp_use])
  done

lemma Step1_2_3: "\<turnstile> [HNext rmhist p]_(c p,r p,m p, rmhist!p) \<and> ImpNext p
         \<and> \<not>unchanged (e p, c p, r p, m p, rmhist!p) \<and> $S3 rmhist p
         \<longrightarrow> ((S4 rmhist p)$ \<and> RPCFwd crCh rmCh rst p \<and> unchanged (e p, c p, m p, rmhist!p))
             \<or> ((S6 rmhist p)$ \<and> RPCFail crCh rmCh rst p \<and> unchanged (e p, c p, m p))"
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm ImpNext_def}]) []
    (map (temp_elim \<^context>) [@{thm S3EnvUnch}, @{thm S3ClerkUnch}, @{thm S3MemUnch}]) 1\<close>)
  apply (tactic \<open>action_simp_tac \<^context> []
    (@{thm squareE} ::
      map (temp_elim \<^context>) [@{thm S3RPC}, @{thm S3Forward}, @{thm S3Fail}]) 1\<close>)
   apply (auto dest!: S3Hist [temp_use])
  done

lemma Step1_2_4: "\<turnstile> [HNext rmhist p]_(c p,r p,m p, rmhist!p) \<and> ImpNext p
              \<and> \<not>unchanged (e p, c p, r p, m p, rmhist!p)
              \<and> $S4 rmhist p \<and> (\<forall>l. $(MemInv mm l))
         \<longrightarrow> ((S4 rmhist p)$ \<and> Read rmCh mm ires p \<and> unchanged (e p, c p, r p, rmhist!p))
             \<or> ((S4 rmhist p)$ \<and> (\<exists>l. Write rmCh mm ires p l) \<and> unchanged (e p, c p, r p, rmhist!p))
             \<or> ((S5 rmhist p)$ \<and> MemReturn rmCh ires p \<and> unchanged (e p, c p, r p))"
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm ImpNext_def}]) []
    (map (temp_elim \<^context>) [@{thm S4EnvUnch}, @{thm S4ClerkUnch}, @{thm S4RPCUnch}]) 1\<close>)
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm RNext_def}]) []
    (@{thm squareE} ::
      map (temp_elim \<^context>) [@{thm S4Read}, @{thm S4Write}, @{thm S4Return}]) 1\<close>)
  apply (auto dest!: S4Hist [temp_use])
  done

lemma Step1_2_5: "\<turnstile> [HNext rmhist p]_(c p,r p,m p, rmhist!p) \<and> ImpNext p
              \<and> \<not>unchanged (e p, c p, r p, m p, rmhist!p) \<and> $S5 rmhist p
         \<longrightarrow> ((S6 rmhist p)$ \<and> RPCReply crCh rmCh rst p \<and> unchanged (e p, c p, m p))
             \<or> ((S6 rmhist p)$ \<and> RPCFail crCh rmCh rst p \<and> unchanged (e p, c p, m p))"
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm ImpNext_def}]) []
    (map (temp_elim \<^context>) [@{thm S5EnvUnch}, @{thm S5ClerkUnch}, @{thm S5MemUnch}, @{thm S5Hist}]) 1\<close>)
  apply (tactic \<open>action_simp_tac \<^context> [] [@{thm squareE}, temp_elim \<^context> @{thm S5RPC}] 1\<close>)
   using [[fast_solver]]
   apply (auto elim!: squareE [temp_use] dest!: S5Reply [temp_use] S5Fail [temp_use])
  done

lemma Step1_2_6: "\<turnstile> [HNext rmhist p]_(c p,r p,m p, rmhist!p) \<and> ImpNext p
              \<and> \<not>unchanged (e p, c p, r p, m p, rmhist!p) \<and> $S6 rmhist p
         \<longrightarrow> ((S1 rmhist p)$ \<and> MClkReply memCh crCh cst p \<and> unchanged (e p, r p, m p))
             \<or> ((S3 rmhist p)$ \<and> MClkRetry memCh crCh cst p \<and> unchanged (e p,r p,m p,rmhist!p))"
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm ImpNext_def}]) []
    (map (temp_elim \<^context>) [@{thm S6EnvUnch}, @{thm S6RPCUnch}, @{thm S6MemUnch}]) 1\<close>)
  apply (tactic \<open>action_simp_tac \<^context> []
    (@{thm squareE} :: map (temp_elim \<^context>) [@{thm S6Clerk}, @{thm S6Retry}, @{thm S6Reply}]) 1\<close>)
     apply (auto dest: S6Hist [temp_use])
  done

(* --------------------------------------------------------------------------
   Step 1.3: S1 implies the barred initial condition.
*)

section "Initialization (Step 1.3)"

lemma Step1_3: "\<turnstile> S1 rmhist p \<longrightarrow> PInit (resbar rmhist) p"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm resbar_def},
    @{thm PInit_def}, @{thm S_def}, @{thm S1_def}]) [] [] 1\<close>)

(* ----------------------------------------------------------------------
   Step 1.4: Implementation's next-state relation simulates specification's
             next-state relation (with appropriate substitutions)
*)

section "Step simulation (Step 1.4)"

lemma Step1_4_1: "\<turnstile> ENext p \<and> $S1 rmhist p \<and> (S2 rmhist p)$ \<and> unchanged (c p, r p, m p)
         \<longrightarrow> unchanged (rtrner memCh!p, resbar rmhist!p)"
  using [[fast_solver]]
  by (auto elim!: squareE [temp_use] simp: c_def r_def m_def resbar_def)

lemma Step1_4_2: "\<turnstile> MClkFwd memCh crCh cst p \<and> $S2 rmhist p \<and> (S3 rmhist p)$
         \<and> unchanged (e p, r p, m p, rmhist!p)
         \<longrightarrow> unchanged (rtrner memCh!p, resbar rmhist!p)"
  by (tactic \<open>action_simp_tac
    (\<^context> addsimps [@{thm MClkFwd_def}, @{thm e_def}, @{thm r_def}, @{thm m_def},
    @{thm resbar_def}, @{thm S_def}, @{thm S2_def}, @{thm S3_def}]) [] [] 1\<close>)

lemma Step1_4_3a: "\<turnstile> RPCFwd crCh rmCh rst p \<and> $S3 rmhist p \<and> (S4 rmhist p)$
         \<and> unchanged (e p, c p, m p, rmhist!p)
         \<longrightarrow> unchanged (rtrner memCh!p, resbar rmhist!p)"
  apply clarsimp
  apply (drule S3_excl [temp_use] S4_excl [temp_use])+
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm e_def},
    @{thm c_def}, @{thm m_def}, @{thm resbar_def}, @{thm S_def}, @{thm S3_def}]) [] [] 1\<close>)
  done

lemma Step1_4_3b: "\<turnstile> RPCFail crCh rmCh rst p \<and> $S3 rmhist p \<and> (S6 rmhist p)$
         \<and> unchanged (e p, c p, m p)
         \<longrightarrow> MemFail memCh (resbar rmhist) p"
  apply clarsimp
  apply (drule S6_excl [temp_use])
  apply (auto simp: RPCFail_def MemFail_def e_def c_def m_def resbar_def)
    apply (force simp: S3_def S_def)
   apply (auto simp: AReturn_def)
  done

lemma Step1_4_4a1: "\<turnstile> $S4 rmhist p \<and> (S4 rmhist p)$ \<and> ReadInner rmCh mm ires p l
         \<and> unchanged (e p, c p, r p, rmhist!p) \<and> $MemInv mm l
         \<longrightarrow> ReadInner memCh mm (resbar rmhist) p l"
  apply clarsimp
  apply (drule S4_excl [temp_use])+
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm ReadInner_def},
    @{thm GoodRead_def}, @{thm BadRead_def}, @{thm e_def}, @{thm c_def}, @{thm m_def}]) [] [] 1\<close>)
     apply (auto simp: resbar_def)
       apply (tactic \<open>ALLGOALS (action_simp_tac
                (\<^context> addsimps [@{thm RPCRelayArg_def}, @{thm MClkRelayArg_def},
                  @{thm S_def}, @{thm S4_def}, @{thm RdRequest_def}, @{thm MemInv_def}])
                [] [@{thm impE}, @{thm MemValNotAResultE}])\<close>)
  done

lemma Step1_4_4a: "\<turnstile> Read rmCh mm ires p \<and> $S4 rmhist p \<and> (S4 rmhist p)$
         \<and> unchanged (e p, c p, r p, rmhist!p) \<and> (\<forall>l. $(MemInv mm l))
         \<longrightarrow> Read memCh mm (resbar rmhist) p"
  by (force simp: Read_def elim!: Step1_4_4a1 [temp_use])

lemma Step1_4_4b1: "\<turnstile> $S4 rmhist p \<and> (S4 rmhist p)$ \<and> WriteInner rmCh mm ires p l v
         \<and> unchanged (e p, c p, r p, rmhist!p)
         \<longrightarrow> WriteInner memCh mm (resbar rmhist) p l v"
  apply clarsimp
  apply (drule S4_excl [temp_use])+
  apply (tactic \<open>action_simp_tac (\<^context> addsimps
    [@{thm WriteInner_def}, @{thm GoodWrite_def}, @{thm BadWrite_def}, @{thm e_def},
    @{thm c_def}, @{thm m_def}]) [] [] 1\<close>)
     apply (auto simp: resbar_def)
    apply (tactic \<open>ALLGOALS (action_simp_tac (\<^context> addsimps
      [@{thm RPCRelayArg_def}, @{thm MClkRelayArg_def}, @{thm S_def},
      @{thm S4_def}, @{thm WrRequest_def}]) [] [])\<close>)
  done

lemma Step1_4_4b: "\<turnstile> Write rmCh mm ires p l \<and> $S4 rmhist p \<and> (S4 rmhist p)$
         \<and> unchanged (e p, c p, r p, rmhist!p)
         \<longrightarrow> Write memCh mm (resbar rmhist) p l"
  by (force simp: Write_def elim!: Step1_4_4b1 [temp_use])

lemma Step1_4_4c: "\<turnstile> MemReturn rmCh ires p \<and> $S4 rmhist p \<and> (S5 rmhist p)$
         \<and> unchanged (e p, c p, r p)
         \<longrightarrow> unchanged (rtrner memCh!p, resbar rmhist!p)"
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm e_def},
    @{thm c_def}, @{thm r_def}, @{thm resbar_def}]) [] [] 1\<close>)
  apply (drule S4_excl [temp_use] S5_excl [temp_use])+
  using [[fast_solver]]
  apply (auto elim!: squareE [temp_use] simp: MemReturn_def AReturn_def)
  done

lemma Step1_4_5a: "\<turnstile> RPCReply crCh rmCh rst p \<and> $S5 rmhist p \<and> (S6 rmhist p)$
         \<and> unchanged (e p, c p, m p)
         \<longrightarrow> unchanged (rtrner memCh!p, resbar rmhist!p)"
  apply clarsimp
  apply (drule S5_excl [temp_use] S6_excl [temp_use])+
  apply (auto simp: e_def c_def m_def resbar_def)
   apply (auto simp: RPCReply_def AReturn_def S5_def S_def dest!: MVOKBAnotRF [temp_use])
  done

lemma Step1_4_5b: "\<turnstile> RPCFail crCh rmCh rst p \<and> $S5 rmhist p \<and> (S6 rmhist p)$
         \<and> unchanged (e p, c p, m p)
         \<longrightarrow> MemFail memCh (resbar rmhist) p"
  apply clarsimp
  apply (drule S6_excl [temp_use])
  apply (auto simp: e_def c_def m_def RPCFail_def AReturn_def MemFail_def resbar_def)
   apply (auto simp: S5_def S_def)
  done

lemma Step1_4_6a: "\<turnstile> MClkReply memCh crCh cst p \<and> $S6 rmhist p \<and> (S1 rmhist p)$
         \<and> unchanged (e p, r p, m p)
         \<longrightarrow> MemReturn memCh (resbar rmhist) p"
  apply clarsimp
  apply (drule S6_excl [temp_use])+
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm e_def},
    @{thm r_def}, @{thm m_def}, @{thm MClkReply_def}, @{thm MemReturn_def},
    @{thm AReturn_def}, @{thm resbar_def}]) [] [] 1\<close>)
    apply simp_all (* simplify if-then-else *)
    apply (tactic \<open>ALLGOALS (action_simp_tac (\<^context> addsimps
      [@{thm MClkReplyVal_def}, @{thm S6_def}, @{thm S_def}]) [] [@{thm MVOKBARFnotNR}])\<close>)
  done

lemma Step1_4_6b: "\<turnstile> MClkRetry memCh crCh cst p \<and> $S6 rmhist p \<and> (S3 rmhist p)$
         \<and> unchanged (e p, r p, m p, rmhist!p)
         \<longrightarrow> MemFail memCh (resbar rmhist) p"
  apply clarsimp
  apply (drule S3_excl [temp_use])+
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm e_def}, @{thm r_def},
    @{thm m_def}, @{thm MClkRetry_def}, @{thm MemFail_def}, @{thm resbar_def}]) [] [] 1\<close>)
   apply (auto simp: S6_def S_def)
  done

lemma S_lemma: "\<turnstile> unchanged (e p, c p, r p, m p, rmhist!p)
         \<longrightarrow> unchanged (S rmhist ec cc rc cs rs hs1 hs2 p)"
  by (auto simp: e_def c_def r_def m_def caller_def rtrner_def S_def Calling_def)

lemma Step1_4_7H: "\<turnstile> unchanged (e p, c p, r p, m p, rmhist!p)
         \<longrightarrow> unchanged (rtrner memCh!p, S1 rmhist p, S2 rmhist p, S3 rmhist p,
                        S4 rmhist p, S5 rmhist p, S6 rmhist p)"
  apply clarsimp
  apply (rule conjI)
   apply (force simp: c_def)
  apply (force simp: S1_def S2_def S3_def S4_def S5_def S6_def intro!: S_lemma [temp_use])
  done

lemma Step1_4_7: "\<turnstile> unchanged (e p, c p, r p, m p, rmhist!p)
         \<longrightarrow> unchanged (rtrner memCh!p, resbar rmhist!p, S1 rmhist p, S2 rmhist p,
                        S3 rmhist p, S4 rmhist p, S5 rmhist p, S6 rmhist p)"
  apply (rule actionI)
  apply (unfold action_rews)
  apply (rule impI)
  apply (frule Step1_4_7H [temp_use])
  apply (auto simp: e_def c_def r_def m_def rtrner_def resbar_def)
  done

(* Frequently needed abbreviation: distinguish between idling and non-idling
   steps of the implementation, and try to solve the idling case by simplification
*)
ML \<open>
fun split_idle_tac ctxt =
  SELECT_GOAL
   (TRY (resolve_tac ctxt @{thms actionI} 1) THEN
    Induct_Tacs.case_tac ctxt "(s,t) \<Turnstile> unchanged (e p, c p, r p, m p, rmhist!p)" [] NONE 1 THEN
    rewrite_goals_tac ctxt @{thms action_rews} THEN
    forward_tac ctxt [temp_use ctxt @{thm Step1_4_7}] 1 THEN
    asm_full_simp_tac ctxt 1);
\<close>

method_setup split_idle = \<open>
  Method.sections (Simplifier.simp_modifiers @ Splitter.split_modifiers)
    >> (K (SIMPLE_METHOD' o split_idle_tac))
\<close>

(* ----------------------------------------------------------------------
   Combine steps 1.2 and 1.4 to prove that the implementation satisfies
   the specification's next-state relation.
*)

(* Steps that leave all variables unchanged are safe, so I may assume
   that some variable changes in the proof that a step is safe. *)
lemma unchanged_safe: "\<turnstile> (\<not>unchanged (e p, c p, r p, m p, rmhist!p)
             \<longrightarrow> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p))
         \<longrightarrow> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  apply (split_idle simp: square_def)
  apply force
  done
(* turn into (unsafe, looping!) introduction rule *)
lemmas unchanged_safeI = impI [THEN unchanged_safe [action_use]]

lemma S1safe: "\<turnstile> $S1 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  apply clarsimp
  apply (rule unchanged_safeI)
  apply (rule idle_squareI)
  apply (auto dest!: Step1_2_1 [temp_use] Step1_4_1 [temp_use])
  done

lemma S2safe: "\<turnstile> $S2 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  apply clarsimp
  apply (rule unchanged_safeI)
  apply (rule idle_squareI)
  apply (auto dest!: Step1_2_2 [temp_use] Step1_4_2 [temp_use])
  done

lemma S3safe: "\<turnstile> $S3 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  apply clarsimp
  apply (rule unchanged_safeI)
  apply (auto dest!: Step1_2_3 [temp_use])
  apply (auto simp: square_def UNext_def dest!: Step1_4_3a [temp_use] Step1_4_3b [temp_use])
  done

lemma S4safe: "\<turnstile> $S4 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<and> (\<forall>l. $(MemInv mm l))
         \<longrightarrow> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  apply clarsimp
  apply (rule unchanged_safeI)
  apply (auto dest!: Step1_2_4 [temp_use])
     apply (auto simp: square_def UNext_def RNext_def
       dest!: Step1_4_4a [temp_use] Step1_4_4b [temp_use] Step1_4_4c [temp_use])
  done

lemma S5safe: "\<turnstile> $S5 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  apply clarsimp
  apply (rule unchanged_safeI)
  apply (auto dest!: Step1_2_5 [temp_use])
  apply (auto simp: square_def UNext_def dest!: Step1_4_5a [temp_use] Step1_4_5b [temp_use])
  done

lemma S6safe: "\<turnstile> $S6 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> [UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  apply clarsimp
  apply (rule unchanged_safeI)
  apply (auto dest!: Step1_2_6 [temp_use])
    apply (auto simp: square_def UNext_def RNext_def
      dest!: Step1_4_6a [temp_use] Step1_4_6b [temp_use])
  done

(* ----------------------------------------------------------------------
   Step 1.5: Temporal refinement proof, based on previous steps.
*)

section "The liveness part"

(* Liveness assertions for the different implementation states, based on the
   fairness conditions. Prove subgoals of WF1 / SF1 rules as separate lemmas
   for readability. Reuse action proofs from safety part.
*)

(* ------------------------------ State S1 ------------------------------ *)

lemma S1_successors: "\<turnstile> $S1 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> (S1 rmhist p)$ \<or> (S2 rmhist p)$"
  apply split_idle
  apply (auto dest!: Step1_2_1 [temp_use])
  done

(* Show that the implementation can satisfy the high-level fairness requirements
   by entering the state S1 infinitely often.
*)

lemma S1_RNextdisabled: "\<turnstile> S1 rmhist p \<longrightarrow>
         \<not>Enabled (<RNext memCh mm (resbar rmhist) p>_(rtrner memCh!p, resbar rmhist!p))"
  apply (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm angle_def},
    @{thm S_def}, @{thm S1_def}]) [notI] [@{thm enabledE}, temp_elim \<^context> @{thm Memoryidle}] 1\<close>)
  apply force
  done

lemma S1_Returndisabled: "\<turnstile> S1 rmhist p \<longrightarrow>
         \<not>Enabled (<MemReturn memCh (resbar rmhist) p>_(rtrner memCh!p, resbar rmhist!p))"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm angle_def}, @{thm MemReturn_def},
    @{thm AReturn_def}, @{thm S_def}, @{thm S1_def}]) [notI] [@{thm enabledE}] 1\<close>)

lemma RNext_fair: "\<turnstile> \<box>\<diamond>S1 rmhist p
         \<longrightarrow> WF(RNext memCh mm (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
  by (auto simp: WF_alt [try_rewrite] intro!: S1_RNextdisabled [temp_use]
    elim!: STL4E [temp_use] DmdImplE [temp_use])

lemma Return_fair: "\<turnstile> \<box>\<diamond>S1 rmhist p
         \<longrightarrow> WF(MemReturn memCh (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
  by (auto simp: WF_alt [try_rewrite]
    intro!: S1_Returndisabled [temp_use] elim!: STL4E [temp_use] DmdImplE [temp_use])

(* ------------------------------ State S2 ------------------------------ *)

lemma S2_successors: "\<turnstile> $S2 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> (S2 rmhist p)$ \<or> (S3 rmhist p)$"
  apply split_idle
  apply (auto dest!: Step1_2_2 [temp_use])
  done

lemma S2MClkFwd_successors: "\<turnstile> ($S2 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p))
         \<and> <MClkFwd memCh crCh cst p>_(c p)
         \<longrightarrow> (S3 rmhist p)$"
  by (auto simp: angle_def dest!: Step1_2_2 [temp_use])

lemma S2MClkFwd_enabled: "\<turnstile> $S2 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> $Enabled (<MClkFwd memCh crCh cst p>_(c p))"
  apply (auto simp: c_def intro!: MClkFwd_ch_enabled [temp_use] MClkFwd_enabled [temp_use])
     apply (cut_tac MI_base)
     apply (blast dest: base_pair)
    apply (simp_all add: S_def S2_def)
  done

lemma S2_live: "\<turnstile> \<box>(ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p))
         \<and> WF(MClkFwd memCh crCh cst p)_(c p)
         \<longrightarrow> (S2 rmhist p \<leadsto> S3 rmhist p)"
  by (rule WF1 S2_successors S2MClkFwd_successors S2MClkFwd_enabled)+

(* ------------------------------ State S3 ------------------------------ *)

lemma S3_successors: "\<turnstile> $S3 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> (S3 rmhist p)$ \<or> (S4 rmhist p \<or> S6 rmhist p)$"
  apply split_idle
  apply (auto dest!: Step1_2_3 [temp_use])
  done

lemma S3RPC_successors: "\<turnstile> ($S3 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p))
         \<and> <RPCNext crCh rmCh rst p>_(r p)
         \<longrightarrow> (S4 rmhist p \<or> S6 rmhist p)$"
  apply (auto simp: angle_def dest!: Step1_2_3 [temp_use])
  done

lemma S3RPC_enabled: "\<turnstile> $S3 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> $Enabled (<RPCNext crCh rmCh rst p>_(r p))"
  apply (auto simp: r_def intro!: RPCFail_Next_enabled [temp_use] RPCFail_enabled [temp_use])
    apply (cut_tac MI_base)
    apply (blast dest: base_pair)
   apply (simp_all add: S_def S3_def)
  done

lemma S3_live: "\<turnstile> \<box>(ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p))
         \<and> WF(RPCNext crCh rmCh rst p)_(r p)
         \<longrightarrow> (S3 rmhist p \<leadsto> S4 rmhist p \<or> S6 rmhist p)"
  by (rule WF1 S3_successors S3RPC_successors S3RPC_enabled)+

(* ------------- State S4 -------------------------------------------------- *)

lemma S4_successors: "\<turnstile> $S4 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
        \<and> (\<forall>l. $MemInv mm l)
        \<longrightarrow> (S4 rmhist p)$ \<or> (S5 rmhist p)$"
  apply split_idle
  apply (auto dest!: Step1_2_4 [temp_use])
  done

(* --------- State S4a: S4 /\ (ires p = NotAResult) ------------------------ *)

lemma S4a_successors: "\<turnstile> $(S4 rmhist p \<and> ires!p = #NotAResult)
         \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p,rmhist!p) \<and> (\<forall>l. $MemInv mm l)
         \<longrightarrow> (S4 rmhist p \<and> ires!p = #NotAResult)$
             \<or> ((S4 rmhist p \<and> ires!p \<noteq> #NotAResult) \<or> S5 rmhist p)$"
  apply split_idle
  apply (auto dest!: Step1_2_4 [temp_use])
  done

lemma S4aRNext_successors: "\<turnstile> ($(S4 rmhist p \<and> ires!p = #NotAResult)
         \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p,rmhist!p) \<and> (\<forall>l. $MemInv mm l))
         \<and> <RNext rmCh mm ires p>_(m p)
         \<longrightarrow> ((S4 rmhist p \<and> ires!p \<noteq> #NotAResult) \<or> S5 rmhist p)$"
  by (auto simp: angle_def
    dest!: Step1_2_4 [temp_use] ReadResult [temp_use] WriteResult [temp_use])

lemma S4aRNext_enabled: "\<turnstile> $(S4 rmhist p \<and> ires!p = #NotAResult)
         \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p) \<and> (\<forall>l. $MemInv mm l)
         \<longrightarrow> $Enabled (<RNext rmCh mm ires p>_(m p))"
  apply (auto simp: m_def intro!: RNext_enabled [temp_use])
   apply (cut_tac MI_base)
   apply (blast dest: base_pair)
  apply (simp add: S_def S4_def)
  done

lemma S4a_live: "\<turnstile> \<box>(ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<and> (\<forall>l. $MemInv mm l)) \<and> WF(RNext rmCh mm ires p)_(m p)
         \<longrightarrow> (S4 rmhist p \<and> ires!p = #NotAResult
              \<leadsto> (S4 rmhist p \<and> ires!p \<noteq> #NotAResult) \<or> S5 rmhist p)"
  by (rule WF1 S4a_successors S4aRNext_successors S4aRNext_enabled)+

(* ---------- State S4b: S4 /\ (ires p # NotAResult) --------------------------- *)

lemma S4b_successors: "\<turnstile> $(S4 rmhist p \<and> ires!p \<noteq> #NotAResult)
         \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p) \<and> (\<forall>l. $MemInv mm l)
         \<longrightarrow> (S4 rmhist p \<and> ires!p \<noteq> #NotAResult)$ \<or> (S5 rmhist p)$"
  apply (split_idle simp: m_def)
  apply (auto dest!: WriteResult [temp_use] Step1_2_4 [temp_use] ReadResult [temp_use])
  done

lemma S4bReturn_successors: "\<turnstile> ($(S4 rmhist p \<and> ires!p \<noteq> #NotAResult)
         \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<and> (\<forall>l. $MemInv mm l)) \<and> <MemReturn rmCh ires p>_(m p)
         \<longrightarrow> (S5 rmhist p)$"
  by (force simp: angle_def dest!: Step1_2_4 [temp_use] dest: ReturnNotReadWrite [temp_use])

lemma S4bReturn_enabled: "\<turnstile> $(S4 rmhist p \<and> ires!p \<noteq> #NotAResult)
         \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<and> (\<forall>l. $MemInv mm l)
         \<longrightarrow> $Enabled (<MemReturn rmCh ires p>_(m p))"
  apply (auto simp: m_def intro!: MemReturn_enabled [temp_use])
   apply (cut_tac MI_base)
   apply (blast dest: base_pair)
  apply (simp add: S_def S4_def)
  done

lemma S4b_live: "\<turnstile> \<box>(ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p) \<and> (\<forall>l. $MemInv mm l))
         \<and> WF(MemReturn rmCh ires p)_(m p)
         \<longrightarrow> (S4 rmhist p \<and> ires!p \<noteq> #NotAResult \<leadsto> S5 rmhist p)"
  by (rule WF1 S4b_successors S4bReturn_successors S4bReturn_enabled)+

(* ------------------------------ State S5 ------------------------------ *)

lemma S5_successors: "\<turnstile> $S5 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> (S5 rmhist p)$ \<or> (S6 rmhist p)$"
  apply split_idle
  apply (auto dest!: Step1_2_5 [temp_use])
  done

lemma S5RPC_successors: "\<turnstile> ($S5 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p))
         \<and> <RPCNext crCh rmCh rst p>_(r p)
         \<longrightarrow> (S6 rmhist p)$"
  by (auto simp: angle_def dest!: Step1_2_5 [temp_use])

lemma S5RPC_enabled: "\<turnstile> $S5 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> $Enabled (<RPCNext crCh rmCh rst p>_(r p))"
  apply (auto simp: r_def intro!: RPCFail_Next_enabled [temp_use] RPCFail_enabled [temp_use])
    apply (cut_tac MI_base)
    apply (blast dest: base_pair)
   apply (simp_all add: S_def S5_def)
  done

lemma S5_live: "\<turnstile> \<box>(ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p))
         \<and> WF(RPCNext crCh rmCh rst p)_(r p)
         \<longrightarrow> (S5 rmhist p \<leadsto> S6 rmhist p)"
  by (rule WF1 S5_successors S5RPC_successors S5RPC_enabled)+

(* ------------------------------ State S6 ------------------------------ *)

lemma S6_successors: "\<turnstile> $S6 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p)
         \<longrightarrow> (S1 rmhist p)$ \<or> (S3 rmhist p)$ \<or> (S6 rmhist p)$"
  apply split_idle
  apply (auto dest!: Step1_2_6 [temp_use])
  done

lemma S6MClkReply_successors:
  "\<turnstile> ($S6 rmhist p \<and> ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p))
         \<and> <MClkReply memCh crCh cst p>_(c p)
         \<longrightarrow> (S1 rmhist p)$"
  by (auto simp: angle_def dest!: Step1_2_6 [temp_use] MClkReplyNotRetry [temp_use])

lemma MClkReplyS6:
  "\<turnstile> $ImpInv rmhist p \<and> <MClkReply memCh crCh cst p>_(c p) \<longrightarrow> $S6 rmhist p"
  by (tactic \<open>action_simp_tac (\<^context> addsimps [@{thm angle_def},
    @{thm MClkReply_def}, @{thm AReturn_def}, @{thm ImpInv_def}, @{thm S_def},
    @{thm S1_def}, @{thm S2_def}, @{thm S3_def}, @{thm S4_def}, @{thm S5_def}]) [] [] 1\<close>)

lemma S6MClkReply_enabled: "\<turnstile> S6 rmhist p \<longrightarrow> Enabled (<MClkReply memCh crCh cst p>_(c p))"
  apply (auto simp: c_def intro!: MClkReply_enabled [temp_use])
     apply (cut_tac MI_base)
     apply (blast dest: base_pair)
    apply (tactic \<open>ALLGOALS (action_simp_tac (\<^context>
      addsimps [@{thm S_def}, @{thm S6_def}]) [] [])\<close>)
  done

lemma S6_live: "\<turnstile> \<box>(ImpNext p \<and> [HNext rmhist p]_(c p,r p,m p, rmhist!p) \<and> $(ImpInv rmhist p))
         \<and> SF(MClkReply memCh crCh cst p)_(c p) \<and> \<box>\<diamond>(S6 rmhist p)
         \<longrightarrow> \<box>\<diamond>(S1 rmhist p)"
  apply clarsimp
  apply (subgoal_tac "sigma \<Turnstile> \<box>\<diamond> (<MClkReply memCh crCh cst p>_ (c p))")
   apply (erule InfiniteEnsures)
    apply assumption
   apply (tactic \<open>action_simp_tac \<^context> []
     (map (temp_elim \<^context>) [@{thm MClkReplyS6}, @{thm S6MClkReply_successors}]) 1\<close>)
  apply (auto simp: SF_def)
  apply (erule contrapos_np)
  apply (auto intro!: S6MClkReply_enabled [temp_use] elim!: STL4E [temp_use] DmdImplE [temp_use])
  done

(* --------------- aggregate leadsto properties----------------------------- *)

lemma S5S6LeadstoS6: "sigma \<Turnstile> S5 rmhist p \<leadsto> S6 rmhist p
      \<Longrightarrow> sigma \<Turnstile> (S5 rmhist p \<or> S6 rmhist p) \<leadsto> S6 rmhist p"
  by (auto intro!: LatticeDisjunctionIntro [temp_use] LatticeReflexivity [temp_use])

lemma S4bS5S6LeadstoS6: "\<lbrakk> sigma \<Turnstile> S4 rmhist p \<and> ires!p \<noteq> #NotAResult \<leadsto> S5 rmhist p;
         sigma \<Turnstile> S5 rmhist p \<leadsto> S6 rmhist p \<rbrakk>
      \<Longrightarrow> sigma \<Turnstile> (S4 rmhist p \<and> ires!p \<noteq> #NotAResult) \<or> S5 rmhist p \<or> S6 rmhist p
                    \<leadsto> S6 rmhist p"
  by (auto intro!: LatticeDisjunctionIntro [temp_use]
    S5S6LeadstoS6 [temp_use] intro: LatticeTransitivity [temp_use])

lemma S4S5S6LeadstoS6: "\<lbrakk> sigma \<Turnstile> S4 rmhist p \<and> ires!p = #NotAResult
                  \<leadsto> (S4 rmhist p \<and> ires!p \<noteq> #NotAResult) \<or> S5 rmhist p;
         sigma \<Turnstile> S4 rmhist p \<and> ires!p \<noteq> #NotAResult \<leadsto> S5 rmhist p;
         sigma \<Turnstile> S5 rmhist p \<leadsto> S6 rmhist p \<rbrakk>
      \<Longrightarrow> sigma \<Turnstile> S4 rmhist p \<or> S5 rmhist p \<or> S6 rmhist p \<leadsto> S6 rmhist p"
  apply (subgoal_tac "sigma \<Turnstile> (S4 rmhist p \<and> ires!p = #NotAResult) \<or>
    (S4 rmhist p \<and> ires!p \<noteq> #NotAResult) \<or> S5 rmhist p \<or> S6 rmhist p \<leadsto> S6 rmhist p")
   apply (erule_tac G = "PRED ((S4 rmhist p \<and> ires!p = #NotAResult) \<or>
     (S4 rmhist p \<and> ires!p \<noteq> #NotAResult) \<or> S5 rmhist p \<or> S6 rmhist p)" in
     LatticeTransitivity [temp_use])
   apply (force simp: Init_defs intro!: ImplLeadsto_gen [temp_use] necT [temp_use])
  apply (rule LatticeDisjunctionIntro [temp_use])
   apply (erule LatticeTransitivity [temp_use])
   apply (erule LatticeTriangle2 [temp_use])
   apply assumption
  apply (auto intro!: S4bS5S6LeadstoS6 [temp_use])
  done

lemma S3S4S5S6LeadstoS6: "\<lbrakk> sigma \<Turnstile> S3 rmhist p \<leadsto> S4 rmhist p \<or> S6 rmhist p;
         sigma \<Turnstile> S4 rmhist p \<and> ires!p = #NotAResult
                  \<leadsto> (S4 rmhist p \<and> ires!p \<noteq> #NotAResult) \<or> S5 rmhist p;
         sigma \<Turnstile> S4 rmhist p \<and> ires!p \<noteq> #NotAResult \<leadsto> S5 rmhist p;
         sigma \<Turnstile> S5 rmhist p \<leadsto> S6 rmhist p \<rbrakk>
      \<Longrightarrow> sigma \<Turnstile> S3 rmhist p \<or> S4 rmhist p \<or> S5 rmhist p \<or> S6 rmhist p \<leadsto> S6 rmhist p"
  apply (rule LatticeDisjunctionIntro [temp_use])
   apply (erule LatticeTriangle2 [temp_use])
   apply (rule S4S5S6LeadstoS6 [THEN LatticeTransitivity [temp_use]])
      apply (auto intro!: S4S5S6LeadstoS6 [temp_use] necT [temp_use]
        intro: ImplLeadsto_gen [temp_use] simp: Init_defs)
  done

lemma S2S3S4S5S6LeadstoS6: "\<lbrakk> sigma \<Turnstile> S2 rmhist p \<leadsto> S3 rmhist p;
         sigma \<Turnstile> S3 rmhist p \<leadsto> S4 rmhist p \<or> S6 rmhist p;
         sigma \<Turnstile> S4 rmhist p \<and> ires!p = #NotAResult
                  \<leadsto> S4 rmhist p \<and> ires!p \<noteq> #NotAResult \<or> S5 rmhist p;
         sigma \<Turnstile> S4 rmhist p \<and> ires!p \<noteq> #NotAResult \<leadsto> S5 rmhist p;
         sigma \<Turnstile> S5 rmhist p \<leadsto> S6 rmhist p \<rbrakk>
      \<Longrightarrow> sigma \<Turnstile> S2 rmhist p \<or> S3 rmhist p \<or> S4 rmhist p \<or> S5 rmhist p \<or> S6 rmhist p
                   \<leadsto> S6 rmhist p"
  apply (rule LatticeDisjunctionIntro [temp_use])
   apply (rule LatticeTransitivity [temp_use])
    prefer 2 apply assumption
   apply (rule S3S4S5S6LeadstoS6 [THEN LatticeTransitivity [temp_use]])
       apply (auto intro!: S3S4S5S6LeadstoS6 [temp_use] necT [temp_use]
         intro: ImplLeadsto_gen [temp_use] simp: Init_defs)
  done

lemma NotS1LeadstoS6: "\<lbrakk> sigma \<Turnstile> \<box>ImpInv rmhist p;
         sigma \<Turnstile> S2 rmhist p \<leadsto> S3 rmhist p;
         sigma \<Turnstile> S3 rmhist p \<leadsto> S4 rmhist p \<or> S6 rmhist p;
         sigma \<Turnstile> S4 rmhist p \<and> ires!p = #NotAResult
                  \<leadsto> S4 rmhist p \<and> ires!p \<noteq> #NotAResult \<or> S5 rmhist p;
         sigma \<Turnstile> S4 rmhist p \<and> ires!p \<noteq> #NotAResult \<leadsto> S5 rmhist p;
         sigma \<Turnstile> S5 rmhist p \<leadsto> S6 rmhist p \<rbrakk>
      \<Longrightarrow> sigma \<Turnstile> \<not>S1 rmhist p \<leadsto> S6 rmhist p"
  apply (rule S2S3S4S5S6LeadstoS6 [THEN LatticeTransitivity [temp_use]])
       apply assumption+
  apply (erule INV_leadsto [temp_use])
  apply (rule ImplLeadsto_gen [temp_use])
  apply (rule necT [temp_use])
  apply (auto simp: ImpInv_def Init_defs intro!: necT [temp_use])
  done

lemma S1Infinite: "\<lbrakk> sigma \<Turnstile> \<not>S1 rmhist p \<leadsto> S6 rmhist p;
         sigma \<Turnstile> \<box>\<diamond>S6 rmhist p \<longrightarrow> \<box>\<diamond>S1 rmhist p \<rbrakk>
      \<Longrightarrow> sigma \<Turnstile> \<box>\<diamond>S1 rmhist p"
  apply (rule classical)
  apply (tactic \<open>asm_lr_simp_tac (\<^context> addsimps
    [temp_use \<^context> @{thm NotBox}, temp_rewrite \<^context> @{thm NotDmd}]) 1\<close>)
  apply (auto elim!: leadsto_infinite [temp_use] mp dest!: DBImplBD [temp_use])
  done

section "Refinement proof (step 1.5)"

(* Prove invariants of the implementation:
   a. memory invariant
   b. "implementation invariant": always in states S1,...,S6
*)
lemma Step1_5_1a: "\<turnstile> IPImp p \<longrightarrow> (\<forall>l. \<box>$MemInv mm l)"
  by (auto simp: IPImp_def box_stp_act [temp_use] intro!: MemoryInvariantAll [temp_use])

lemma Step1_5_1b: "\<turnstile> Init(ImpInit p \<and> HInit rmhist p) \<and> \<box>(ImpNext p)
         \<and> \<box>[HNext rmhist p]_(c p, r p, m p, rmhist!p) \<and> \<box>(\<forall>l. $MemInv mm l)
         \<longrightarrow> \<box>ImpInv rmhist p"
  apply invariant
   apply (auto simp: Init_def ImpInv_def box_stp_act [temp_use]
     dest!: Step1_1 [temp_use] dest: S1_successors [temp_use] S2_successors [temp_use]
     S3_successors [temp_use] S4_successors [temp_use] S5_successors [temp_use]
     S6_successors [temp_use])
  done

(*** Initialization ***)
lemma Step1_5_2a: "\<turnstile> Init(ImpInit p \<and> HInit rmhist p) \<longrightarrow> Init(PInit (resbar rmhist) p)"
  by (auto simp: Init_def intro!: Step1_1 [temp_use] Step1_3  [temp_use])

(*** step simulation ***)
lemma Step1_5_2b: "\<turnstile> \<box>(ImpNext p \<and> [HNext rmhist p]_(c p, r p, m p, rmhist!p)
         \<and> $ImpInv rmhist p \<and> (\<forall>l. $MemInv mm l))
         \<longrightarrow> \<box>[UNext memCh mm (resbar rmhist) p]_(rtrner memCh!p, resbar rmhist!p)"
  by (auto simp: ImpInv_def elim!: STL4E [temp_use]
    dest!: S1safe [temp_use] S2safe [temp_use] S3safe [temp_use] S4safe [temp_use]
    S5safe [temp_use] S6safe [temp_use])

(*** Liveness ***)
lemma GoodImpl: "\<turnstile> IPImp p \<and> HistP rmhist p
         \<longrightarrow>   Init(ImpInit p \<and> HInit rmhist p)
             \<and> \<box>(ImpNext p \<and> [HNext rmhist p]_(c p, r p, m p, rmhist!p))
             \<and> \<box>(\<forall>l. $MemInv mm l) \<and> \<box>($ImpInv rmhist p)
             \<and> ImpLive p"
  apply clarsimp
    apply (subgoal_tac "sigma \<Turnstile> Init (ImpInit p \<and> HInit rmhist p) \<and> \<box> (ImpNext p) \<and>
      \<box>[HNext rmhist p]_ (c p, r p, m p, rmhist!p) \<and> \<box> (\<forall>l. $MemInv mm l)")
   apply (auto simp: split_box_conj [try_rewrite] box_stp_act [try_rewrite]
       dest!: Step1_5_1b [temp_use])
      apply (force simp: IPImp_def MClkIPSpec_def RPCIPSpec_def RPSpec_def
        ImpLive_def c_def r_def m_def)
      apply (force simp: IPImp_def MClkIPSpec_def RPCIPSpec_def RPSpec_def
        HistP_def Init_def ImpInit_def)
    apply (force simp: IPImp_def MClkIPSpec_def RPCIPSpec_def RPSpec_def
      ImpNext_def c_def r_def m_def split_box_conj [temp_use])
   apply (force simp: HistP_def)
  apply (force simp: allT [temp_use] dest!: Step1_5_1a [temp_use])
  done

(* The implementation is infinitely often in state S1... *)
lemma Step1_5_3a: "\<turnstile> \<box>(ImpNext p \<and> [HNext rmhist p]_(c p, r p, m p, rmhist!p))
         \<and> \<box>(\<forall>l. $MemInv mm l)
         \<and> \<box>($ImpInv rmhist p) \<and> ImpLive p
         \<longrightarrow> \<box>\<diamond>S1 rmhist p"
  apply (clarsimp simp: ImpLive_def)
  apply (rule S1Infinite)
   apply (force simp: split_box_conj [try_rewrite] box_stp_act [try_rewrite]
     intro!: NotS1LeadstoS6 [temp_use] S2_live [temp_use] S3_live [temp_use]
     S4a_live [temp_use] S4b_live [temp_use] S5_live [temp_use])
  apply (auto simp: split_box_conj [temp_use] intro!: S6_live [temp_use])
  done

(* ... and therefore satisfies the fairness requirements of the specification *)
lemma Step1_5_3b: "\<turnstile> \<box>(ImpNext p \<and> [HNext rmhist p]_(c p, r p, m p, rmhist!p))
         \<and> \<box>(\<forall>l. $MemInv mm l) \<and> \<box>($ImpInv rmhist p) \<and> ImpLive p
         \<longrightarrow> WF(RNext memCh mm (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
  by (auto intro!: RNext_fair [temp_use] Step1_5_3a [temp_use])

lemma Step1_5_3c: "\<turnstile> \<box>(ImpNext p \<and> [HNext rmhist p]_(c p, r p, m p, rmhist!p))
         \<and> \<box>(\<forall>l. $MemInv mm l) \<and> \<box>($ImpInv rmhist p) \<and> ImpLive p
         \<longrightarrow> WF(MemReturn memCh (resbar rmhist) p)_(rtrner memCh!p, resbar rmhist!p)"
  by (auto intro!: Return_fair [temp_use] Step1_5_3a [temp_use])

(* QED step of step 1 *)
lemma Step1: "\<turnstile> IPImp p \<and> HistP rmhist p \<longrightarrow> UPSpec memCh mm (resbar rmhist) p"
  by (auto simp: UPSpec_def split_box_conj [temp_use]
    dest!: GoodImpl [temp_use] intro!: Step1_5_2a [temp_use] Step1_5_2b [temp_use]
    Step1_5_3b [temp_use] Step1_5_3c [temp_use])

(* ------------------------------ Step 2 ------------------------------ *)
section "Step 2"

lemma Step2_2a: "\<turnstile> Write rmCh mm ires p l \<and> ImpNext p
         \<and> [HNext rmhist p]_(c p, r p, m p, rmhist!p)
         \<and> $ImpInv rmhist p
         \<longrightarrow> (S4 rmhist p)$ \<and> unchanged (e p, c p, r p, rmhist!p)"
  apply clarsimp
  apply (drule WriteS4 [action_use])
   apply assumption
  apply split_idle
  apply (auto simp: ImpNext_def dest!: S4EnvUnch [temp_use] S4ClerkUnch [temp_use]
    S4RPCUnch [temp_use])
     apply (auto simp: square_def dest: S4Write [temp_use])
  done

lemma Step2_2: "\<turnstile>   (\<forall>p. ImpNext p)
         \<and> (\<forall>p. [HNext rmhist p]_(c p, r p, m p, rmhist!p))
         \<and> (\<forall>p. $ImpInv rmhist p)
         \<and> [\<exists>q. Write rmCh mm ires q l]_(mm!l)
         \<longrightarrow> [\<exists>q. Write memCh mm (resbar rmhist) q l]_(mm!l)"
  apply (auto intro!: squareCI elim!: squareE)
  apply (assumption | rule exI Step1_4_4b [action_use])+
    apply (force intro!: WriteS4 [temp_use])
   apply (auto dest!: Step2_2a [temp_use])
  done

lemma Step2_lemma: "\<turnstile> \<box>(  (\<forall>p. ImpNext p)
            \<and> (\<forall>p. [HNext rmhist p]_(c p, r p, m p, rmhist!p))
            \<and> (\<forall>p. $ImpInv rmhist p)
            \<and> [\<exists>q. Write rmCh mm ires q l]_(mm!l))
         \<longrightarrow> \<box>[\<exists>q. Write memCh mm (resbar rmhist) q l]_(mm!l)"
  by (force elim!: STL4E [temp_use] dest!: Step2_2 [temp_use])

lemma Step2: "\<turnstile> #l \<in> #MemLoc \<and> (\<forall>p. IPImp p \<and> HistP rmhist p)
         \<longrightarrow> MSpec memCh mm (resbar rmhist) l"
  apply (auto simp: MSpec_def)
   apply (force simp: IPImp_def MSpec_def)
  apply (auto intro!: Step2_lemma [temp_use] simp: split_box_conj [temp_use] all_box [temp_use])
     prefer 4
     apply (force simp: IPImp_def MSpec_def)
    apply (auto simp: split_box_conj [temp_use] elim!: allE dest!: GoodImpl [temp_use])
  done

(* ----------------------------- Main theorem --------------------------------- *)
section "Memory implementation"

(* The combination of a legal caller, the memory clerk, the RPC component,
   and a reliable memory implement the unreliable memory.
*)

(* Implementation of internal specification by combination of implementation
   and history variable with explicit refinement mapping
*)
lemma Impl_IUSpec: "\<turnstile> Implementation \<and> Hist rmhist \<longrightarrow> IUSpec memCh mm (resbar rmhist)"
  by (auto simp: IUSpec_def Implementation_def IPImp_def MClkISpec_def
    RPCISpec_def IRSpec_def Hist_def intro!: Step1 [temp_use] Step2 [temp_use])

(* The main theorem: introduce hiding and eliminate history variable. *)
lemma Implementation: "\<turnstile> Implementation \<longrightarrow> USpec memCh"
  apply clarsimp
  apply (frule History [temp_use])
  apply (auto simp: USpec_def intro: eexI [temp_use] Impl_IUSpec [temp_use]
    MI_base [temp_use] elim!: eexE)
  done

end


(*  Title:      HOL/Auth/n_mutualExSimp.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_mutualExSimp Protocol Case Study*}

theory n_mutualExSimp imports n_mutualExSimp_lemma_invs_on_rules n_mutualExSimp_on_inis
begin
lemma main:
assumes a1: "s \<in> reachableSet {andList (allInitSpecs N)} (rules N)"
and a2: "0 < N"
shows "\<forall> f. f \<in> (invariants N) --> formEval f s"
proof (rule consistentLemma)
show "consistent (invariants N) {andList (allInitSpecs N)} (rules N)"
proof (cut_tac a1, unfold consistent_def, rule conjI)
show "\<forall> f ini s. f \<in> (invariants N) --> ini \<in> {andList (allInitSpecs N)} --> formEval ini s --> formEval f s"
proof ((rule allI)+, (rule impI)+)
  fix f ini s
  assume b1: "f \<in> (invariants N)" and b2: "ini \<in> {andList (allInitSpecs N)}" and b3: "formEval ini s"
  have b4: "formEval (andList (allInitSpecs N)) s"
  apply (cut_tac b2 b3, simp) done
  show "formEval f s"
  apply (rule on_inis, cut_tac b1, assumption, cut_tac b2, assumption, cut_tac b3, assumption) done
qed
next show "\<forall> f r s. f \<in> invariants N --> r \<in> rules N --> invHoldForRule s f r (invariants N)"
proof ((rule allI)+, (rule impI)+)
  fix f r s
  assume b1: "f \<in> invariants N" and b2: "r \<in> rules N"
  show "invHoldForRule s f r (invariants N)"
  apply (rule invs_on_rules, cut_tac b1, assumption, cut_tac b2, assumption) done
qed
qed
next show "s \<in> reachableSet {andList (allInitSpecs N)} (rules N)"
  apply (metis a1) done
qed
end


section \<open>Nested List Assertion\<close>
theory LLVM_DS_List_Assn
imports "../vcg/LLVM_VCG_Main"
begin
  (* TODO: Improve handling of pure assertions.
    Dirty hacks like for pure list-assn shouldn't be necessary!
  *)

  (* TODO: Move *)
  lemma gen_drule:
    assumes "P\<turnstile>Q"
    assumes "FRAME A P F"
    assumes "Q**F\<turnstile>B"
    shows "A\<turnstile>B"
    using assms unfolding FRAME_def
    using sep_rule(1) sep_rule(2) by blast

  (* TODO: Move *)
  lemma pure_part_set_imgD[vcg_prep_ext_rules]:
    shows "pure_part (sep_set_img S P) \<longrightarrow> (\<forall>x\<in>S. pure_part (P x))"
  proof (cases "finite S")
    case True thus ?thesis
      by (induction S) (auto dest: pure_part_split_conj)
  next
    case False then show ?thesis by simp
  qed

  subsection \<open>Tags\<close>
  text \<open>Ghost instructions to guide the VCG and Frame Inference\<close>
  lemma entails_is_noop_htriple: "(A \<turnstile> B) \<Longrightarrow> llvm_htriple A (return x) (\<lambda>_. B)"
    apply (auto simp: htriple_def wp_return)
    by (metis (mono_tags, hide_lams) conj_entails_mono empty_ent_GC entails_def entails_lift_extract_simps(2) sep_conj_empty)

  lemma tag_op_ruleI:
    assumes "tag_op = return x"
    assumes "A\<turnstile>B"
    shows "llvm_htriple A tag_op (\<lambda>_. B)"
    using entails_is_noop_htriple assms by metis

  text \<open>Assertion to be matched with anything.
    To obtain abstract from concrete variable.\<close>
  definition "tag_assn \<equiv> mk_pure_assn (\<lambda>_ _. True)"
  lemma tag_assn_pure[is_pure_rule]: "is_pure (tag_assn)" unfolding tag_assn_def by auto

  lemma tag_assnI[fri_rules]: "PRECOND (SOLVE_ASM (\<flat>\<^sub>pA a c)) \<Longrightarrow> \<box> \<turnstile> \<upharpoonleft>\<^sub>ptag_assn a c"
    by (auto simp: tag_assn_def sep_algebra_simps)

  (* TODO: Move *)
  lemma split_pure_assn: "is_pure A \<Longrightarrow> \<upharpoonleft>A a c \<turnstile> \<upharpoonleft>A a c ** \<upharpoonleft>A a c"
    by (smt entails_eq_iff entails_pureI extract_pure_assn pure_part_pureD pure_true_conv sep.add.right_neutral)

  definition tag_split_pure :: "'b::llvm_rep \<Rightarrow> unit llM"
    where "tag_split_pure x = return ()"

  lemma tag_split_pure_rl[vcg_rules]:
    shows "llvm_htriple
      (\<up>(is_pure A) ** \<upharpoonleft>A a c)
      (tag_split_pure c)
      (\<lambda>_. \<upharpoonleft>A a c ** \<upharpoonleft>A a c)"
    supply [vcg_rules] = tag_op_ruleI[OF tag_split_pure_def[where x=c] split_pure_assn[of A a c]]
    by vcg

  lemma bury_pure_assn: "is_pure A \<Longrightarrow> \<upharpoonleft>A a c \<turnstile> \<box>"
    by (smt entails_eq_iff entails_pureI extract_pure_assn pure_part_pureD pure_true_conv)

  lemma bury_pure_assn': "\<upharpoonleft>\<^sub>pA a c \<turnstile> \<box>"
    by (simp add: dr_assn_pure_prefix_def entails_lift_extract_simps(1))

  definition tag_bury_pure :: "'b::llvm_rep \<Rightarrow> unit llM"
    where "tag_bury_pure x = return ()"

  lemma tag_bury_pure_rl[vcg_rules]:
    shows "llvm_htriple
      (\<up>(is_pure A) ** \<upharpoonleft>A a c)
      (tag_bury_pure c)
      (\<lambda>_. \<box>)"
    supply [vcg_rules] = tag_op_ruleI[OF tag_bury_pure_def[where x=c] bury_pure_assn[of A a c]]
    by vcg

  subsection \<open>Map of Valid Indexes in List\<close>
  (* TODO: DUP in Array_of_Array_List. *)
  definition "idxe_map l i \<equiv> if i<length l then Some (l!i) else None"

  lemma idxe_map_empty[simp]: "idxe_map [] = Map.empty" unfolding idxe_map_def by auto

  lemma idxe_map_dom[simp]: "dom (idxe_map l) = {0..<length l}" unfolding idxe_map_def by (auto split: if_splits)

  lemma le_idxe_map_updI: "i<length l \<Longrightarrow> m \<subseteq>\<^sub>m idxe_map l \<Longrightarrow> m(i\<mapsto>l!i) \<subseteq>\<^sub>m idxe_map l"
    unfolding idxe_map_def map_le_def by (auto split: if_splits)

  lemma le_idxe_map_delD: "m \<subseteq>\<^sub>m idxe_map l \<Longrightarrow> m(i:=None) \<subseteq>\<^sub>m idxe_map (l[i:=x])"
    unfolding idxe_map_def map_le_def by (auto split: if_splits)

  lemma le_idxe_map_delD': "m \<subseteq>\<^sub>m idxe_map l \<Longrightarrow> m(i:=None) \<subseteq>\<^sub>m idxe_map l"
    unfolding idxe_map_def map_le_def by (auto split: if_splits)

  lemma le_idxe_mapD: "m \<subseteq>\<^sub>m idxe_map l \<Longrightarrow> m i = Some xi \<Longrightarrow> l!i = xi"
    unfolding idxe_map_def map_le_def
    apply (clarsimp split: if_splits)
    by (metis domI domIff option.inject)

  lemma le_idxe_map_lenD: "m \<subseteq>\<^sub>m idxe_map l \<Longrightarrow> m i = Some xi \<Longrightarrow> i < length l"
    unfolding idxe_map_def map_le_def
    apply (clarsimp split: if_splits)
    by (metis domI domIff)

  lemma le_idxe_map_append1I: "A\<subseteq>\<^sub>midxe_map (xs@[y]) \<Longrightarrow> A(length xs := None)\<subseteq>\<^sub>midxe_map (xs)"
    by (auto simp: map_le_def idxe_map_def split: if_splits)

  lemma le_idxe_map_append2I: "A\<subseteq>\<^sub>midxe_map xs \<Longrightarrow> A\<subseteq>\<^sub>midxe_map (xs@ys)"
    by (auto simp: map_le_def idxe_map_def split: if_splits)

  subsection \<open>Nested List Assertion\<close>

  definition "list_assn A R \<equiv> mk_assn (\<lambda>xs ys.
     \<up>(length xs=length ys)
  ** \<up>(R \<subseteq>\<^sub>m idxe_map ys)
  ** (\<Union>*i\<in>{0..<length ys} - dom R. \<upharpoonleft>A (xs!i) (ys!i)))"

  lemma list_assn_pure_partD[vcg_prep_ext_rules]:
    "pure_part (\<upharpoonleft>(list_assn A R) xs ys)
      \<Longrightarrow> length xs = length ys \<and> R \<subseteq>\<^sub>m idxe_map ys \<and> (\<forall>x\<in>{0..<length ys} - dom R. pure_part (\<upharpoonleft>A (xs ! x) (ys ! x)))"
    unfolding list_assn_def
    apply vcg_prepare_external by blast

  subsection \<open>Transformations\<close>

  subsubsection \<open>Initialization and Destruction\<close>
    text \<open>Initialization if there is a pure initial element\<close>
  lemma list_assn_init_pure:
    assumes "\<box> \<turnstile> \<upharpoonleft>A x xi"
    shows "\<box> \<turnstile> \<upharpoonleft>(list_assn A Map.empty) (replicate n x) (replicate n xi)"
  proof -
    have "\<box> \<turnstile> (\<Union>*xa\<in>{0..<n}. \<upharpoonleft>A x xi)"
      apply (induction n)
      subgoal by simp
      subgoal for n
        apply (simp add: atLeast0_lessThan_Suc)
        using conj_entails_mono[OF assms] by simp
      done

    thus ?thesis
      unfolding list_assn_def
      by (simp add: sep_algebra_simps)
  qed

  text \<open>Arbitrary initialization, no elements owned. Can be used to justify init-algorithm\<close>
  lemma list_assn_init_none:
    assumes "length xs = length ys"
    shows "\<box> \<turnstile> \<upharpoonleft>(list_assn A (idxe_map ys)) xs ys"
    using assms unfolding list_assn_def
    by (simp add: sep_algebra_simps)

  lemma list_assn_empty: "\<box> \<turnstile> \<upharpoonleft>(list_assn A Map.empty) [] []"
    unfolding list_assn_def
    by (auto simp: sep_algebra_simps)

  text \<open>Destruction if all elements have been extracted\<close>
  lemma list_assn_free_none:
    assumes "dom R \<supseteq> {0..<length ys}"
    shows "\<upharpoonleft>(list_assn A R) xs ys \<turnstile> \<box>"
    using assms unfolding list_assn_def
    by (auto simp: sep_algebra_simps entails_lift_extract_simps dest: map_le_implies_dom_le)

  subsubsection \<open>Extracting and Joining Elements\<close>

  lemma list_assn_extract_aux:
    assumes "i<length xs" "i\<notin>R"
    shows "sep_set_img ({0..<length xs} - R) P
        = (P i ** sep_set_img ({0..<length xs} - insert i R) P)"
  proof -
    from assms have 1: "{0..<length xs} - R = insert i ({0..<length xs} - insert i R)" by auto
    show ?thesis
      by (subst 1) auto
  qed

  lemma list_assn_extract:
    assumes "i<length xs" "R i = None"
    shows "\<upharpoonleft>(list_assn A R) xs ys \<turnstile> \<upharpoonleft>(list_assn A (R(i\<mapsto>ys!i))) xs ys ** \<upharpoonleft>A (xs!i) (ys!i)"
    using assms unfolding list_assn_def
    supply [simp] = le_idxe_map_updI list_assn_extract_aux ndomIff
    supply fri_red_img[fri_red_rules]
    apply (clarsimp simp: sep_algebra_simps entails_lift_extract_simps)
    apply (rule ENTAILSD)
    apply vcg
    done

  lemma list_assn_upd_aux:
    fixes I xs xsi
    defines "I \<equiv> {0..<length xsi}"
    assumes "i\<in>I" "i\<in>R" and [simp]: "length xsi = length xs"
    shows "(\<Union>*j\<in>I - (R - {i}). \<upharpoonleft>A (xs[i := x] ! j) (xsi[i := xi] ! j)) = (\<upharpoonleft>A x xi ** (\<Union>*j\<in>I - R. \<upharpoonleft>A (xs ! j) (xsi ! j)))"
  proof -
    from assms have 1: "I - (R - {i}) = insert i (I-R)" by auto
    from assms have [simplified,simp]: "i\<notin>I-R" by auto
    have [simp]: "i<length xs" using \<open>i\<in>I\<close> unfolding I_def by auto
    have [simp]: "j\<in>I-R \<Longrightarrow> i\<noteq>j" for j using \<open>i\<in>R\<close> by auto
    show ?thesis apply (subst 1) by simp
  qed

  lemma list_assn_update:
    assumes "R i \<noteq> None"
    shows "\<upharpoonleft>(list_assn A R) xs ys ** \<upharpoonleft>A x y \<turnstile> \<upharpoonleft>(list_assn A (R(i:=None))) (xs[i:=x]) (ys[i:=y])"
    using assms unfolding list_assn_def
    apply -
    apply (rule entails_pureI)

    supply [simp] = le_idxe_map_updI le_idxe_map_delD
    supply fri_red_img[fri_red_rules]
    apply (clarsimp simp: sep_algebra_simps entails_lift_extract_simps)
    apply (subst list_assn_upd_aux)
    subgoal by (metis domI idxe_map_dom map_leD)
    apply auto [2]
    apply (rule ENTAILSD)
    apply vcg
    done

  lemma list_assn_join:
    assumes "R i = Some y"
    assumes "x = xs!i"
    shows "\<upharpoonleft>(list_assn A R) xs ys ** \<upharpoonleft>A x y \<turnstile> \<upharpoonleft>(list_assn A (R(i:=None))) xs ys"
    apply (rule entails_pureI)
    apply (subst (asm) list_assn_def)
    apply (clarsimp simp: sep_algebra_simps dest!: pure_part_split_conj)
    apply (rule entails_trans[OF list_assn_update[where i=i]])
    using assms by (auto dest: le_idxe_mapD)

  lemma list_assn_join':
    assumes "R i = None"
    assumes "x = xs!i" "y=ys!i"
    shows "\<upharpoonleft>(list_assn A (R(i\<mapsto>ys!i))) xs ys ** \<upharpoonleft>A x y \<turnstile> \<upharpoonleft>(list_assn A R) xs ys"
    apply (sep_drule list_assn_join[where i=i])
    using assms by (auto simp: fun_upd_idem)

  subsubsection \<open>Push and Pop\<close>
  lemma list_assn_push_back:
    shows "(\<upharpoonleft>(list_assn A R) xs ys ** \<upharpoonleft>A x y) \<turnstile> (\<upharpoonleft>(list_assn A R) (xs@[x]) (ys@[y]))"
    unfolding list_assn_def
    apply (clarsimp simp: sep_algebra_simps atLeast0_lessThan_Suc entails_lift_extract_simps
      insert_Diff_if le_idxe_map_append2I; safe)
    apply (auto dest: le_idxe_map_lenD; fail)
    apply (rule ENTAILSD)
    supply [simp] = nth_append
    by vcg

  lemma list_assn_pop_back1:
    assumes "R (length xs - 1) \<noteq> None"
    shows "\<upharpoonleft>(list_assn A R) xs ys \<turnstile> \<upharpoonleft>(list_assn A (R(length xs-1 := None))) (butlast xs) (butlast ys)"
    using assms unfolding list_assn_def
    apply (rule_tac entails_pureI)
    apply (cases xs rule: rev_cases; cases ys rule: rev_cases)
    apply (clarsimp_all
      dest!: pure_part_split_conj
      simp: sep_algebra_simps atLeast0_lessThan_Suc domI set_minus_minus_disj_conv)
    apply (rule ENTAILSD)
    supply [simp] = le_idxe_map_append1I
    by vcg

  lemma list_assn_pop_back2:
    assumes "xs\<noteq>[]" "R (length xs - 1) = None"
    shows "(\<upharpoonleft>(list_assn A R) xs ys) \<turnstile> (\<upharpoonleft>(list_assn A R) (butlast xs) (butlast ys) ** \<upharpoonleft>A (last xs) (last ys))"
    apply (rule entails_pureI) using assms
    apply vcg_prepare_external
    apply (sep_drule list_assn_extract[where i="length xs - 1"])
    subgoal by (cases ys; simp)
    subgoal by simp
    apply (sep_drule list_assn_pop_back1)
    subgoal by auto
    by (cases ys rule: rev_cases; simp add: last_conv_nth fun_upd_idem)

  subsection \<open>Fri-Reduce Rules for List-Assertion\<close>
  lemma la_red_extract:
    "PRECOND (SOLVE_AUTO (R i = None \<and> i<length xs))
      \<Longrightarrow> is_sep_red (\<upharpoonleft>(list_assn A (R(i\<mapsto>ys!i))) xs ys) \<box> (\<upharpoonleft>(list_assn A R) xs ys) (\<upharpoonleft>A (xs!i) (ys!i))"
    apply (clarsimp simp: vcg_tag_defs)
    apply (rule is_sep_redI)
    apply (sep_drule list_assn_extract, assumption+)
    apply (erule gen_drule, fri)
    apply (rule ENTAILSD, fri)
    done

  lemma la_red_join:
    "PRECOND (SOLVE_AUTO (R i = None \<and> i<length xs \<and> x=xs!i \<and> y=ys!i))
      \<Longrightarrow> is_sep_red \<box> (\<upharpoonleft>(list_assn A (R(i\<mapsto>ys!i))) xs ys) (\<upharpoonleft>A x y) (\<upharpoonleft>(list_assn A R) xs ys)"
    apply (clarsimp simp: vcg_tag_defs)
    apply (rule is_sep_redI)
    apply (sep_rule list_assn_join')
    apply assumption+
    apply (erule gen_drule, fri)
    apply (rule ENTAILSD, fri)
    done

  subsection \<open>Tags for List-Assertion\<close>

  definition tag_la_upd :: "'b::llvm_rep \<Rightarrow> 'a word \<Rightarrow> 'd::llvm_rep \<Rightarrow> unit llM"
    where "tag_la_upd p i y = return ()"

  lemma tag_la_upd_rl[vcg_rules]:
    shows "llvm_htriple
      (\<upharpoonleft>tag_assn i ii ** \<upharpoonleft>AA ys p ** \<upharpoonleft>(list_assn A R) xs ys ** \<upharpoonleft>A x y ** \<up>(R i \<noteq> None))
      (tag_la_upd p ii y)
      (\<lambda>_. \<upharpoonleft>(list_assn A (R(i:=None))) (xs[i:=x]) (ys[i:=y]) ** \<upharpoonleft>AA ys p)"
    supply [vcg_rules] = tag_op_ruleI[OF tag_la_upd_def[where i=ii] list_assn_update[where i=i]]
    by vcg

  definition tag_la_join :: "'b::llvm_rep \<Rightarrow> 'a word \<Rightarrow> 'd::llvm_rep \<Rightarrow> unit llM"
    where "tag_la_join p i y = return ()"

  lemma tag_la_join_rl[vcg_rules]:
    shows "llvm_htriple
      (\<upharpoonleft>tag_assn i ii ** \<upharpoonleft>AA ys p ** \<upharpoonleft>(list_assn A R) xs ys ** \<upharpoonleft>A x y ** \<up>(R i = Some y \<and> x=xs!i))
      (tag_la_join p ii y)
      (\<lambda>_. \<upharpoonleft>(list_assn A (R(i:=None))) xs ys ** \<upharpoonleft>AA ys p)"
    supply [vcg_rules] = tag_op_ruleI[OF tag_la_join_def[where i=ii] list_assn_join[where i=i]]
    by vcg

  definition "tag_la_extract p i = return ()"

  (*
    TODO: We have to use tag-assn for pure (i), and variables (AA) for impure assertions:
      Otherwise, current frame-inference's pure extraction will not unify
      variable assertion with pure assertion! FIX THAT!
  *)

  lemma tag_la_extract_rl[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>tag_assn i ii ** \<upharpoonleft>AA ys p ** \<upharpoonleft>(list_assn A R) xs ys ** \<up>(R i = None \<and> i<length xs))
      (tag_la_extract p ii)
      (\<lambda>_. \<upharpoonleft>(list_assn A (R(i\<mapsto>ys!i))) xs ys ** \<upharpoonleft>A (xs!i) (ys!i) ** \<upharpoonleft>AA ys p ** \<up>(length xs = length ys))"
    supply [vcg_rules] = tag_op_ruleI[OF tag_la_extract_def[where i=ii] list_assn_extract[where i=i]]
    apply vcg
    done

  definition "tag_la_push_back p x = return ()"

  lemma tag_la_push_back_rl[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>AA ys p ** \<upharpoonleft>(list_assn A R) xs ys ** \<upharpoonleft>A x y)
      (tag_la_push_back p y)
      (\<lambda>_. \<upharpoonleft>(list_assn A R) (xs@[x]) (ys@[y]) ** \<upharpoonleft>AA ys p)"
    supply [vcg_rules] = tag_op_ruleI[OF tag_la_push_back_def[where p=p] list_assn_push_back]
    by vcg

  definition "tag_la_pop_back p = return ()"
  lemma tag_la_pop_back_rl[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>AA ys p ** \<upharpoonleft>(list_assn A R) xs ys ** \<up>(xs\<noteq>[] \<and> R (length xs-1) = None))
      (tag_la_pop_back p)
      (\<lambda>_. \<upharpoonleft>AA ys p ** \<upharpoonleft>(list_assn A R) (butlast xs) (butlast ys) ** \<upharpoonleft>A (last xs) (last ys) ** \<up>(xs\<noteq>[] \<and> ys\<noteq>[]))"
    supply [vcg_rules] = tag_op_ruleI[OF tag_la_pop_back_def[where p=p] list_assn_pop_back2]
    apply (rule htriple_pure_preI)
    by vcg

  subsection \<open>Pure List Assertion\<close>
  (* TODO: is_pure list_assn rule *)

  definition "tag_la_exfree_pure p i = return ()"

  lemma bury_pure_red: "PRECOND (SOLVE_ASM (is_pure A)) \<Longrightarrow> is_sep_red \<box> \<box> (\<upharpoonleft>A a c) \<box>"
    unfolding vcg_tag_defs
    apply (rule is_sep_redI)
    apply (sep_drule bury_pure_assn)
    by simp

  lemma tag_la_exfree_pure_rl[vcg_rules]:
    "llvm_htriple
      (\<upharpoonleft>tag_assn i ii ** \<upharpoonleft>AA ys p ** \<upharpoonleft>(list_assn A R) xs ys ** \<up>(is_pure A \<and> R i = None \<and> i<length xs))
      (tag_la_exfree_pure p ii)
      (\<lambda>_. \<upharpoonleft>(list_assn A (R(i\<mapsto>ys!i))) xs ys ** \<upharpoonleft>AA ys p ** \<up>(length xs = length ys))"
    supply R[vcg_rules] =
      tag_op_ruleI[OF tag_la_exfree_pure_def[where i=ii] list_assn_extract[where i=i], of xs R A ys]
    thm R
    apply vcg
    apply vcg_try_solve
    subgoal (* TODO: Dirty hack! *)
      unfolding FRAME_INFER_def FRI_END_def
      apply (sep_drule bury_pure_assn')
      by simp
    done

end


(*  Title:      JinjaDCI/BV/EffMono.thy

    Author:     Gerwin Klein, Susannah Mansky
    Copyright   2000 Technische Universitaet Muenchen, 2019-20 UIUC

    Based on the Jinja theory BV/EffectMono.thy by Gerwin Klein
*)

section \<open> Monotonicity of eff and app \<close>

theory EffectMono imports Effect begin

declare not_Err_eq [iff]

lemma app\<^sub>i_mono:
  assumes wf: "wf_prog p P"
  assumes less: "P \<turnstile> \<tau> \<le>\<^sub>i \<tau>'"
  shows "app\<^sub>i (i,P,mxs,mpc,rT,\<tau>') \<Longrightarrow> app\<^sub>i (i,P,mxs,mpc,rT,\<tau>)"
(*<*)
proof -
  assume app: "app\<^sub>i (i,P,mxs,mpc,rT,\<tau>')"

  obtain ST LT ST' LT' where
    [simp]: "\<tau> = (ST,LT)" and
    [simp]: "\<tau>' = (ST',LT')"
    by (cases \<tau>, cases \<tau>')

  from less have [simp]: "size ST = size ST'" and [simp]: "size LT = size LT'"
    by (auto dest: list_all2_lengthD)

  note [iff] = list_all2_Cons2 widen_Class
  note [simp] = fun_of_def

  from app less show "app\<^sub>i (i,P,mxs,mpc,rT,\<tau>)"
  proof (cases i)
    case Load
    with app less show ?thesis by (auto dest!: list_all2_nthD)
  next
    case (Invoke M n)
    with app have n: "n < size ST'" by simp

    { assume "ST!n = NT" hence ?thesis using n app Invoke by simp }
    moreover {
      assume "ST'!n = NT"
      moreover with n less have "ST!n = NT"
        by (auto dest: list_all2_nthD)
      ultimately have ?thesis using n app Invoke by simp
    }
    moreover {
      assume ST: "ST!n \<noteq> NT" and ST': "ST'!n \<noteq> NT"

      from ST' app Invoke obtain D Ts T m C' where
        D:   "ST' ! n = Class D" and
        Ts:  "P \<turnstile> rev (take n ST') [\<le>] Ts" and
        D_M: "P \<turnstile> D sees M,NonStatic: Ts\<rightarrow>T = m in C'"
        by auto

      from n D less have "P \<turnstile> ST!n \<le> ST'!n"
        by (fastforce dest: list_all2_nthD2)
      with D ST obtain D' where
        D': "ST!n = Class D'" and DsubC: "P \<turnstile> D' \<preceq>\<^sup>* D" by auto

      from wf D_M DsubC obtain Ts' T' m' C'' where
        D'_M: "P \<turnstile> D' sees M,NonStatic: Ts'\<rightarrow>T' = m' in C''" and
        Ts': "P \<turnstile> Ts [\<le>] Ts'"
        by (blast dest: sees_method_mono)

      from less have "P \<turnstile> rev (take n ST) [\<le>] rev (take n ST')" by simp
      also note Ts also note Ts'
      finally have "P \<turnstile> rev (take n ST) [\<le>] Ts'" .
      with D'_M D' app less Invoke have ?thesis by fastforce
    }
    ultimately show ?thesis by blast
  next
    case (Invokestatic D M n)
    moreover {
      from app Invokestatic obtain Ts T m C' where
        Ts:  "P \<turnstile> rev (take n ST') [\<le>] Ts" and
        D_M: "P \<turnstile> D sees M,Static: Ts\<rightarrow>T = m in C'"
        by auto
      from wf D_M obtain Ts' T' m' C'' where
        D'_M: "P \<turnstile> D sees M,Static: Ts'\<rightarrow>T' = m' in C''" and
        Ts': "P \<turnstile> Ts [\<le>] Ts'"
        by (blast dest: sees_method_mono)
      from less have "P \<turnstile> rev (take n ST) [\<le>] rev (take n ST')" by simp
      also note Ts also note Ts'
      finally have "P \<turnstile> rev (take n ST) [\<le>] Ts'" .
      with D'_M app less Invokestatic have ?thesis by fastforce
    }
    ultimately show ?thesis by blast
  next
    case Getfield
    with app less show ?thesis by (fastforce intro: rtrancl_trans)
  next
    case (Putfield F C)
    with app less show ?thesis by (fastforce intro: widen_trans rtrancl_trans)
  next
    case (Putstatic C F D)
    with app less show ?thesis by (fastforce intro: widen_trans rtrancl_trans)
  next
    case Return
    with app less show ?thesis by (fastforce intro: widen_trans)
  qed (auto elim!: refTE not_refTE)
qed
(*>*)

lemma succs_mono:
  assumes wf: "wf_prog p P" and app\<^sub>i: "app\<^sub>i (i,P,mxs,mpc,rT,\<tau>')"
  shows "P \<turnstile> \<tau> \<le>\<^sub>i \<tau>' \<Longrightarrow> set (succs i \<tau> pc) \<subseteq> set (succs i \<tau>' pc)"
(*<*)
proof (cases i)
  case (Invoke M n)
  obtain ST LT ST' LT' where
    [simp]: "\<tau> = (ST,LT)" and [simp]: "\<tau>' = (ST',LT')" by (cases \<tau>, cases \<tau>')
  assume "P \<turnstile> \<tau> \<le>\<^sub>i \<tau>'"
  moreover
  with app\<^sub>i Invoke have "n < size ST" by (auto dest: list_all2_lengthD)
  ultimately
  have "P \<turnstile> ST!n \<le> ST'!n" by (auto simp add: fun_of_def dest: list_all2_nthD)
  with Invoke show ?thesis by auto
qed auto
(*>*)

lemma app_mono:
  assumes wf: "wf_prog p P"
  assumes less': "P \<turnstile> \<tau> \<le>' \<tau>'"
  shows "app i P m rT pc mpc xt \<tau>' \<Longrightarrow> app i P m rT pc mpc xt \<tau>"
(*<*)
proof (cases \<tau>)
  case None thus ?thesis by simp
next
  case (Some \<tau>\<^sub>1)
  moreover
  with less' obtain \<tau>\<^sub>2 where \<tau>\<^sub>2: "\<tau>' = Some \<tau>\<^sub>2" by (cases \<tau>') auto
  ultimately have less: "P \<turnstile> \<tau>\<^sub>1 \<le>\<^sub>i \<tau>\<^sub>2" using less' by simp

  assume "app i P m rT pc mpc xt \<tau>'"
  with Some \<tau>\<^sub>2 obtain
    app\<^sub>i: "app\<^sub>i (i, P, pc, m, rT, \<tau>\<^sub>2)" and
    xcpt: "xcpt_app i P pc m xt \<tau>\<^sub>2" and
    succs: "\<forall>(pc',s')\<in>set (eff i P pc xt (Some \<tau>\<^sub>2)). pc' < mpc"
    by (auto simp add: app_def)

  from wf less app\<^sub>i have "app\<^sub>i (i, P, pc, m, rT, \<tau>\<^sub>1)" by (rule app\<^sub>i_mono)
  moreover
  from less have "size (fst \<tau>\<^sub>1) = size (fst \<tau>\<^sub>2)"
    by (cases \<tau>\<^sub>1, cases \<tau>\<^sub>2) (auto dest: list_all2_lengthD)
  with xcpt have "xcpt_app i P pc m xt \<tau>\<^sub>1" by (simp add: xcpt_app_def)
  moreover
  from wf app\<^sub>i less have "\<forall>pc. set (succs i \<tau>\<^sub>1 pc) \<subseteq> set (succs i \<tau>\<^sub>2 pc)"
    by (blast dest: succs_mono)
  with succs
  have "\<forall>(pc',s')\<in>set (eff i P pc xt (Some \<tau>\<^sub>1)). pc' < mpc"
    by (cases \<tau>\<^sub>1, cases \<tau>\<^sub>2)
       (auto simp add: eff_def norm_eff_def xcpt_eff_def dest: bspec)
  ultimately
  show ?thesis using Some by (simp add: app_def)
qed
(*>*)

lemma eff\<^sub>i_mono:
  assumes wf: "wf_prog p P"
  assumes less: "P \<turnstile> \<tau> \<le>\<^sub>i \<tau>'"
  assumes app\<^sub>i: "app i P m rT pc mpc xt (Some \<tau>')"
  assumes succs: "succs i \<tau> pc \<noteq> []"  "succs i \<tau>' pc \<noteq> []"
  shows "P \<turnstile> eff\<^sub>i (i,P,\<tau>) \<le>\<^sub>i eff\<^sub>i (i,P,\<tau>')"
(*<*)
proof -
  obtain ST LT ST' LT' where
    [simp]: "\<tau> = (ST,LT)" and
    [simp]: "\<tau>' = (ST',LT')"
    by (cases \<tau>, cases \<tau>')

  note [simp] = eff_def app_def fun_of_def

  from less have "P \<turnstile> (Some \<tau>) \<le>' (Some \<tau>')" by simp
  from wf this app\<^sub>i
  have app: "app i P m rT pc mpc xt (Some \<tau>)" by (rule app_mono)

  from less app app\<^sub>i show ?thesis
  proof (cases i)
    case Throw with succs have False by simp
    thus ?thesis ..
  next
    case Return with succs have False by simp
    thus ?thesis ..
  next
    case (Load i)
    from Load app obtain y where
       y:  "i < size LT" "LT!i = OK y" by clarsimp
    from Load app\<^sub>i obtain y' where
       y': "i < size LT'" "LT'!i = OK y'" by clarsimp

    from less have "P \<turnstile> LT [\<le>\<^sub>\<top>] LT'" by simp
    with y y' have "P \<turnstile> y \<le> y'" by (auto dest: list_all2_nthD)
    with Load less y y' app app\<^sub>i
    show ?thesis by auto
  next
    case Store with less app app\<^sub>i
    show ?thesis by (auto simp add: list_all2_update_cong)
  next
    case (Invoke M n)
    with app\<^sub>i have n: "n < size ST'" by simp
    from less have [simp]: "size ST = size ST'"
      by (auto dest: list_all2_lengthD)

    from Invoke succs have ST: "ST!n \<noteq> NT" and ST': "ST'!n \<noteq> NT"
      by (auto split: if_split_asm)

    from ST' app\<^sub>i Invoke obtain D Ts T m C' where
      D:   "ST' ! n = Class D" and
      D_M: "P \<turnstile> D sees M,NonStatic: Ts\<rightarrow>T = m in C'"
      by auto

    from n D less have "P \<turnstile> ST!n \<le> ST'!n"
      by (fastforce dest: list_all2_nthD2)
    with D ST obtain D' where
      D': "ST ! n = Class D'" and DsubC: "P \<turnstile> D' \<preceq>\<^sup>* D"
      by (auto simp: widen_Class)

    from wf D_M DsubC obtain Ts' T' m' C'' where
      D'_M: "P \<turnstile> D' sees M,NonStatic: Ts'\<rightarrow>T' = m' in C''" and
      Ts': "P \<turnstile> T' \<le> T"
      by (blast dest: sees_method_mono)

    with Invoke n D D' D_M less
    show ?thesis by (auto intro: list_all2_dropI)
  qed auto
qed
(*>*)

end


(*  Title:      HOL/Auth/n_mutualExFsm.thy
    Author:     Yongjian Li and Kaiqiang Duan, State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
    Copyright    2016 State Key Lab of Computer Science, Institute of Software, Chinese Academy of Sciences
*)

header{*The n_mutualExFsm Protocol Case Study*}

theory n_mutualExFsm imports n_mutualExFsm_lemma_invs_on_rules n_mutualExFsm_on_inis
begin
lemma main:
assumes a1: "s \<in> reachableSet {andList (allInitSpecs N)} (rules N)"
and a2: "0 < N"
shows "\<forall> f. f \<in> (invariants N) --> formEval f s"
proof (rule consistentLemma)
show "consistent (invariants N) {andList (allInitSpecs N)} (rules N)"
proof (cut_tac a1, unfold consistent_def, rule conjI)
show "\<forall> f ini s. f \<in> (invariants N) --> ini \<in> {andList (allInitSpecs N)} --> formEval ini s --> formEval f s"
proof ((rule allI)+, (rule impI)+)
  fix f ini s
  assume b1: "f \<in> (invariants N)" and b2: "ini \<in> {andList (allInitSpecs N)}" and b3: "formEval ini s"
  have b4: "formEval (andList (allInitSpecs N)) s"
  apply (cut_tac b2 b3, simp) done
  show "formEval f s"
  apply (rule on_inis, cut_tac b1, assumption, cut_tac b2, assumption, cut_tac b3, assumption) done
qed
next show "\<forall> f r s. f \<in> invariants N --> r \<in> rules N --> invHoldForRule s f r (invariants N)"
proof ((rule allI)+, (rule impI)+)
  fix f r s
  assume b1: "f \<in> invariants N" and b2: "r \<in> rules N"
  show "invHoldForRule s f r (invariants N)"
  apply (rule invs_on_rules, cut_tac b1, assumption, cut_tac b2, assumption) done
qed
qed
next show "s \<in> reachableSet {andList (allInitSpecs N)} (rules N)"
  apply (metis a1) done
qed
end