subsection\<open>Hauptfiltervariant (Fig.~10 in \<^cite>\<open>"C85"\<close>)\<close>

theory SimpleVariantHF imports
  HOML
  MFilter
  BaseDefs
begin
text\<open>Definition: Set of supersets of \<open>X\<close>, we call this \<open>\<H>\<F> X\<close>.\<close>
abbreviation HF::"\<gamma>\<Rightarrow>(\<gamma>\<Rightarrow>\<sigma>)"  where "HF X \<equiv> \<lambda>Y.(X\<^bold>\<sqsubseteq>Y)"

text\<open>Postulate: \<open>\<H>\<F> \<G>\<close> is a filter; i.e., Hauptfilter of \<open>\<G>\<close>.\<close>
axiomatization where F1: "\<lfloor>Filter (HF \<G>)\<rfloor>"

text\<open>Necessary existence of a Godlike entity.\<close>
theorem T6: "\<lfloor>\<^bold>\<box>(\<^bold>\<exists>\<^sup>E \<G>)\<rfloor>" using F1 by auto \<comment>\<open>Proof found\<close>

theorem T6again: "\<lfloor>\<^bold>\<box>(\<^bold>\<exists>\<^sup>E \<G>)\<rfloor>"
proof -
 have T3': "\<lfloor>\<^bold>\<exists>\<^sup>E \<G>\<rfloor>" using F1 by auto
 have T6:  "\<lfloor>\<^bold>\<box>(\<^bold>\<exists>\<^sup>E \<G>)\<rfloor>" using T3' by blast
 thus ?thesis by simp qed

text\<open>Possible existence of Godlike entity not implied.\<close>
lemma T3: "\<lfloor>\<^bold>\<diamond>(\<^bold>\<exists>\<^sup>E \<G>)\<rfloor>" nitpick oops  \<comment>\<open>Countermodel\<close>

text\<open>Axiom T enforces possible existence of Godlike entity.\<close>
axiomatization
lemma T3: assumes T: "\<lfloor>\<^bold>\<forall>\<phi>.((\<^bold>\<box>\<phi>) \<^bold>\<rightarrow> \<phi>)\<rfloor>"
          shows "\<lfloor>\<^bold>\<diamond>(\<^bold>\<exists>\<^sup>E \<G>)\<rfloor>" using F1 T by auto

lemma True nitpick[satisfy] oops \<comment>\<open>Consistency: model found\<close>

text\<open>Modal collapse: not implied anymore.\<close>
lemma MC: "\<lfloor>\<^bold>\<forall>\<Phi>.(\<Phi> \<^bold>\<rightarrow> \<^bold>\<box>\<Phi>)\<rfloor>" nitpick oops  \<comment>\<open>Countermodel\<close>
lemma MT: "\<lfloor>\<^bold>\<forall>x y.(((\<G> x) \<^bold>\<and> (\<G> y)) \<^bold>\<rightarrow> (x\<^bold>=y))\<rfloor>"
          nitpick oops \<comment>\<open>Countermodel\<close>
end


(*  Title:       variants/d_fwdrreqs/Aodv_Message.thy
    License:     BSD 2-Clause. See LICENSE.
    Author:      Timothy Bourke, Inria
    Author:      Peter Höfner, NICTA
*)

section "AODV protocol messages"

theory D_Aodv_Message
imports D_Fwdrreqs
begin

datatype msg =
    Rreq nat rreqid ip sqn k ip sqn ip bool
  | Rrep nat ip sqn ip ip
  | Rerr "ip \<rightharpoonup> sqn" ip
  | Newpkt data ip
  | Pkt data ip ip

instantiation msg :: msg
begin
  definition newpkt_def [simp]: "newpkt \<equiv> \<lambda>(d, dip). Newpkt d dip"
  definition eq_newpkt_def: "eq_newpkt m \<equiv> case m of Newpkt d dip \<Rightarrow> True | _ \<Rightarrow> False"

  instance by intro_classes (simp add: eq_newpkt_def)
end

text \<open>The @{type msg} type models the different messages used within AODV.
      The instantiation as a @{class msg} is a technicality due to the special
      treatment of @{term newpkt} messages in the AWN SOS rules.
      This use of classes allows a clean separation of the AWN-specific definitions
      and these AODV-specific definitions.\<close>

definition rreq :: "nat \<times> rreqid \<times> ip \<times> sqn \<times> k \<times> ip \<times> sqn \<times> ip \<times> bool \<Rightarrow> msg"
  where "rreq \<equiv> \<lambda>(hops, rreqid, dip, dsn, dsk, oip, osn, sip, handled).
                    Rreq hops rreqid dip dsn dsk oip osn sip handled"

lemma rreq_simp [simp]:
  "rreq(hops, rreqid, dip, dsn, dsk, oip, osn, sip, handled) =  Rreq hops rreqid dip dsn dsk oip osn sip handled"
  unfolding rreq_def by simp

definition rrep :: "nat \<times> ip \<times> sqn \<times> ip \<times> ip \<Rightarrow> msg"
  where "rrep \<equiv> \<lambda>(hops, dip, dsn, oip, sip). Rrep hops dip dsn oip sip"

lemma rrep_simp [simp]:
  "rrep(hops, dip, dsn, oip, sip) = Rrep hops dip dsn oip sip"
  unfolding rrep_def by simp

definition rerr :: "(ip \<rightharpoonup> sqn) \<times> ip \<Rightarrow> msg"
  where "rerr \<equiv> \<lambda>(dests, sip). Rerr dests sip"

lemma rerr_simp [simp]:
  "rerr(dests, sip) = Rerr dests sip"
  unfolding rerr_def by simp

lemma not_eq_newpkt_rreq [simp]: "\<not>eq_newpkt (Rreq hops rreqid dip dsn dsk oip osn sip handled)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rrep [simp]: "\<not>eq_newpkt (Rrep hops dip dsn oip sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_rerr [simp]: "\<not>eq_newpkt (Rerr dests sip)"
  unfolding eq_newpkt_def by simp

lemma not_eq_newpkt_pkt [simp]: "\<not>eq_newpkt (Pkt d dip sip)"
  unfolding eq_newpkt_def by simp

definition pkt :: "data \<times> ip \<times> ip \<Rightarrow> msg"
  where "pkt \<equiv> \<lambda>(d, dip, sip). Pkt d dip sip"

lemma pkt_simp [simp]:
  "pkt(d, dip, sip) = Pkt d dip sip"
  unfolding pkt_def by simp

end


(*  Title:      HOL/Auth/n_germanSimp_lemma_inv__7_on_rules.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_germanSimp Protocol Case Study*}

theory n_germanSimp_lemma_inv__7_on_rules imports n_germanSimp_lemma_on_inv__7
begin
section{*All lemmas on causal relation between inv__7*}
lemma lemma_inv__7_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__7  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__0 N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__1 N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_StoreVsinv__7) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqSVsinv__7) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__0 N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqE__part__0Vsinv__7) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__1 N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqE__part__1Vsinv__7) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__0Vsinv__7) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__1Vsinv__7) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvAckVsinv__7) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvInvAckVsinv__7) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntSVsinv__7) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntEVsinv__7) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntSVsinv__7) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntEVsinv__7) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end


(*
 * Copyright 2017, Data61
 * Commonwealth Scientific and Industrial Research Organisation (CSIRO)
 * ABN 41 687 119 230.
 *
 * This software may be distributed and modified according to the terms of
 * the BSD 2-Clause license. Note that NO WARRANTY is provided.
 * See "LICENSE_BSD2.txt" for details.
 *

 * @TAG(DATA61_BSD)
 *)

theory EChronos_arm_sched_prop_EIT_inv

imports
  "EChronos_arm_sched_prop_tactic"
begin

definition
  schedule
where
  "schedule \<equiv>
    \<lbrace>True\<rbrace>
    \<acute>nextT := None;;
    \<lbrace>True (*\<acute>nextT = None*)\<rbrace>
    WHILE \<acute>nextT = None
    INV \<lbrace>True\<rbrace>
    DO
      \<lbrace>True\<rbrace>
      \<acute>E_tmp := \<acute>E;;
      \<lbrace>True\<rbrace>
      \<acute>R := handle_events \<acute>E_tmp \<acute>R;;
      \<lbrace>True\<rbrace>
      \<acute>E := \<acute>E - \<acute>E_tmp;;
      \<lbrace>True\<rbrace>
      \<acute>nextT := sched_policy(\<acute>R)
    OD"

definition
  context_switch
where
  "context_switch preempt_enabled \<equiv>
    \<lbrace>True\<rbrace>
    \<acute>contexts := \<acute>contexts (\<acute>curUser \<mapsto> (preempt_enabled, \<acute>ATStack));;
    \<lbrace>True\<rbrace>
    \<acute>curUser := the \<acute>nextT;;
    \<lbrace>True\<rbrace>
    \<acute>ATStack := snd (the (\<acute>contexts (\<acute>curUser)));;
    \<lbrace>True\<rbrace>
    IF fst (the (\<acute>contexts (\<acute>curUser)))
      THEN \<lbrace>True\<rbrace> \<langle>svc\<^sub>aEnable\<rangle>
      ELSE \<lbrace>True\<rbrace> \<langle>svc\<^sub>aDisable\<rangle> FI"

definition
  eChronos_arm_sched_prop_EIT_prog
where
  "eChronos_arm_sched_prop_EIT_prog \<equiv>
  (hardware_init,,
   eChronos_init,,
  (COBEGIN
    (* svc\<^sub>a_take *)
    \<lbrace>True\<rbrace>
    WHILE True INV \<lbrace>True\<rbrace>
    DO
      \<lbrace>True\<rbrace> svc\<^sub>aTake
    OD
    \<lbrace>False\<rbrace>

    \<parallel>

    (* svc\<^sub>a *)
    \<lbrace>True\<rbrace>
    WHILE True INV \<lbrace>True\<rbrace>
    DO
      add_await_routine svc\<^sub>a (
      \<lbrace>True\<rbrace>
      \<acute>ghostP := True;;
      add_inv_assn_com \<lbrace>True\<rbrace> (
      schedule;;
      context_switch True;;
      \<lbrace>True\<rbrace>
       \<langle>\<acute>ghostP := False,, IRet\<rangle>))
    OD
    \<lbrace>False\<rbrace>

    \<parallel>

    (* svc\<^sub>s *)
    \<lbrace>True\<rbrace>
    WHILE True INV \<lbrace>True\<rbrace>
    DO
      add_await_routine svc\<^sub>s (
      \<lbrace>True\<rbrace>
      \<acute>ghostS := True;;
      add_inv_assn_com \<lbrace>True\<rbrace> (
      schedule;;
      context_switch False;;
      \<lbrace>True\<rbrace>
       \<langle>\<acute>ghostS := False,, IRet\<rangle>))
    OD
    \<lbrace>False\<rbrace>

    \<parallel>

    SCHEME [user0 \<le> i < user0 + nbRoutines]
    \<lbrace>True\<rbrace> IF (i\<in>I) THEN

    (* Interrupts *)
    \<lbrace>True\<rbrace>
    WHILE True INV \<lbrace>True\<rbrace>
    DO
      \<lbrace>True\<rbrace>
      ITake i;;

      (add_await_routine i (
      add_inv_assn_com
       \<lbrace>True\<rbrace> (
      \<lbrace>True\<rbrace>
      \<acute>E :\<in> {E'. \<acute>E \<subseteq> E'};;

      \<lbrace>True\<rbrace>
      svc\<^sub>aRequest;;

      \<lbrace>True (*\<acute>svc\<^sub>aReq*)\<rbrace>
      \<langle>IRet\<rangle>)))
    OD

    ELSE
    (* Users *)
    add_inv_assn_com
     \<lbrace>True\<rbrace> (
    \<lbrace>True\<rbrace>
    WHILE True INV \<lbrace>True\<rbrace>
    DO
      (add_await_routine i (
      \<lbrace>True\<rbrace>
      \<acute>userSyscall :\<in> {SignalSend, Block};;

      \<lbrace>True\<rbrace>
      IF \<acute>userSyscall = SignalSend
      THEN
        \<lbrace>True\<rbrace>
        \<langle>\<acute>ghostU := \<acute>ghostU (i := Syscall),, svc\<^sub>aDisable\<rangle>;;

        add_inv_assn_com
          \<lbrace>True\<rbrace> (
        \<lbrace>True\<rbrace>
        \<acute>R :\<in> {R'. \<forall>i. \<acute>R i = Some True \<longrightarrow> R' i = Some True};;

        \<lbrace>True\<rbrace>
        svc\<^sub>aRequest;;

        \<lbrace>True\<rbrace>
        \<langle>svc\<^sub>aEnable,, \<acute>ghostU := \<acute>ghostU (i := User)\<rangle>);;
        \<lbrace>True\<rbrace>
        WHILE \<acute>svc\<^sub>aReq INV \<lbrace>True\<rbrace>
        DO
          \<lbrace>True\<rbrace> SKIP
        OD
      ELSE \<lbrace>True\<rbrace> IF \<acute>userSyscall = Block
      THEN
        \<lbrace>True\<rbrace>
        \<langle>\<acute>ghostU := \<acute>ghostU (i := Syscall),, svc\<^sub>aDisable\<rangle>;;

        \<lbrace>True\<rbrace>
        \<acute>R := \<acute>R (i := Some False);;

        \<lbrace>True\<rbrace>
        \<langle>\<acute>ghostU := \<acute>ghostU (i := Yield),, SVC\<^sub>s_now\<rangle>;;
        \<lbrace>True\<rbrace>
        \<acute>ghostU := \<acute>ghostU (i := Syscall);;

        \<lbrace>True\<rbrace>
        \<langle>svc\<^sub>aEnable,, \<acute>ghostU := \<acute>ghostU (i := User)\<rangle>;;
        \<lbrace>True\<rbrace>
        WHILE \<acute>svc\<^sub>aReq INV \<lbrace>True\<rbrace>
        DO
          \<lbrace>True\<rbrace> SKIP
        OD
      FI FI))
    OD)
    FI
    \<lbrace>False\<rbrace>
  COEND))"

lemmas eChronos_arm_sched_prop_EIT_prog_defs =
                    eChronos_arm_sched_prop_base_defs
                    eChronos_arm_sched_prop_EIT_prog_def
                    schedule_def context_switch_def

lemma rtos_EIT_inv_holds:
  "0<nbUsers \<and> 0 < nbInts \<Longrightarrow>
  \<lbrace>True\<rbrace> \<parallel>-\<^sub>i \<lbrace>\<acute>EIT_inv \<rbrace> \<lbrace>True\<rbrace>
  eChronos_arm_sched_prop_EIT_prog
  \<lbrace>False\<rbrace>"
  unfolding eChronos_arm_sched_prop_EIT_prog_defs
  unfolding oghoare_inv_def EIT_inv_def
  apply (simp add: add_inv_aux_def o_def)
  apply oghoare
  apply (find_goal \<open>succeeds \<open>rule subsetI[where A=UNIV]\<close>\<close>)
  subgoal
  apply (clarify)
  apply (erule notE)
  apply (simp add: handle_events_empty user0_is_highest)
  apply (rule conjI)
   apply (case_tac "nbRoutines - Suc (Suc 0)=0")
    apply (clarsimp simp:  handle_events_empty user0_is_highest)
   apply (clarsimp simp: handle_events_empty user0_is_highest)
  apply clarsimp
  apply (case_tac "i=0")
   apply (clarsimp simp: handle_events_empty user0_is_highest)
  apply (case_tac "i=Suc 0")
   apply (clarsimp simp: handle_events_empty user0_is_highest user0_def)
  apply (case_tac "i=Suc (Suc 0)")
   apply (clarsimp simp: handle_events_empty user0_is_highest user0_def)
  apply (clarsimp simp: handle_events_empty user0_is_highest)
  done

  apply (tactic \<open>fn thm => if Thm.nprems_of thm > 0 then
        let val ctxt = @{context}
            val clarsimp_ctxt = (ctxt
                addsimps @{thms Int_Diff card_insert_if
                                insert_Diff_if Un_Diff interrupt_policy_I
                                handle_events_empty helper16
                                helper18 interrupt_policy_self
                                user0_is_highest
                                interrupt_policy_mono sorted_by_policy_svc\<^sub>a
                                helper21 helper22 helper25}
                delsimps @{thms disj_not1}
                addSIs @{thms last_tl'})

            val clarsimp_ctxt2 = (ctxt
                addsimps @{thms neq_Nil_conv
                                interrupt_policy_svc\<^sub>a'
                                interrupt_policy_svc\<^sub>s'
                                interrupt_policy_U helper25
                                handle_events_empty}
                delsimps @{thms disj_not1}
                addDs @{thms })
                           |> Splitter.add_split @{thm if_split_asm}
                           |> Splitter.add_split @{thm if_split}

            val clarsimp_ctxt3 = (put_simpset HOL_basic_ss ctxt)

            val fastforce_ctxt = (ctxt
                addsimps @{thms sorted_by_policy_svc\<^sub>s_svc\<^sub>a sched_policy_Some_U
                                interrupt_policy_U last_tl
                                helper26 sorted_by_policy_svc\<^sub>a''}
                addDs @{thms })
                           |> Splitter.add_split @{thm if_split_asm}
                           |> Splitter.add_split @{thm if_split}

                          in
        timeit (fn _ => Cache_Tactics.PARALLEL_GOALS_CACHE 21 ((TRY' o SOLVED' o DETERM') (
        ((set_to_logic ctxt
        THEN_ALL_NEW svc_commute ctxt
        THEN_ALL_NEW (((fn tac => fn i => DETERM (tac i))
                        (TRY_EVERY_FORWARD' ctxt
                                            @{thms helper29 helper30
                                            sorted_by_policy_U
                                            sorted_by_policy_svc\<^sub>a_single
                                            sorted_by_policy_svc\<^sub>s_single
                                            sorted_by_policy_U_single
                                            sched_picks_user
                                            set_tl
                                            sorted_by_policy_empty'})
                         THEN'
                         ((TRY' o REPEAT_ALL_NEW)
                             (FORWARD (dresolve_tac ctxt
                                  @{thms helper21' helper27' helper28'})
                                  ctxt)))
                THEN' (TRY' (clarsimp_tac clarsimp_ctxt3))
                THEN' (TRY' (
                        SOLVED' (fn i => fn st => timed_tac 5 ctxt st
                                    (Blast.depth_tac ctxt 3 i st))
                ORELSE' SOLVED' (fn i => fn st => timed_tac 30 clarsimp_ctxt st (clarsimp_tac clarsimp_ctxt i st))
                ORELSE' SOLVED' (fn i => fn st => timed_tac 30 clarsimp_ctxt2 st (clarsimp_tac clarsimp_ctxt2 i st))
                ORELSE' SOLVED' (clarsimp_tac (ctxt delsimps @{thms disj_not1}
                           |> Splitter.add_split @{thm if_split_asm}) THEN_ALL_NEW
                                (fn i => fn st => timed_tac 20 fastforce_ctxt st (fast_force_tac fastforce_ctxt i st)))
                )))
                ))) 1)
                thm |> Seq.pull |> the |> fst |> Seq.single) end
        else Seq.empty\<close>)
  (*2.295s elapsed time, 4.428s cpu time, 0.200s GC time*)
  done

end


(*  Title:      HOL/Auth/n_german_lemma_on_inv__34.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_german Protocol Case Study*}

theory n_german_lemma_on_inv__34 imports n_german_base
begin
section{*All lemmas on causal relation between inv__34 and some rule r*}
lemma n_SendInvAckVsinv__34:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)" and
a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_SendInvAck  i" apply fastforce done
from a2 obtain p__Inv2 where a2:"p__Inv2\<le>N\<and>f=inv__34  p__Inv2" apply fastforce done
have "(i=p__Inv2)\<or>(i~=p__Inv2)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv2)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv2)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvInvAckVsinv__34:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)" and
a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvInvAck  i" apply fastforce done
from a2 obtain p__Inv2 where a2:"p__Inv2\<le>N\<and>f=inv__34  p__Inv2" apply fastforce done
have "(i=p__Inv2)\<or>(i~=p__Inv2)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv2)"
  have "?P1 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv2)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntSVsinv__34:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)" and
a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntS  i" apply fastforce done
from a2 obtain p__Inv2 where a2:"p__Inv2\<le>N\<and>f=inv__34  p__Inv2" apply fastforce done
have "(i=p__Inv2)\<or>(i~=p__Inv2)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv2)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv2) ''Cmd'')) (Const GntS)) (eqn (IVar (Field (Para (Ident ''Chan3'') p__Inv2) ''Cmd'')) (Const InvAck))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv2)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntEVsinv__34:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)" and
a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntE  i" apply fastforce done
from a2 obtain p__Inv2 where a2:"p__Inv2\<le>N\<and>f=inv__34  p__Inv2" apply fastforce done
have "(i=p__Inv2)\<or>(i~=p__Inv2)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv2)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv2) ''Cmd'')) (Const GntE)) (eqn (IVar (Field (Para (Ident ''Chan3'') p__Inv2) ''Cmd'')) (Const InvAck))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv2)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_SendReqE__part__1Vsinv__34:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqE__part__1  i" and
  a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_StoreVsinv__34:
  assumes a1: "\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d" and
  a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendGntSVsinv__34:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendGntS  i" and
  a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqEVsinv__34:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReqE N i" and
  a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendInv__part__0Vsinv__34:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i" and
  a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqE__part__0Vsinv__34:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqE__part__0  i" and
  a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendInv__part__1Vsinv__34:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i" and
  a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqSVsinv__34:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendReqS  i" and
  a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendGntEVsinv__34:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_SendGntE N i" and
  a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqSVsinv__34:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReqS N i" and
  a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__34  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

end


section \<open>Invariants of single-invocId executions.\<close>
theory execution_invariants_s
  imports repliss_sem_single_invocation execution_invariants
begin

text \<open>This theory includes proof for invariants that hold for all single-invocId executions.\<close>

lemma state_wellFormed_s_steps:
  assumes wf: "state_wellFormed S"
    and steps: "S ~~ (i, tr) \<leadsto>\<^sub>S* S'"
  shows "state_wellFormed S'"
  using steps
proof (induct rule: step_s_induct)
  case initial
  then show ?case
    using wf by simp
next
  case (step tr S' a S'')

  from ` state_wellFormed S'`
  have step_wf: "state_wellFormed S''" if "S' ~~ (i, fst a) \<leadsto> S''"
    using that
  proof (rule state_wellFormed_combine_step)
    show "get_action (i, fst a) \<noteq> ACrash"
      by (metis prod.collapse sndI step.hyps step_s_no_Fail)
  qed

  from `S' ~~ (i, a) \<leadsto>\<^sub>S S''`
  show ?case
  proof cases
    case (local ls f ok ls')
    show ?thesis
      by (rule step_wf, auto simp add: local step.simps)
  next
    case (newId ls f ls' uid uidv ls'')
    show ?thesis
    proof (rule step_wf)
      show "S' ~~ (i, fst a) \<leadsto> S''"
        using newId by (auto simp add:  step.simps)
    qed
  next
    case (beginAtomic ls f ls' t S' vis vis')
    thus ?thesis by simp
  next
    case (endAtomic ls f ls' t valid)
    show ?thesis
      by (rule step_wf, auto simp add: endAtomic step.simps)
  next
    case (dbop ls f Op ls' t c res vis)
    show ?thesis
    proof (rule step_wf)
      show "S' ~~ (i, fst a) \<leadsto> S''"
        using dbop by (auto simp add:  step.simps)
    qed
  next
    case (invocation proc initState impl Sx valid)
    have "Sx ~~ (i, AInvoc proc) \<leadsto> S''"
      using invocation apply (auto simp add: step.simps)
      using wf_localState_to_invocOp apply blast
      using wf_localState_needs_invocOp by blast

    thus ?thesis
      using `state_wellFormed Sx` state_wellFormed_combine_step by fastforce
  next
    case (return ls f res valid)
    show ?thesis
      by (rule step_wf, auto simp add: return step.simps)
  qed
qed

definition initialStates :: "('proc::valueType, 'ls, 'op, 'any::valueType) prog \<Rightarrow> invocId \<Rightarrow> ('proc, 'ls, 'op, 'any) state set"   where
  "initialStates progr i \<equiv> {
    (S\<lparr>localState := (localState S)(i \<mapsto> initState),
       currentProc := (currentProc S)(i \<mapsto> impl),
       visibleCalls := (visibleCalls S)(i \<mapsto> {}),
       invocOp := (invocOp S)(i \<mapsto> proc)\<rparr>)
 | S proc initState impl.
    prog S = progr
  \<and> procedure progr proc = (initState, impl)
  \<and> uniqueIds proc \<subseteq> knownIds S
  \<and> invariant_all S
  \<and> state_wellFormed S
  \<and> invocOp S i = None
  \<and> (\<forall>tx. txStatus S tx \<noteq> Some Uncommitted)
  \<and> (\<forall>tx. txOrigin S tx \<noteq> Some i)
}"

lemma initialStates_wellFormed:
"state_wellFormed S" if "S \<in> initialStates progr i"
  using that proof (auto simp add: initialStates_def)
  fix Sa proc initState impl
  assume S_def: "S = Sa\<lparr>localState := localState Sa(i \<mapsto> initState), currentProc := currentProc Sa(i \<mapsto> impl), visibleCalls := visibleCalls Sa(i \<mapsto> {}),
                 invocOp := invocOp Sa(i \<mapsto> proc)\<rparr>"
    and "progr = prog Sa"
    and "procedure (prog Sa) proc = (initState, impl)"
    and "uniqueIds proc \<subseteq> knownIds Sa"
    and "invariant_all Sa"
    and "state_wellFormed Sa"
    and "invocOp Sa i = None"
    and "\<forall>tx. txStatus Sa tx \<noteq> Some Uncommitted"

  have step: "Sa ~~ (i, AInvoc proc) \<leadsto> S"
    apply (auto simp add: step.simps S_def)
    by (metis \<open>invocOp Sa i = None\<close> \<open>procedure (prog Sa) proc = (initState, impl)\<close> \<open>state_wellFormed Sa\<close> \<open>uniqueIds proc \<subseteq> knownIds Sa\<close> state.surjective state.unfold_congs(12) state.update_convs(1) wf_localState_to_invocOp)

  with \<open>state_wellFormed Sa\<close>
  have "state_wellFormed S"
    using state_wellFormed_combine_step by fastforce

  then show " state_wellFormed
            (Sa\<lparr>localState := localState Sa(i \<mapsto> initState), currentProc := currentProc Sa(i \<mapsto> impl), visibleCalls := visibleCalls Sa(i \<mapsto> {}),
                  invocOp := invocOp Sa(i \<mapsto> proc)\<rparr>)"
    using S_def by simp
qed

definition state_wellFormed_s where
  "state_wellFormed_s S i \<equiv> \<exists>prog tr. initialState prog ~~ (i,tr) \<leadsto>\<^sub>S* S"

lemma initialStates_reachable_from_initialState:
  assumes "init\<in>initialStates progr i"
  shows "\<exists>p invr. initialState progr ~~ (i, AInvoc p, invr) \<leadsto>\<^sub>S init"
  using assms apply (auto simp add: initialStates_def step_s.simps )
   apply (auto simp add: initialState_def)
  by blast

lemma initialStates_wf:
  assumes "init\<in>initialStates progr i"
    and "init ~~ (i,tr) \<leadsto>\<^sub>S* S"
  shows "state_wellFormed_s S i"
  using assms initialStates_reachable_from_initialState state_wellFormed_s_def steps_s_append steps_s_single by blast

lemma state_wellFormed_s_to_wf:
  assumes "state_wellFormed_s S i"
  shows "state_wellFormed S"
  using assms state_wellFormed_init state_wellFormed_s_def state_wellFormed_s_steps by blast

(*
definition state_wellFormed_s where
"state_wellFormed_s S i \<equiv> \<exists>prog init tr. init\<in>initialStates prog i \<and> init ~~ (i,tr) \<leadsto>\<^sub>S* S"
*)

lemma state_wellFormed_s_induct[consumes 1, case_names initial step[IH steps step]]:
  assumes wf: "state_wellFormed_s S i"
    and initial_P: "\<And>progr. P (initialState progr)"
    and step_P: "\<And>tr S a S' progr. \<lbrakk>P S; initialState progr ~~ (i,tr) \<leadsto>\<^sub>S* S;  S ~~ (i, a) \<leadsto>\<^sub>S S'\<rbrakk> \<Longrightarrow> P S'"
  shows "P S"
proof -
  from wf
  obtain prog tr where  steps: "initialState prog ~~ (i, tr) \<leadsto>\<^sub>S* S"
    by (auto simp add: state_wellFormed_s_def)

  from steps
  show "P S"
  proof (induct rule: step_s_induct)
    case initial
    then show ?case
      using initial_P by blast
  next
    case (step tr S a S')
    then show ?case
      using step_P by blast
  qed
qed

lemma wf_s_localState_to_invocOp:
  "\<lbrakk>state_wellFormed_s S i; localState S i \<noteq> None\<rbrakk> \<Longrightarrow> invocOp S i \<noteq> None"
  by (meson state_wellFormed_s_to_wf wellFormed_invoc_notStarted(2))

lemma wf_s_localState_to_invocOp2:
  "\<lbrakk>state_wellFormed_s S i; localState S i \<triangleq> x\<rbrakk> \<Longrightarrow> \<exists>p. invocOp S i \<triangleq> p"
  using wf_s_localState_to_invocOp by fastforce

lemma wellFormed_s_invoc_notStarted1:
  assumes "state_wellFormed_s S i"
    and "invocOp S i = None"
  shows "currentTx S i = None"
  using assms state_wellFormed_s_to_wf wellFormed_invoc_notStarted(1) by auto

lemma wellFormed_s_invoc_notStarted2:
  assumes "state_wellFormed_s S i"
    and "invocOp S i = None"
  shows  "localState S i = None"
  using assms wf_s_localState_to_invocOp by blast

lemma unchangedProg1:
  assumes steps: "S ~~ (i, tr) \<leadsto>\<^sub>S S'"
  shows "prog S' = prog S"
  using assms by (auto simp add: step_s.simps)

lemma unchangedProg:
  assumes steps: "S ~~ (i, tr) \<leadsto>\<^sub>S* S'"
  shows "prog S' = prog S"
  using assms by (induct rule: step_s_induct) (auto simp add: unchangedProg1)

lemma state_wellFormed_s_currentTxsOnlyInCurrent:
  assumes wf: "state_wellFormed_s S i"
    and other: "i' \<noteq> i"
  shows "currentTx S i' = None"
  using assms proof (induct rule: state_wellFormed_s_induct)
  case (initial progr)
  show ?case
    by (auto simp add: initialState_def)
next
  case (step tr S a S' progr)
  then show ?case
    apply (auto simp add: step_s.simps)
     apply (metis not_None_eq wellFormed_currentTx_unique wellFormed_currentTx_unique_h(2))
    by (meson option.exhaust wellFormed_currentTx_unique_h(2))
qed

lemma state_wellFormed_s_currentTxs_iff_uncommitted:
  assumes wf: "state_wellFormed_s S i"
  shows "currentTx S i \<triangleq> tx \<longleftrightarrow> (txStatus S tx \<triangleq> Uncommitted)"
  using local.wf state_wellFormed_s_currentTxsOnlyInCurrent state_wellFormed_s_to_wf wellFormed_currentTxUncommitted wellFormed_currentTx_back3 by fastforce

end


(* *********************************************************************

    Theory ProgCorr.thy is part of a framework for modelling,
    verification and transformation of concurrent imperative
    programs. Copyright (c) 2021  M. Bortin

    The framework is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
    For more details see the license agreement (LICENSE) you should have
    received along with the framework.

   ******************************************************************* *)

theory ProgCorr
imports RG
begin

section "Stepwise correspondence between programs"

definition prog_corrC :: "(nat \<Rightarrow> 'a LA) \<Rightarrow> (nat \<Rightarrow> 'b LA) \<Rightarrow> ('a \<times> 'b) set \<Rightarrow> ('a LA \<times> 'b LA) set \<Rightarrow> bool"
  where "prog_corrC \<rho> \<rho>' r X \<equiv> (\<forall>(p, p') \<in> X. \<forall>(s, t) \<in> r. \<forall>p'' t'. \<rho>' \<turnstile> (p', t) -p\<rightarrow> (p'', t') \<longrightarrow>
                                 (\<exists>s' p'''. \<rho> \<turnstile> (p, s) -p\<rightarrow> (p''', s') \<and> (s', t') \<in> r \<and> (p''', p'') \<in> X)) \<and>
                                 (\<forall>p. (p, Skip) \<in> X \<longrightarrow> p = Skip) \<and>
                                 (\<forall>p. (Skip, p) \<in> X \<longrightarrow> p = Skip)"

definition prog_corr :: "(nat \<Rightarrow> 'a LA) \<Rightarrow> (nat \<Rightarrow> 'b LA) \<Rightarrow> ('a \<times> 'b) set \<Rightarrow> ('a LA \<times> 'b LA) set"
  where "prog_corr \<rho> \<rho>' r \<equiv> \<Union>{X. prog_corrC \<rho> \<rho>' r X}"

abbreviation prog_corr' :: "(nat \<Rightarrow> 'a LA) \<Rightarrow> (nat \<Rightarrow> 'b LA) \<Rightarrow> 'a LA \<Rightarrow> ('a \<times> 'b) set \<Rightarrow> 'b LA \<Rightarrow> bool"
   ("_, _ \<Turnstile> _ \<sqsupseteq>\<^bsub>_\<^esub> _" [71, 71, 20, 10, 20] 71)
   where "\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<equiv> (p, p') \<in> prog_corr \<rho> \<rho>' r"

definition prog_mucorr :: "(nat \<Rightarrow> 'a LA) \<Rightarrow> (nat \<Rightarrow> 'b LA) \<Rightarrow> ('a \<times> 'b) set \<Rightarrow> ('a LA \<times> 'b LA) set"
  where "prog_mucorr \<rho> \<rho>' r = {(p, p') |p p'. (\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p') \<and> \<rho>', \<rho> \<Turnstile> p' \<sqsupseteq>\<^bsub>r\<inverse>\<^esub> p}"

abbreviation prog_mucorr' :: "(nat \<Rightarrow> 'a LA) \<Rightarrow> (nat \<Rightarrow> 'b LA) \<Rightarrow> 'a LA \<Rightarrow> ('a \<times> 'b) set \<Rightarrow> 'b LA \<Rightarrow> bool"
   ("_, _ \<Turnstile> _ \<approx>\<^bsub>_\<^esub> _" [71, 71, 20, 10, 20] 71)
   where "\<rho>, \<rho>' \<Turnstile> p \<approx>\<^bsub>r\<^esub> p' \<equiv> (p, p') \<in> prog_mucorr \<rho> \<rho>' r"

abbreviation prog_mucorr'' :: "(nat \<Rightarrow> 'a LA) \<Rightarrow> 'a LA \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> 'a LA \<Rightarrow> bool"
   ("_ \<Turnstile> _ \<approx>\<^bsub>_\<^esub> _" [71, 20, 10, 20] 71)
   where "\<rho> \<Turnstile> p \<approx>\<^bsub>r\<^esub> p' \<equiv> (p, p') \<in> prog_mucorr \<rho> \<rho> r"

abbreviation prog_mucorr''' :: "'a LA \<Rightarrow> ('a \<times> 'b) set \<Rightarrow> 'b LA \<Rightarrow> bool"
   ("\<Turnstile> _ \<approx>\<^bsub>_\<^esub> _" [20, 10, 20] 71)
   where "\<Turnstile> p \<approx>\<^bsub>r\<^esub> p' \<equiv> (p, p') \<in> prog_mucorr (\<lambda>x. Skip) (\<lambda>x. Skip) r"

abbreviation prog_corr'' :: "(nat \<Rightarrow> 'a LA) \<Rightarrow> 'a LA \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> 'a LA \<Rightarrow> bool"
   ("_ \<Turnstile> _ \<sqsupseteq>\<^bsub>_\<^esub> _" [71, 20, 20, 20] 71)
   where "\<rho> \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<equiv> (p, p') \<in> prog_corr \<rho> \<rho> r"

abbreviation prog_corr'_id :: "(nat \<Rightarrow> 'a LA) \<Rightarrow> (nat \<Rightarrow> 'a LA) \<Rightarrow> 'a LA \<Rightarrow> 'a LA \<Rightarrow> bool"
   ("_, _ \<Turnstile> _ \<sqsupseteq> _" [71, 71, 20, 20] 71)
   where "\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq> p' \<equiv> (p, p') \<in> prog_corr \<rho> \<rho>' Id"

abbreviation prog_corr'_id' :: "(nat \<Rightarrow> 'a LA) \<Rightarrow> 'a LA \<Rightarrow> 'a LA \<Rightarrow> bool"
   ("_ \<Turnstile> _ \<sqsupseteq> _" [71, 20, 20] 71)
   where "\<rho> \<Turnstile> p \<sqsupseteq> p' \<equiv> (p, p') \<in> prog_corr \<rho> \<rho> Id"

abbreviation prog_corr''' :: "'a LA \<Rightarrow> ('a \<times> 'b) set \<Rightarrow> 'b LA \<Rightarrow> bool"
   ("\<Turnstile> _ \<sqsupseteq>\<^bsub>_\<^esub> _" [20, 20, 20] 71)
   where "\<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<equiv> (p, p') \<in> prog_corr (\<lambda>x. Skip) (\<lambda>x. Skip) r"

abbreviation prog_corr'''_id :: "'a LA \<Rightarrow> 'a LA \<Rightarrow> bool"
   ("\<Turnstile> _ \<sqsupseteq> _" [20, 20] 71)
   where "\<Turnstile> p \<sqsupseteq> p' \<equiv> (p, p') \<in> prog_corr (\<lambda>x. Skip) (\<lambda>x. Skip) Id"

abbreviation prog_mucorr'_id :: "(nat \<Rightarrow> 'a LA) \<Rightarrow> (nat \<Rightarrow> 'a LA) \<Rightarrow> 'a LA \<Rightarrow> 'a LA \<Rightarrow> bool"
   ("_, _ \<Turnstile> _ \<approx> _" [71, 71, 20, 20] 71)
   where "\<rho>, \<rho>' \<Turnstile> p \<approx> p' \<equiv> (p, p') \<in> prog_mucorr \<rho> \<rho>' Id"

abbreviation prog_mucorr'_id' :: "(nat \<Rightarrow> 'a LA) \<Rightarrow> 'a LA \<Rightarrow> 'a LA \<Rightarrow> bool"
   ("_ \<Turnstile> _ \<approx> _" [71, 20, 20] 71)
   where "\<rho> \<Turnstile> p \<approx> p' \<equiv> (p, p') \<in> prog_mucorr \<rho> \<rho> Id"

lemma small_step_eqv :
"(\<rho>, \<rho>' \<Turnstile> p \<approx> p') = ((\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq> p') \<and> (\<rho>', \<rho> \<Turnstile> p' \<sqsupseteq> p))"
  by(simp add: prog_mucorr_def)

lemma prog_corrC_skipD1 :
"(Skip, p) \<in> X \<Longrightarrow> prog_corrC \<rho> \<rho>' r X \<Longrightarrow> p = Skip"
  by(clarsimp simp: prog_corrC_def)

lemma prog_corrC_skipD2 :
"(p, Skip) \<in> X \<Longrightarrow> prog_corrC \<rho> \<rho>' r X \<Longrightarrow> p = Skip"
  by(clarsimp simp: prog_corrC_def)

lemma prog_corrC_step :
"(p, p') \<in> X \<Longrightarrow> prog_corrC \<rho> \<rho>' r X \<Longrightarrow> (s, t) \<in> r \<Longrightarrow> \<rho>' \<turnstile> (p', t) -p\<rightarrow> (p'', t') \<Longrightarrow>
   \<exists>s' p'''. \<rho> \<turnstile> (p, s) -p\<rightarrow> (p''', s') \<and> (s', t') \<in> r \<and> (p''', p'') \<in> X"
  apply(simp add: prog_corrC_def)
  apply(drule conjunct1)
  apply(drule bspec, assumption, simp)+
  done

lemma prog_corrC_steps :
"\<rho>' \<turnstile> (p', t) -p\<rightarrow>\<^sup>n (p'', t') \<Longrightarrow> (p, p') \<in> X \<Longrightarrow> prog_corrC \<rho> \<rho>' r X \<Longrightarrow> (s, t) \<in> r \<Longrightarrow>
   \<exists>s' p'''. \<rho> \<turnstile> (p, s) -p\<rightarrow>\<^sup>n (p''', s') \<and> (s', t') \<in> r \<and> (p''', p'') \<in> X"
  apply(induct n arbitrary: p s p' t p'' t', simp)
  apply clarsimp
  apply((drule meta_spec)+, (drule meta_mp, assumption)+)
  apply clarsimp
  apply(drule_tac p=p''' in prog_corrC_step, assumption, assumption, assumption)
  apply clarify
  apply(rename_tac s1 p1)
  apply(rule_tac x=s1 in exI, simp)
  apply(rule_tac x=p1 in exI, simp)
  apply(erule relcomppI, assumption)
  done

lemma prog_corrC_skips :
"prog_corrC \<rho> \<rho>' r {(Skip, Skip)}"
  apply(clarsimp simp: prog_corrC_def)
  apply(erule Skip_pstep)
  done

lemma prog_corrC_union :
"prog_corrC \<rho> \<rho>' r X \<Longrightarrow> prog_corrC \<rho> \<rho>' r Z \<Longrightarrow> prog_corrC \<rho> \<rho>' r (X \<union> Z)"
  apply(subst prog_corrC_def, simp)
  apply(rule conjI, clarsimp)
   apply(erule disjE)
    apply(drule prog_corrC_step, assumption+)
    apply fastforce
   apply(drule prog_corrC_step, assumption+)
   apply fastforce
  apply(rule conjI, clarsimp)+
    apply(erule prog_corrC_skipD2, assumption)
    apply(clarify, erule prog_corrC_skipD2, assumption)
  apply clarsimp
  apply(rule conjI, clarify, erule prog_corrC_skipD1, assumption)
  apply(clarify, erule prog_corrC_skipD1, assumption)
  done

lemma prog_corrC_Union :
"\<forall>x \<in> S. prog_corrC \<rho> \<rho>' r x \<Longrightarrow> prog_corrC \<rho> \<rho>' r (\<Union>S)"
  apply(subst prog_corrC_def)
  apply(rule conjI, clarsimp)
   apply(drule bspec, assumption)
   apply(drule prog_corrC_step, assumption+)
   apply fastforce
  apply(rule conjI, clarsimp)
   apply(drule bspec, assumption)
   apply(drule prog_corrC_skipD2, assumption+)
  apply clarsimp
  apply(drule bspec, assumption)
  apply(drule prog_corrC_skipD1, assumption+)
  done

lemma prog_corrC_comp :
"prog_corrC \<rho> \<rho>' r1 X \<Longrightarrow> prog_corrC \<rho>' \<rho>'' r2 Z \<Longrightarrow>
 prog_corrC \<rho> \<rho>'' (r1 O r2) (X O Z)"
  apply(subst prog_corrC_def, simp)
  apply(rule conjI, clarsimp)
   apply(frule prog_corrC_step, assumption, assumption, assumption)
   apply clarsimp
   apply(drule prog_corrC_step, assumption, assumption, assumption)
   apply clarsimp
   apply(rename_tac t1 p1)
   apply(rule_tac x=t1 in exI)
   apply(rule_tac x=p1 in exI, simp)
   apply(rule conjI)
    apply(erule relcompI, assumption)+
  apply(rule conjI, clarsimp)
   apply(drule prog_corrC_skipD2, assumption)
   apply clarsimp
   apply(drule prog_corrC_skipD2, assumption+)
  apply clarify
  apply(drule prog_corrC_skipD1, assumption)
  apply clarsimp
  apply(drule prog_corrC_skipD1, assumption+)
  done

lemma prog_corrC_Id :
"prog_corrC \<rho> \<rho> Id Id"
  by(clarsimp simp: prog_corrC_def)

lemma prog_corr_skipD1 :
"\<rho>, \<rho>' \<Turnstile> SKIP \<sqsupseteq>\<^bsub>r\<^esub> p \<Longrightarrow> p = SKIP"
  by(clarsimp simp: prog_corr_def, erule prog_corrC_skipD1, assumption)

lemma prog_corr_skipD2 :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> SKIP \<Longrightarrow> p = SKIP"
  by(clarsimp simp: prog_corr_def, erule prog_corrC_skipD2, assumption)

lemma prog_corr_step :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<Longrightarrow> (s, t) \<in> r \<Longrightarrow> \<rho>' \<turnstile> (p', t) -p\<rightarrow> (p'', t') \<Longrightarrow>
 \<exists>s' p'''. \<rho> \<turnstile> (p, s) -p\<rightarrow> (p''', s') \<and> (s', t') \<in> r \<and> \<rho>, \<rho>' \<Turnstile> p''' \<sqsupseteq>\<^bsub>r\<^esub> p''"
  apply(clarsimp simp: prog_corr_def)
  apply(drule prog_corrC_step, assumption+)
  by fastforce

lemma prog_corr_trans :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r1\<^esub> p' \<Longrightarrow> \<rho>', \<rho>'' \<Turnstile> p' \<sqsupseteq>\<^bsub>r2\<^esub> p'' \<Longrightarrow>
 \<rho>, \<rho>'' \<Turnstile> p \<sqsupseteq>\<^bsub>r1 O r2\<^esub> p''"
  apply(clarsimp simp: prog_corr_def)
  apply(rename_tac X Z)
  apply(rule_tac x="X O Z" in exI)
  apply(rule conjI)
   apply(erule prog_corrC_comp, assumption)
  apply(erule relcompI, assumption)
  done

lemmas prog_corr_trans' = prog_corr_trans[where ?r1.0=Id and ?r2.0=Id, simplified]
lemmas prog_corr_trans_IdL = prog_corr_trans[where ?r1.0=Id, simplified]
lemmas prog_corr_trans_IdR = prog_corr_trans[where ?r2.0=Id, simplified]

lemma prog_corr_refl :
"\<rho> \<Turnstile> p \<sqsupseteq> p"
  apply(simp add: prog_corr_def)
  apply(rule exI, rule conjI, rule prog_corrC_Id)
  by simp

lemma small_step_eqvD1 :
"\<rho>, \<rho>' \<Turnstile> p \<approx> p' \<Longrightarrow> \<rho>, \<rho>' \<Turnstile> p \<sqsupseteq> p'"
  by(clarsimp simp: small_step_eqv)

lemma small_step_eqvD2 :
"\<rho>, \<rho>' \<Turnstile> p \<approx> p' \<Longrightarrow> \<rho>', \<rho> \<Turnstile> p' \<sqsupseteq> p"
  by(clarsimp simp: small_step_eqv)

lemma small_step_eqv_refl :
"\<rho> \<Turnstile> p \<approx> p"
  apply(clarsimp simp: small_step_eqv)
  by(rule prog_corr_refl)

lemma small_step_eqv_sym :
"\<rho>, \<rho>' \<Turnstile> p \<approx> p' \<Longrightarrow> \<rho>', \<rho> \<Turnstile> p' \<approx> p"
  by(clarsimp simp: small_step_eqv)

lemma small_step_eqv_trans :
"\<rho>, \<rho>' \<Turnstile> p \<approx> p' \<Longrightarrow> \<rho>', \<rho>'' \<Turnstile> p' \<approx> p'' \<Longrightarrow>
 \<rho>, \<rho>'' \<Turnstile> p \<approx> p''"
  apply(clarsimp simp: small_step_eqv)
  apply(drule_tac p''=p'' in prog_corr_trans, assumption)
  apply(drule_tac p=p'' in prog_corr_trans, assumption)
  by simp

section "Further properties"

lemma small_step_eqv_substL :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p'' \<Longrightarrow> \<rho> \<Turnstile> p \<approx> p' \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> p' \<sqsupseteq>\<^bsub>r\<^esub> p''"
  apply(clarsimp simp: small_step_eqv)
  apply(drule_tac p=p' in prog_corr_trans, assumption)
  apply simp
  done

lemma small_step_eqv_substR :
"\<rho>, \<rho>' \<Turnstile> p'' \<sqsupseteq>\<^bsub>r\<^esub> p \<Longrightarrow> \<rho>' \<Turnstile> p \<approx> p' \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> p'' \<sqsupseteq>\<^bsub>r\<^esub> p'"
  apply(clarsimp simp: small_step_eqv)
  apply(drule_tac p=p'' in prog_corr_trans, assumption)
  by simp

section "Associativity of sequencing"

lemma prog_corr_seq_assoc1 :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<Longrightarrow> \<rho>, \<rho>' \<Turnstile> q \<sqsupseteq>\<^bsub>r\<^esub> q' \<Longrightarrow> \<rho>, \<rho>' \<Turnstile> v \<sqsupseteq>\<^bsub>r\<^esub> v' \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> (p;q);v \<sqsupseteq>\<^bsub>r\<^esub> p';(q';v')"
  apply(clarsimp simp: prog_corr_def)
  apply(rename_tac P Q V)
  apply(rule_tac x="{(Seq (Seq x q) v, Seq x' (Seq q' v')) | x x'. (x, x') \<in> P} \<union>
                    {(Seq x v, Seq x' v') | x x'. (x, x') \<in> Q} \<union> V \<union> {(Skip, Skip)}" in exI)
  apply simp
  apply(subst prog_corrC_def)
  apply clarsimp
  apply(rule conjI)
   apply clarsimp
   apply(erule Skip_pstep)
  apply(rule conjI)
   apply clarsimp
   apply(rename_tac s t p'' t')
   apply(erule disjE, clarsimp)
    apply(case_tac "x' = SKIP", clarify)
     apply(drule prog_corrC_skipD2, assumption)
     apply(drule Seq_pstep_Skip, clarsimp)
     apply(rule_tac x=s in exI, simp)
     apply(rule exI, rule conjI)
      apply(rule pstep.Seq, rule pstep.SeqSkip)
     apply fast
    apply(drule Seq_pstep, assumption)
    apply clarsimp
    apply(drule_tac X=P and p=x in prog_corrC_step[rotated -1], assumption+)
    apply clarsimp
    apply(rule_tac x=s' in exI, simp)
    apply(rule exI, rule conjI)
     apply(rule pstep.Seq, erule pstep.Seq)
    apply fast
   apply(erule disjE, clarsimp)
    apply(case_tac "x' = SKIP", clarify)
     apply(drule prog_corrC_skipD2, assumption)
     apply(drule Seq_pstep_Skip, clarsimp)
     apply(rule_tac x=s in exI, simp)
     apply(rule exI, rule conjI)
      apply(rule pstep.SeqSkip)
     apply fast
    apply(drule Seq_pstep, assumption)
    apply clarsimp
    apply(drule_tac X=Q and p=x in prog_corrC_step[rotated -1], assumption+)
    apply clarsimp
    apply(rule_tac x=s' in exI, simp)
    apply(rule exI, rule conjI)
     apply(erule pstep.Seq)
    apply fast
   apply(drule_tac X=V in prog_corrC_step[rotated -1], assumption+)
   apply fast
  apply(rule conjI, clarsimp)
   apply(erule prog_corrC_skipD2, assumption)
  apply clarsimp
  apply(erule prog_corrC_skipD1, assumption)
  done

lemma prog_corr_seq_assoc2 :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<Longrightarrow> \<rho>, \<rho>' \<Turnstile> q \<sqsupseteq>\<^bsub>r\<^esub> q' \<Longrightarrow> \<rho>, \<rho>' \<Turnstile> v \<sqsupseteq>\<^bsub>r\<^esub> v' \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> p;(q;v) \<sqsupseteq>\<^bsub>r\<^esub> (p';q');v'"
  apply(clarsimp simp: prog_corr_def)
  apply(rename_tac P Q V)
  apply(rule_tac x="{(Seq x (Seq q v), Seq (Seq x' q') v') | x x'. (x, x') \<in> P} \<union>
                    {(Seq x v, Seq x' v') | x x'. (x, x') \<in> Q} \<union> V \<union> {(Skip, Skip)}" in exI)
  apply simp
  apply(subst prog_corrC_def)
  apply clarsimp
  apply(rule conjI)
   apply clarsimp
   apply(erule Skip_pstep)
  apply(rule conjI)
   apply clarsimp
   apply(rename_tac s t p'' t')
   apply(erule disjE, clarsimp)
    apply(drule Seq_pstep, simp, clarsimp)
    apply(case_tac "x' = SKIP", clarify)
     apply(drule prog_corrC_skipD2, assumption)
     apply(drule Seq_pstep_Skip, clarsimp)
     apply(rule_tac x=s in exI, simp)
     apply(rule exI, rule conjI)
      apply(rule pstep.SeqSkip)
     apply fast
    apply(drule Seq_pstep, simp, clarsimp)
    apply(drule_tac X=P and p=x in prog_corrC_step[rotated -1], assumption+)
    apply clarsimp
    apply(rule_tac x=s' in exI, simp)
    apply(rule exI, rule conjI)
     apply(erule pstep.Seq, fast)
   apply(erule disjE, clarsimp)
    apply(case_tac "x' = SKIP", clarify)
     apply(drule prog_corrC_skipD2, assumption)
     apply(drule Seq_pstep_Skip, clarsimp)
     apply(rule_tac x=s in exI, simp)
     apply(rule exI, rule conjI)
      apply(rule pstep.SeqSkip)
     apply fast
    apply(drule Seq_pstep, assumption)
    apply clarsimp
    apply(drule_tac X=Q and p=x in prog_corrC_step[rotated -1], assumption+)
    apply clarsimp
    apply(rule_tac x=s' in exI, simp)
    apply(rule exI, rule conjI)
     apply(erule pstep.Seq)
    apply fast
   apply(drule_tac X=V in prog_corrC_step[rotated -1], assumption+)
   apply fast
  apply(rule conjI, clarsimp)
   apply(erule prog_corrC_skipD2, assumption)
  apply clarsimp
  apply(erule prog_corrC_skipD1, assumption)
  done

theorem small_step_eqv_seq_assoc :
"\<rho> \<Turnstile> (p;q);v \<approx> p;q;v"
  apply(simp add: small_step_eqv)
  apply(rule conjI)
  apply(rule prog_corr_seq_assoc1, (rule prog_corr_refl)+)
  apply(rule prog_corr_seq_assoc2, (rule prog_corr_refl)+)
  done

section "Structural correspondence rules"

lemma prog_corr_skips :
"\<rho>, \<rho>' \<Turnstile> SKIP \<sqsupseteq>\<^bsub>r\<^esub> SKIP"
  apply(simp add: prog_corr_def)
  apply(rule_tac x="{(Skip, Skip)}" in exI, simp)
  by(rule prog_corrC_skips)

lemma prog_corr_basics :
"(\<And>s t. (s, t) \<in> r \<Longrightarrow> (f s, f' t) \<in> r) \<Longrightarrow>
  \<rho>, \<rho>' \<Turnstile> Basic f \<sqsupseteq>\<^bsub>r\<^esub> Basic f'"
  apply(simp add: prog_corr_def)
  apply(rule_tac x="{(Basic f, Basic f'), (Skip, Skip)}" in exI, simp add: prog_corrC_def)
  apply(rule conjI, clarsimp)
   apply(drule Basic_pstep, clarsimp)
   apply(drule meta_spec, drule meta_spec, drule meta_mp, assumption)
   apply(rule exI, rule conjI, rule pstep.Basic, assumption)
  apply clarsimp
  by(erule Skip_pstep)

lemma prog_corr_cjumps :
"\<rho>, \<rho>' \<Turnstile> \<rho> i \<sqsupseteq>\<^bsub>r\<^esub> \<rho>' j \<Longrightarrow> \<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<Longrightarrow>
 \<forall>(s, t) \<in> r. (s \<in> C) = (t \<in> C') \<Longrightarrow>
  \<rho>, \<rho>' \<Turnstile> CJUMP C TO i OTHERWISE p END \<sqsupseteq>\<^bsub>r\<^esub> CJUMP C' TO j OTHERWISE p' END"
  apply(simp add: prog_corr_def, clarify)
  apply(rename_tac X Z)
  apply(rule_tac x="{(CJump C i p, CJump C' j p')} \<union> X \<union> Z" in exI, simp)
  apply(subst prog_corrC_def, simp)
  apply(rule conjI, clarsimp)
   apply(drule CJump_pstep, clarify)
   apply(erule disjE, clarsimp)
    apply(rename_tac s t')
    apply(rule_tac x=s in exI)
    apply(rule exI, rule conjI, rule pstep.CJumpT, fast)
    apply simp
   apply clarsimp
   apply(rename_tac s t')
   apply(rule_tac x=s in exI)
   apply(rule exI, rule conjI, rule pstep.CJumpF, fast)
   apply simp
  apply(rule conjI, clarsimp)
   apply(erule disjE)
    apply(drule prog_corrC_step[rotated -1], assumption+)
    apply fast
   apply(drule prog_corrC_step[rotated -1], assumption+)
   apply fast
  apply(rule conjI, clarify)+
    apply(rule prog_corrC_skipD2, assumption+)
   apply(clarify, rule prog_corrC_skipD2, assumption+)
  apply clarify
  apply(rule conjI, clarify)+
   apply(rule prog_corrC_skipD1, assumption+)
  apply(clarify, rule prog_corrC_skipD1, assumption+)
  done

lemma prog_corr_whiles :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<Longrightarrow> \<rho>, \<rho>' \<Turnstile> q \<sqsupseteq>\<^bsub>r\<^esub> q' \<Longrightarrow>
 \<forall>(s, t) \<in> r. (s \<in> C) = (t \<in> C') \<Longrightarrow>
  \<rho>, \<rho>' \<Turnstile> WHILE C \<lbrakk>inv: I\<rbrakk> DO p SUBSEQUENTLY q OD \<sqsupseteq>\<^bsub>r\<^esub>
          WHILE C' \<lbrakk>inv: I'\<rbrakk> DO p' SUBSEQUENTLY q' OD"
  apply(simp add: prog_corr_def, clarify)
  apply(rename_tac X Z)
  apply(rule_tac x="{(While C I p q,
                      While C' I' p' q')} \<union>
                    {(SKIP;While C I p q,
                      SKIP;While C' I' p' q')} \<union>
                    {(u ; (SKIP ; While C I p q),
                      v ; (SKIP ; While C' I' p' q')) | u v. (u, v) \<in> X} \<union>
                     Z" in exI, simp)
  apply(subst prog_corrC_def, simp)
  apply(rule conjI, clarsimp)
   apply(drule Seq_pstep_Skip, clarify)
  apply(intro exI, rule conjI, rule pstep.SeqSkip, fast)
  apply(rule conjI, clarsimp)
   apply(rename_tac s t p'' t')
   apply(drule While_pstep, clarify)
   apply(erule disjE, clarify)
    apply(rule_tac x=s in exI, simp)
    apply(rule exI, rule conjI, rule pstep.WhileT, fast, fast)
   apply clarsimp
   apply(rule_tac x=s in exI, simp)
   apply(rule exI, rule conjI, rule pstep.WhileF, fast, fast)
  apply(rule conjI, clarsimp)
   apply(erule disjE, clarify)
    apply(case_tac "v=SKIP", clarify)
     apply(drule prog_corrC_skipD2, assumption, clarify)
     apply(drule Seq_pstep_Skip, clarify)
     apply(intro exI, rule conjI, rule pstep.SeqSkip, fast)
    apply(drule Seq_pstep, simp, clarify)
    apply(drule prog_corrC_step[rotated -1], assumption+)
    apply clarsimp
    apply(intro exI, rule conjI, erule pstep.Seq, fast)
   apply(drule prog_corrC_step[rotated -1], assumption+)
   apply fast
  apply(rule conjI, clarify)
   apply(rule prog_corrC_skipD2, assumption+)
  apply(clarify, rule prog_corrC_skipD1, assumption+)
  done

subsection "Program correspondence and the parallel operator"

text "subsuming commutativity property"
theorem prog_corr_parallels :
"\<forall>i<length ps. \<rho>,\<rho>' \<Turnstile> fst(ps!\<sigma> i) \<sqsupseteq>\<^bsub>r\<^esub> fst(ps'!i) \<Longrightarrow> length ps = length ps' \<Longrightarrow>
 inj_on \<sigma> {0..<length ps'} \<Longrightarrow> \<forall>i<length ps'. \<sigma> i < length ps \<Longrightarrow>
 \<rho>,\<rho>' \<Turnstile> Parallel ps \<sqsupseteq>\<^bsub>r\<^esub> Parallel ps'"
  apply(clarsimp simp: prog_corr_def)
  apply(subst (asm) Skolem_list_nth)
  apply clarsimp
  apply(rename_tac Xs)
  apply(rule_tac x="{(Parallel u, Parallel v) |u v. length u = length v \<and> length v = length Xs \<and>
                     (\<forall>i<length v. prog_corrC \<rho> \<rho>' r (Xs ! i) \<and> (fst (u ! \<sigma> i), fst (v ! i)) \<in> Xs ! i)}
                    \<union> {(Skip, Skip)}"
        in exI, simp)
  apply(subst prog_corrC_def, clarsimp)
  apply(rule conjI, clarsimp)
   apply(erule Skip_pstep)
  apply clarsimp
  apply(rename_tac s t us p'' t' vs)
  apply(drule Parallel_pstep)
  apply(erule disjE, clarsimp)
   apply(frule_tac x=i in spec, drule mp, assumption, erule conjE)
   apply(drule_tac X="Xs!i" in prog_corrC_step[rotated -1], assumption+)
   apply clarify
   apply(rule_tac x=s' in exI)
  apply(rule exI, rule conjI, erule_tac i="\<sigma> i" in pstep.Parallel, simp, clarsimp)
   apply(rename_tac j)
   apply(case_tac "j = i", clarsimp)
   apply(subgoal_tac "\<sigma> j \<noteq> \<sigma> i")
    apply clarsimp
   apply clarify
   apply(erule notE, erule inj_onD, assumption, simp, simp)
  apply clarsimp
  apply(rule_tac x=s in exI, rule conjI, rule pstep.ParallelSkip)
  apply clarsimp
   apply(drule mem_nth, clarsimp)
   apply(frule_tac inj_on_surj_set_intv, assumption)
   apply(drule_tac x=i in spec, drule mp, assumption, erule exE)
   apply(rename_tac j, clarify)
   apply(drule_tac x=j in spec, drule mp, assumption, erule conjE)
   apply(drule prog_corrC_skipD2, assumption)
   apply(drule_tac f=fst in arg_cong, simp)
  by assumption

lemma prog_corr_parallels' :
"(\<And>i. i < length ps \<Longrightarrow> \<rho>, \<rho>' \<Turnstile> fst (ps ! i) \<sqsupseteq>\<^bsub>r\<^esub> fst (ps' ! i)) \<Longrightarrow>
 length ps = length ps' \<Longrightarrow>
  \<rho>, \<rho>' \<Turnstile> Parallel ps \<sqsupseteq>\<^bsub>r\<^esub> Parallel ps'"
  apply(rule prog_corr_parallels[where \<sigma>=id, simplified, rule_format])
  by(fast, assumption, simp)

lemma prog_corr_scheme :
"(\<And>i. n \<le> i \<Longrightarrow> i < m \<Longrightarrow> \<rho>, \<rho>' \<Turnstile> fst (f i) \<sqsupseteq>\<^bsub>r\<^esub> fst (g i)) \<Longrightarrow>
  \<rho>, \<rho>' \<Turnstile> Parallel (map f [n..<m]) \<sqsupseteq>\<^bsub>r\<^esub> Parallel (map g [n..<m])"
  apply(rule prog_corr_parallels')
  by simp+

lemma prog_corr_parallel_app :
"\<rho>, \<rho>' \<Turnstile> Parallel as \<sqsupseteq>\<^bsub>r\<^esub> Parallel as' \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> Parallel bs \<sqsupseteq>\<^bsub>r\<^esub> Parallel bs' \<Longrightarrow>
 length as = length as' \<Longrightarrow>
 length bs = length bs' \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> Parallel (as@bs) \<sqsupseteq>\<^bsub>r\<^esub> Parallel (as'@bs')"
  apply(simp add: prog_corr_def, clarify)
  apply(rename_tac A B)
  apply(rule_tac x="{(Parallel (xs@zs), Parallel (xs'@zs')) | xs zs xs' zs'.
                       (Parallel xs, Parallel xs') \<in> A \<and> length xs = length xs' \<and>
                       (Parallel zs, Parallel zs') \<in> B \<and> length zs = length zs'}
                    \<union> {(Skip, Skip)}" in exI, simp)
  apply(subst prog_corrC_def, clarsimp)
  apply(rule conjI, clarsimp)
   apply(erule Skip_pstep)
  apply(rule conjI, clarsimp)
   apply(drule Parallel_pstep)
   apply(erule disjE, clarsimp)
    apply(case_tac "i < length xs'")
     apply(subst (asm) nth_append, simp)
     apply(frule_tac p'="Parallel xs'" and X=A in prog_corrC_step[rotated 1], assumption)
       apply(erule pstep.Parallel, assumption+)
     apply clarsimp
     apply(drule Parallel_pstep)
     apply(erule disjE, clarsimp)
      apply(rename_tac j p'')
      apply(intro exI, rule conjI, rule_tac i=j in pstep.Parallel)
        apply(subst nth_append, simp)
       apply simp
      apply(subst list_update_append, simp)+
      apply(subst nth_append, simp)+
      apply(intro exI, rule conjI, rule refl)+
      apply simp
     apply clarsimp
     apply(drule_tac X=A in prog_corrC_skipD1, assumption)
     apply clarify
    apply(drule leI)
    apply(subst (asm) nth_append, simp)
    apply(frule_tac p'="Parallel zs'" and X=B in prog_corrC_step[rotated 1], assumption)
      apply(erule pstep.Parallel, simp, assumption+)
    apply clarsimp
    apply(drule Parallel_pstep)
    apply(erule disjE, clarsimp)
     apply(rename_tac j p'')
     apply(intro exI, rule conjI, rule_tac i="j+length xs" in pstep.Parallel)
       apply(subst nth_append, simp)
      apply simp
     apply(subst list_update_append, simp)+
     apply(subst nth_append, simp)+
     apply(intro exI, rule conjI, rule refl)+
     apply simp
    apply clarsimp
    apply(drule_tac X=B in prog_corrC_skipD1, assumption)
    apply clarify
   apply clarsimp
   apply(rule exI, rule conjI)
    apply(rule pstep.ParallelSkip)
    apply(frule_tac p="Parallel xs" in prog_corrC_step, assumption+)
     apply(rule pstep.ParallelSkip, clarsimp)
    apply clarsimp
    apply(drule_tac X=A in prog_corrC_skipD2, assumption)
    apply clarify
    apply(drule Parallel_pstep_to_Skip)
    apply(frule_tac p="Parallel zs" in prog_corrC_step, assumption+)
     apply(rule pstep.ParallelSkip, clarsimp)
    apply clarsimp
    apply(drule_tac X=B in prog_corrC_skipD2, assumption)
    apply clarify
    apply(drule Parallel_pstep_to_Skip)
    apply fastforce
   apply assumption
  apply(intro exI, rule conjI, rule refl)+
  by simp

lemma prog_corr_parallel_Cons :
"\<rho>, \<rho>' \<Turnstile> Parallel ps \<sqsupseteq>\<^bsub>r\<^esub> Parallel ps' \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<Longrightarrow>
 length ps = length ps' \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> Parallel ((p, a)#ps) \<sqsupseteq>\<^bsub>r\<^esub> Parallel ((p', a')#ps')"
  apply(drule_tac as="[(p,a)]" and as'="[(p',a')]" in prog_corr_parallel_app[rotated 1])
     apply(simp, assumption)
   apply(rule prog_corr_parallels', simp)
  by simp+

subsection "Further rules"

lemma prog_corr_seqs :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<Longrightarrow> \<rho>, \<rho>' \<Turnstile> q \<sqsupseteq>\<^bsub>r\<^esub> q' \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> (p;q) \<sqsupseteq>\<^bsub>r\<^esub> (p';q')"
  apply(clarsimp simp: prog_corr_def)
  apply(rename_tac X Z)
  apply(rule_tac x="{(Seq u q, Seq v q') | u v. (u, v) \<in> X} \<union> Z" in exI, simp)
  apply(subst prog_corrC_def, simp)
  apply(rule conjI, clarsimp)
   apply(erule disjE, clarsimp)
  apply(case_tac "v=Skip", clarify)
     apply(drule prog_corrC_skipD2, assumption)
     apply clarify
     apply(drule Seq_pstep_Skip, clarsimp)
     apply(intro exI, rule conjI, rule pstep.SeqSkip)
     apply fast
    apply(drule Seq_pstep, assumption)
    apply clarsimp
    apply(drule_tac p'=v in prog_corrC_step, assumption+)
    apply clarify
    apply(intro exI, rule conjI, erule pstep.Seq)
    apply fast
   apply(drule_tac X=Z in prog_corrC_step[rotated 2], assumption+)
   apply fast
  apply(rule conjI, clarsimp)
   apply(erule prog_corrC_skipD2, assumption)
  apply clarify
  apply(erule prog_corrC_skipD1, assumption)
  done

lemma prog_corr_conds :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<Longrightarrow> \<rho>, \<rho>' \<Turnstile> q \<sqsupseteq>\<^bsub>r\<^esub> q' \<Longrightarrow>
 \<forall>(s, t) \<in> r. (s \<in> C) = (t \<in> C') \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> (IF C THEN p ELSE q FI) \<sqsupseteq>\<^bsub>r\<^esub>
           IF C' THEN p' ELSE q' FI"
  apply(clarsimp simp: prog_corr_def)
  apply(rename_tac X Z)
  apply(rule_tac x="{(Cond C p q, Cond C' p' q')} \<union> X \<union> Z" in exI, simp)
  apply(subst prog_corrC_def, simp)
  apply(rule conjI, clarsimp)
   apply(drule Cond_pstep, clarify)
   apply(erule disjE, clarsimp)
    apply(rename_tac s t)
    apply(rule_tac x=s in exI)
    apply(rule exI, rule conjI, rule pstep.CondT, fast, fast)
   apply clarsimp
   apply(rename_tac s t)
   apply(rule_tac x=s in exI)
   apply(rule exI, rule conjI, rule pstep.CondF, fast, fast)
  apply(rule conjI, clarsimp)
   apply(erule disjE)
    apply(drule_tac X=X in prog_corrC_step[rotated 2], assumption+)
    apply fast
   apply(drule_tac X=Z in prog_corrC_step[rotated 2], assumption+)
   apply fast
  apply(rule conjI, clarsimp)+
    apply(erule prog_corrC_skipD2, assumption)
   apply clarify
   apply(erule prog_corrC_skipD2, assumption)
  apply(rule allI, rule conjI)
   apply clarify
   apply(erule prog_corrC_skipD1, assumption)
  apply clarify
  apply(erule prog_corrC_skipD1, assumption)
  done

lemma prog_corr_awaits :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<Longrightarrow>
 \<forall>(s, t) \<in> r. t \<in> C' \<longrightarrow> s \<in> C \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> (AWAIT C \<lbrakk>ann: a\<rbrakk> THEN p END) \<sqsupseteq>\<^bsub>r\<^esub> AWAIT C' \<lbrakk>ann: a'\<rbrakk> THEN p' END"
  apply(clarsimp simp: prog_corr_def)
  apply(rename_tac X)
  apply(rule_tac x="{(Await C a p, Await C' a' p')} \<union> X" in exI, simp)
  apply(subst prog_corrC_def, simp)
  apply(rule conjI, clarsimp)
   apply(drule Await_pstep, clarify)
   apply(subst (asm) rtranclp_power, clarify)
   apply(drule prog_corrC_steps[rotated 1], assumption+)
   apply clarify
   apply(frule prog_corrC_skipD2, assumption)
   apply clarify
   apply(drule rtranclp_power[THEN iffD2, OF exI])+
   apply(intro exI, rule conjI, rule pstep.Await, fast, assumption)
   apply simp
  apply(rule conjI, clarsimp)
   apply(drule_tac X=X in prog_corrC_step[rotated 2], assumption+)
   apply fast
  apply(rule conjI, clarsimp)
   apply(erule prog_corrC_skipD2, assumption)
  apply clarify
  apply(erule prog_corrC_skipD1, assumption)
  done

lemma prog_corr_await_basic :
"\<forall>(s, t) \<in> r. s \<in> C \<and> (\<exists>s'. \<rho> \<turnstile> (p, s) -p\<rightarrow>\<^sup>* (SKIP, s') \<and> (s', f t) \<in> r) \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> (AWAIT C \<lbrakk>ann: a\<rbrakk> THEN p END) \<sqsupseteq>\<^bsub>r\<^esub> Basic f"
  apply(clarsimp simp: prog_corr_def)
  apply(rule_tac x="{(Await C a p, Basic f), (SKIP, SKIP)}" in exI, simp)
  apply(simp add: prog_corrC_def)
  apply(rule conjI, clarsimp)
   apply(drule Basic_pstep, clarify)
   apply(drule bspec, assumption)
   apply clarsimp
   apply(rule exI, rule conjI, erule pstep.Await, assumption+)
  apply clarsimp
  apply(erule Skip_pstep)
  done

corollary prog_corr_atomic2_basic :
"\<forall>(s, t) \<in> r. (h(g s), f t) \<in> r \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> (AWAIT UNIV \<lbrakk>ann: a\<rbrakk> THEN Basic g; Basic h END) \<sqsupseteq>\<^bsub>r\<^esub> Basic f"
  apply(rule prog_corr_await_basic, clarsimp)
  apply(drule bspec, assumption, clarsimp)
  apply(rule exI, rule conjI)
    apply(rule rtranclp_trans)
     apply(rule r_into_rtranclp)
     apply(rule pstep.Seq)
     apply(rule pstep.Basic)
    apply(rule rtranclp_trans)
     apply(rule r_into_rtranclp)
     apply(rule pstep.SeqSkip)
    apply(rule r_into_rtranclp)
   apply(rule pstep.Basic)
  by simp

corollary prog_corr_atomic3_basic :
"\<forall>(s, t) \<in> r. (g3(g2(g1 s)), f t) \<in> r \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> (AWAIT UNIV \<lbrakk>ann: a\<rbrakk> THEN Basic g1; Basic g2; Basic g3 END) \<sqsupseteq>\<^bsub>r\<^esub> Basic f"
  apply(rule prog_corr_await_basic, clarsimp)
  apply(drule bspec, assumption, clarsimp)
  apply(rule exI, rule conjI)
   apply(rule rtranclp_trans)
    apply(rule rtranclp_trans)
     apply(rule r_into_rtranclp)
     apply(rule pstep.Seq)
     apply(rule pstep.Basic)
    apply(rule r_into_rtranclp)
    apply(rule pstep.SeqSkip)
   apply(rule rtranclp_trans)
    apply(rule rtranclp_trans)
     apply(rule r_into_rtranclp)
     apply(rule pstep.Seq)
     apply(rule pstep.Basic)
    apply(rule r_into_rtranclp)
    apply(rule pstep.SeqSkip)
   apply(rule r_into_rtranclp)
   apply(rule pstep.Basic)
  by assumption

lemma prog_corr_basic_await :
"\<forall>(s, t) \<in> r. \<forall>t'. t \<in> C \<longrightarrow> \<rho>' \<turnstile> (p, t) -p\<rightarrow>\<^sup>* (SKIP, t') \<longrightarrow> (f s, t') \<in> r \<Longrightarrow>
 \<rho>, \<rho>' \<Turnstile> Basic f \<sqsupseteq>\<^bsub>r\<^esub> (AWAIT C \<lbrakk>ann: a\<rbrakk> THEN p END)"
  apply(clarsimp simp: prog_corr_def)
  apply(rule_tac x="{(Basic f, Await C a p), (SKIP, SKIP)}" in exI, simp)
  apply(simp add: prog_corrC_def)
  apply(rule conjI, clarsimp)
   apply(drule bspec, assumption)
   apply clarsimp
   apply(drule Await_pstep, clarsimp)
   apply(drule spec, drule mp, assumption)
   apply(rule exI, rule conjI, rule pstep.Basic)
   apply assumption
  apply clarify
  by(erule Skip_pstep)

lemmas prog_corr_basic_atomic = prog_corr_basic_await[where C=UNIV, simplified]

section "Replacement rules for the seq-normalisation"

lemma prog_corr_seqN_cond1 :
"\<rho> \<Turnstile> IF C THEN p ELSE q FI; r \<sqsupseteq>
      IF C THEN p;r ELSE q;r FI"
  apply(simp add: prog_corr_def)
  apply(rule_tac x="{(Seq (Cond C p q) r, Cond C (Seq p r) (Seq q r))} \<union> Id" in exI, simp)
  apply(simp (no_asm) add: prog_corrC_def)
  apply(rule conjI, clarsimp)
   apply(drule Cond_pstep, clarify)
   apply(erule disjE, clarify)
    apply(rule exI, rule conjI, rule pstep.Seq, erule pstep.CondT, simp)
   apply clarify
    apply(rule exI, rule conjI, rule pstep.Seq, erule pstep.CondF, simp)
  apply fast
  done

lemma prog_corr_seqN_cond2 :
"\<rho> \<Turnstile> IF C THEN p;r ELSE q;r FI \<sqsupseteq>
      (IF C THEN p ELSE q FI; r)"
  apply(simp add: prog_corr_def)
  apply(rule_tac x="{(Cond C (Seq p r) (Seq q r), Seq (Cond C p q) r)} \<union> Id" in exI, simp)
  apply(simp (no_asm) add: prog_corrC_def)
  apply(rule conjI, clarsimp)
   apply(drule Seq_pstep, simp, clarsimp)
   apply(drule Cond_pstep, clarify)
   apply(erule disjE, clarify)
    apply(rule exI, rule conjI, erule pstep.CondT, simp)
   apply clarify
    apply(rule exI, rule conjI, erule pstep.CondF, simp)
  apply fast
  done

corollary eqv_seqN_cond :
"\<rho> \<Turnstile> IF C THEN p ELSE q FI; r \<approx> IF C THEN p;r ELSE q;r FI"
  by(simp add: small_step_eqv, rule conjI, rule prog_corr_seqN_cond1,
     rule prog_corr_seqN_cond2)

lemma prog_corr_seqN_while1 :
"\<rho> \<Turnstile> WHILE C \<lbrakk>inv: I\<rbrakk> DO p SUBSEQUENTLY q OD; r \<sqsupseteq>
      WHILE C \<lbrakk>inv: I'\<rbrakk> DO p SUBSEQUENTLY q;r OD"
  apply(simp add: prog_corr_def)
  apply(rule_tac x="{(Seq (While C I p q) r, While C I' p (Seq q r)),
                     (Seq (Seq Skip (While C I p q)) r,
                      Seq Skip (While C I' p (Seq q r)))} \<union>
                     {(Seq (Seq u (Seq Skip (While C I p q))) r,
                       Seq u (Seq Skip (While C I' p (Seq q r)))) |u. u \<in> UNIV} \<union> Id" in exI, simp)
  apply(simp (no_asm) add: prog_corrC_def)
  apply(rule conjI, clarsimp)
   apply(drule While_pstep, clarify)
   apply(erule disjE, clarsimp)
    apply(rule exI, rule conjI)
    apply(rule pstep.Seq, erule pstep.WhileT)
    apply clarsimp
   apply clarsimp
   apply(rule pstep.Seq, erule pstep.WhileF)
  apply clarsimp
  apply(rule conjI, clarsimp)
   apply(drule Seq_pstep_Skip)
   apply clarsimp
   apply(rule exI, rule conjI, rule pstep.Seq, rule pstep.SeqSkip)
   apply clarsimp+
  apply(erule disjE, clarsimp)
   apply(case_tac "u = Skip", clarsimp)
    apply(drule Seq_pstep_Skip)
    apply clarsimp
    apply(rule exI, rule conjI, rule pstep.Seq, rule pstep.SeqSkip)
    apply clarsimp
   apply(drule Seq_pstep, assumption)
   apply clarsimp
   apply(rule exI, rule conjI, rule pstep.Seq, erule pstep.Seq)
   apply clarsimp
  apply fastforce
  done

lemma prog_corr_seqN_while2 :
"\<rho> \<Turnstile> WHILE C \<lbrakk>inv: I\<rbrakk> DO p SUBSEQUENTLY q;r OD \<sqsupseteq>
      WHILE C \<lbrakk>inv: I'\<rbrakk> DO p SUBSEQUENTLY q OD; r "
  apply(simp add: prog_corr_def)
  apply(rule_tac x="{(While C I p (Seq q r), Seq (While C I' p q) r),
                     (Seq Skip (While C I p (Seq q r)),
                      Seq (Seq Skip (While C I' p q)) r)} \<union>
                     {(Seq u (Seq Skip (While C I p (Seq q r))),
                       Seq (Seq u (Seq Skip (While C I' p q))) r) |u. u \<in> UNIV} \<union> Id" in exI, simp)
  apply(simp (no_asm) add: prog_corrC_def)
  apply(rule conjI, clarsimp)
   apply(drule Seq_pstep, simp)
   apply clarsimp
   apply(drule While_pstep, clarify)
   apply(erule disjE, clarsimp)
    apply(rule exI, rule conjI, erule pstep.WhileT)
    apply clarsimp+
   apply(erule pstep.WhileF)
   apply simp
  apply(rule conjI, clarsimp)
   apply(drule Seq_pstep, simp)
   apply clarify
   apply(drule Seq_pstep_Skip, simp)
   apply(rule exI, rule conjI, rule pstep.SeqSkip)
   apply simp
  apply clarsimp
  apply(erule disjE, clarsimp)
   apply(drule Seq_pstep, simp)
   apply clarify
   apply(case_tac "u = Skip", clarify)
    apply(drule Seq_pstep_Skip, simp)
    apply(rule exI, rule conjI, rule pstep.SeqSkip)
    apply simp
   apply(drule Seq_pstep, simp)
   apply clarify
   apply(rule exI, rule conjI, erule pstep.Seq)
   apply clarsimp
  apply fast
  done

corollary eqv_seqN_while :
"\<rho> \<Turnstile> WHILE C \<lbrakk>inv: I\<rbrakk> DO p SUBSEQUENTLY q OD; r \<approx>
      WHILE C \<lbrakk>inv: I'\<rbrakk> DO p SUBSEQUENTLY q;r OD "
  by(simp add: small_step_eqv, rule conjI, rule prog_corr_seqN_while1,
     rule prog_corr_seqN_while2)

section "if-normalisation"

lemma prog_corr_condN1 :
"\<rho> j = q \<Longrightarrow>
 \<rho> \<Turnstile> IF C THEN p ELSE q FI \<sqsupseteq>
          CJUMP -C TO j OTHERWISE p END"
  apply(clarsimp simp:prog_corr_def)
  apply(rule_tac x="{(IF C THEN p ELSE q FI, CJUMP -C TO j OTHERWISE p END)} \<union> Id" in exI, simp)
  apply(simp (no_asm) add: prog_corrC_def)
  apply(rule conjI, clarsimp)
   apply(drule CJump_pstep, clarify)
   apply(erule disjE, clarsimp)
    apply(rule exI, rule conjI, erule pstep.CondF, simp)
   apply clarsimp
   apply(erule pstep.CondT, simp)
  apply clarsimp
  apply(rule_tac x=p'' in exI, simp)
  done

lemma prog_corr_condN2 :
"\<rho> j = q \<Longrightarrow>
 \<rho> \<Turnstile> CJUMP -C TO j OTHERWISE p END \<sqsupseteq> IF C THEN p ELSE q FI"
  apply(clarsimp simp:prog_corr_def)
  apply(rule_tac x="{(CJUMP -C TO j OTHERWISE p END, IF C THEN p ELSE q FI)} \<union> Id" in exI, simp)
  apply(simp (no_asm) add: prog_corrC_def)
  apply(rule conjI, clarsimp)
   apply(drule Cond_pstep, clarify)
   apply(erule disjE, clarsimp)
    apply(rule pstep.CJumpF, simp, simp)
   apply(rule pstep.CJumpT, simp, simp)
  apply clarsimp
  apply fast
  done

corollary eqv_condN :
"\<rho> j = q \<Longrightarrow>
 \<rho> \<Turnstile> IF C THEN p ELSE q FI \<approx> CJUMP -C TO j OTHERWISE p END"
  apply(clarsimp simp: small_step_eqv)
  apply(rule conjI)
   apply(rule prog_corr_condN1, rule refl)
  apply(rule prog_corr_condN2, rule refl)
  done

section "while-normalisation"

lemma eqv_while_cjump :
"\<rho> j = CJUMP -C TO i OTHERWISE p;JUMP j END \<Longrightarrow>
 \<rho> i = q \<Longrightarrow>
 \<rho> \<Turnstile> WHILE C \<lbrakk>inv: I\<rbrakk> DO p SUBSEQUENTLY q OD \<approx>
         CJUMP -C TO i OTHERWISE p;JUMP j END"
  apply(clarsimp simp: small_step_eqv)
  apply(rule conjI)
   apply(subst prog_corr_def)
   apply clarsimp
   apply(rule_tac x="{(While C I p (\<rho> i), CJump (-C) i (Seq p (Jump j))),
                     (Seq Skip (While C I p q), Jump j)} \<union>
          {(Seq u (Seq Skip (While C I p q)), Seq u (Jump j)) |u. u \<in> UNIV} \<union> Id"
     in exI)
   apply(simp add: prog_corrC_def)
   apply(rule conjI, clarsimp)
    apply(drule CJump_pstep, clarsimp)
    apply(erule disjE, clarsimp)
     apply(rule_tac x="\<rho> i" in exI, simp)
     apply(erule pstep.WhileF)
    apply clarsimp
    apply(rule exI, rule conjI, erule pstep.WhileT, simp)
   apply(rule conjI, clarsimp)
    apply(drule Jump_pstep, clarsimp)
    apply(rule exI, rule conjI, rule pstep.SeqSkip, simp)
   apply(rule conjI, clarsimp)
    apply(erule disjE, clarsimp)
     apply(case_tac "u = Skip", clarify)
      apply(drule Seq_pstep_Skip, clarsimp)
      apply(rule exI, rule conjI, rule pstep.SeqSkip, simp)
     apply(drule Seq_pstep, assumption, clarsimp)
     apply(rule exI, rule conjI, erule pstep.Seq, simp)
    apply fast
   apply(clarsimp simp: Jump_def)
  apply(subst prog_corr_def)
  apply clarsimp
   apply(rule_tac x="{(CJump (-C) i (Seq p (Jump j)), While C I p (\<rho> i)),
                     (Jump j, Seq Skip (While C I p q))} \<union>
          {(Seq u (Jump j), Seq u (Seq Skip (While C I p q))) |u. u \<in> UNIV} \<union> Id"
     in exI)
  apply(simp add: prog_corrC_def)
  apply(rule conjI, clarsimp)
   apply(drule While_pstep, clarsimp)
   apply(erule disjE, clarsimp)
    apply(rule exI, rule conjI, rule pstep.CJumpF, simp, simp)
   apply clarsimp
   apply(rule pstep.CJumpT, simp, simp)
  apply(rule conjI, clarsimp)
   apply(drule Seq_pstep_Skip, clarsimp)
   apply(subst Jump_def)
   apply(rule exI, rule conjI, rule pstep.CJumpT, simp, simp)
  apply(rule conjI, clarsimp)
   apply(erule disjE, clarsimp)
    apply(case_tac "u = Skip", clarify)
     apply(drule Seq_pstep_Skip, clarsimp)
     apply(rule exI, rule conjI, rule pstep.SeqSkip, simp)
    apply(drule Seq_pstep, assumption, clarsimp)
    apply(rule exI, rule conjI, erule pstep.Seq, simp)
   apply fast
  apply(clarsimp simp: Jump_def)
  done

section "Program correspondence and R/G properties"

theorem prog_corr_sq_replay :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<Longrightarrow>
 sq \<in> EnvCond \<rho>' R' \<Longrightarrow>
 r O R' \<subseteq> R O r \<Longrightarrow>
 sq!0 = ((p', t), tk) \<Longrightarrow>
 (s, t) \<in> r \<Longrightarrow>
 \<exists>sq'\<in>EnvCond \<rho> R. sq'!0 = ((p, s), tk) \<and>
      length sq = length sq' \<and>
   (\<forall>i<length sq. (\<rho>, \<rho>' \<Turnstile> progOf(sq'!i) \<sqsupseteq>\<^bsub>r\<^esub> progOf(sq!i)) \<and>
                  (stateOf(sq'!i), stateOf(sq!i)) \<in> r \<and>
                  tkOf(sq'!i) = tkOf(sq!i))"
  apply(subgoal_tac "sq \<in> COMP \<rho>'")
   prefer 2
   apply(simp add: EnvCond_def pcs_def)
  apply(induct sq rule: rev_induct)
   apply(drule COMP_noNil, clarify)
  apply(rename_tac a sq)
  apply(case_tac "sq = []")
   apply clarsimp
   apply(rule_tac x="[((p, s), tk)]" in bexI, simp)
   apply(simp add: EnvCond_def)
   apply(rule_tac x=p in exI, simp add: pcs_def)
   apply(simp (no_asm) add: COMP_eq)
  apply clarsimp
  apply(rename_tac p1 t1 tk1 sq)
  apply(subst (asm) nth_append, simp)
  apply(drule meta_mp)
   apply(erule EnvCond_prefix_cls, simp (no_asm) add: prefix_def, assumption, rule subset_refl)
  apply(drule meta_mp, erule COMP_prefix_cls, simp (no_asm) add: prefix_def, assumption)
  apply clarsimp
  apply(frule_tac x="length sq' - 1" in spec, drule mp, rule pred_less, simp, clarsimp)
  apply(case_tac "sq!(length sq' - 1)", clarsimp)
  apply(rename_tac p0 t0)
  apply(case_tac "sq'!(length sq' - 1)", clarsimp)
  apply(rename_tac p0' t0' tk0')
  apply(case_tac tk1, simp)
   apply(frule_tac i="length sq" in COMP_nth, simp, clarsimp)
   apply(subst (asm) nth_append, simp)+
   apply(simp split: if_splits)
    apply(drule stepR_D1)
    apply(drule prog_corr_step[rotated -1], assumption+)
    apply clarify
    apply(rule_tac x="sq' @ [((p''', s'), True)]" in bexI, simp)
     apply(rule conjI)
      apply(subst nth_append, clarsimp)
     apply clarsimp
     apply(subst nth_append, simp)
     apply(rule conjI, clarify)
      apply(subst nth_append, simp)+
    apply(subst EnvCond_def, simp)
    apply(rule conjI)
     apply(rule_tac x=p in exI)
     apply(simp add: pcs_def)
     apply(rule conjI)
      apply(rule COMP_compose2)
       apply(simp add: EnvCond_def pcs_def)
      apply(subst last_conv_nth, clarsimp)
      apply(simp (no_asm) add: COMP_eq)
      apply(clarsimp simp: stepR_def)
      apply(rule_tac x=True in exI, simp)
     apply(subst hd_conv_nth, simp)
     apply(subst nth_append, clarsimp)
    apply(clarsimp simp: cstep_cond_def)
    apply(case_tac "i = length sq'", clarsimp)
    apply(subst (asm) nth_append, simp)+
    apply(subst (asm) nth_append, simp split: if_splits)
    apply(erule_tac i=i in EnvCond_D, simp, assumption, erule sym, assumption)
   apply(erule notE, rule pred_less[simplified], clarsimp)
  apply clarsimp
  apply(drule_tac i="length sq" and c=p0 and s=t0 and tk=tk0' in EnvCond_D, simp, clarsimp)
    apply(subst nth_append, simp)
    apply(clarify, erule notE, rule pred_less[simplified], clarsimp)
   apply(subst nth_append, simp)
  apply(drule_tac c="(t0', t1)" in subsetD)
   apply(erule relcompI, assumption)
  apply clarsimp
  apply(rename_tac t0' t1' t1)
  apply(rule_tac x="sq' @ [((p0', t1'), False)]" in bexI, simp)
   apply(rule conjI)
    apply(subst nth_append, clarsimp)+
    apply(drule_tac i="length sq" in COMP_nth, simp, simp, clarsimp)
   apply clarsimp
   apply(subst (asm) nth_append, simp split: if_splits)+
    apply(drule stepR_D2, clarify)
   apply(clarify, erule notE, rule pred_less[simplified], clarsimp)
  apply(subst EnvCond_def, simp)
  apply(rule conjI, rule_tac x=p in exI)
   apply(simp add: pcs_def)
   apply(subst hd_conv_nth, clarsimp)
   apply(rule conjI)
     apply(rule COMP_compose2, simp add: EnvCond_def pcs_def)
    apply(subst last_conv_nth, clarsimp)
    apply(simp (no_asm) add: COMP_eq)
    apply(clarsimp simp: stepR_def)
    apply(rule_tac x="False" in exI, simp)
   apply(subst nth_append, clarsimp)
  apply clarify
  apply(case_tac "i=length sq", clarsimp)
   apply(subst nth_append, simp)+
   apply(simp add: cstep_cond_def)
  apply(subst nth_append, simp)+
  apply(rule conjI, clarsimp simp: cstep_cond_def)
   apply(erule_tac i=i in EnvCond_D, simp, assumption, erule sym, assumption)
  apply(clarify, erule notE, rule less_trans, rule pred_less[simplified], clarsimp)
  by simp

corollary prog_corr_sq_replayId :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq> p' \<Longrightarrow>
 sq \<in> COMP \<rho>' \<Longrightarrow>
 sq!0 = ((p', s), tk) \<Longrightarrow>
 \<exists>sq' \<in> COMP \<rho>. \<exists>tk'. sq'!0 = ((p, s), tk') \<and>
      length sq = length sq' \<and>
   (\<forall>i<length sq. (\<rho>, \<rho>' \<Turnstile> progOf(sq'!i) \<sqsupseteq> progOf(sq!i)) \<and>
                  stateOf(sq'!i) = stateOf(sq!i) \<and>
                  tkOf(sq'!i) = tkOf(sq!i))"
  apply(drule_tac sq=sq and R'=UNIV and R=UNIV in prog_corr_sq_replay)
      apply(clarsimp simp: EnvCond_def pcs_def cstep_cond_def)
      apply(subst hd_conv_nth, erule COMP_noNil)
      apply fast+
  apply(erule bexE)
  apply(rule_tac x=sq' in bexI)
   apply simp
  apply(clarsimp simp: EnvCond_def pcs_def)
  done

theorem prog_corr_RG :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq>\<^bsub>r\<^esub> p' \<Longrightarrow>
 \<rho> \<Turnstile> {R, P} p {Q, G} \<Longrightarrow>
 r O R' \<subseteq> R O r \<Longrightarrow>
 P' \<subseteq> r `` P \<Longrightarrow>
 r `` Q \<subseteq> Q' \<Longrightarrow>
 r\<inverse> O G O r \<subseteq> G' \<Longrightarrow>
 \<rho>' \<Turnstile> {R', P'} p' {Q', G'}"
  apply(subst HoareTripleRG_def, clarify)
  apply(rename_tac sq)
  apply(clarsimp simp: InitCond_def)
  apply(subgoal_tac "c=p'", clarify)
   apply(subst (asm) hd_conv_nth, erule pcs_noNil)
   apply(drule subsetD, assumption, clarify)
   apply(drule prog_corr_sq_replay, assumption+)
   apply clarsimp
   apply(subst (asm) HoareTripleRG_def)
   apply(subgoal_tac "sq' \<in> \<lbrakk>p\<rbrakk>\<^sub>\<rho>")
   apply(drule_tac c=sq' in subsetD, simp add: InitCond_def)
     apply(rule conjI, erule exI)
     apply(subst hd_conv_nth, erule pcs_noNil)
     apply simp
    apply clarify
    apply(rule conjI)
     apply(subst TermCond_def, simp)
     apply(rule conjI, erule exI)
     apply clarify
     apply(frule_tac x=j in spec, drule mp, simp)
     apply clarsimp
     apply(drule prog_corr_skipD2)
     apply(drule_tac TermCond_D)
     apply(drule_tac x=j in spec, drule mp, simp, drule mp, assumption)
     apply clarsimp
     apply(drule_tac x=i in spec, drule mp, simp)
     apply clarsimp
     apply(drule prog_corr_skipD1)
     apply(drule_tac c="stateOf (sq ! i)" in subsetD, erule ImageI, assumption)
     apply(rule_tac x=i in exI, simp)
     apply(case_tac "sq!i", clarsimp)
    apply(subst ProgCond_def, simp)
    apply(rule conjI, erule exI)
    apply(clarsimp simp: cstep_cond_def)
    apply(drule_tac t="sq ! (i - Suc 0)" in sym)
    apply(case_tac "sq'!(i-1)", clarsimp)
    apply(rename_tac p0 s0 tk0)
    apply(case_tac "sq'!i", clarsimp)
    apply(rename_tac p1 s1 tk1)
    apply(frule_tac x="i-1" in spec, drule_tac P="i-1<length sq'" in mp, simp)
    apply(drule_tac x=i in spec, drule mp, assumption)
    apply clarsimp
    apply(drule_tac i=i in ProgCond_D, assumption+)
    apply(erule subsetD)
    apply fast
   apply(clarsimp simp: EnvCond_def pcs_def)
   apply(subst (asm) hd_conv_nth, erule COMP_noNil)+
   apply simp
  apply(clarsimp simp: pcs_def)
  done

corollary prog_corr_RG_sub :
"\<rho>, \<rho>' \<Turnstile> p \<sqsupseteq> p' \<Longrightarrow>
 \<rho> \<Turnstile> {R, P} p {Q, G} \<Longrightarrow>
 \<rho>' \<Turnstile> {R, P} p' {Q, G}"
  by(erule prog_corr_RG, assumption, clarsimp+)

corollary prog_corr_RG_eq :
"\<rho>, \<rho>' \<Turnstile> p \<approx> p' \<Longrightarrow>
 (\<rho> \<Turnstile> {R, P} p {Q, G}) = (\<rho>' \<Turnstile> {R, P} p' {Q, G})"
  apply(clarsimp simp: small_step_eqv)
  apply(rule iffI)
   apply(erule prog_corr_RG_sub, assumption)+
  done

corollary ConseqRG:
"\<rho> \<Turnstile> {R, S} p {Q, G}  \<Longrightarrow>
 R' \<subseteq> R \<Longrightarrow> S' \<subseteq> S \<Longrightarrow> Q \<subseteq> Q' \<Longrightarrow> G \<subseteq> G' \<Longrightarrow>
 \<rho> \<Turnstile> {R', S'} p {Q', G'}"
  apply(rule_tac r=Id in prog_corr_RG)
       apply(rule prog_corr_refl)
      apply assumption
  by fast+

corollary ConseqRG2:
"\<rho> \<Turnstile>\<^sub>2 {R, S} p {T, G}  \<Longrightarrow>
 R' \<subseteq> R \<Longrightarrow> S' \<subseteq> S \<Longrightarrow> T \<subseteq> T' \<Longrightarrow> G \<subseteq> G' \<Longrightarrow>
 \<rho> \<Turnstile>\<^sub>2 {R', S'} p {T', G'}"
  apply(clarsimp simp: HoareTripleRG2_def)
  apply(drule_tac x=\<sigma> in spec)
  by(erule ConseqRG, simp_all, fast+)

section "Plain syntax-directed tactic for program correspondences"

lemma PCasesE :
"i < Suc n \<Longrightarrow> (i = n \<Longrightarrow> P i) \<Longrightarrow> (i < n \<Longrightarrow> P i) \<Longrightarrow> P i"
by(erule Nat.less_SucE, simp_all)

lemma PCasesE' :
"i < Suc n \<Longrightarrow> P n \<Longrightarrow> (i < n \<Longrightarrow> P i) \<Longrightarrow> P i"
by(erule PCasesE, simp_all)

ML \<open>

fun rts ctxt t i =
  resolve_tac ctxt t i

fun rt ctxt t i =
  resolve_tac ctxt [t] i

fun et ctxt t i =
  eresolve_tac ctxt [t] i

fun dt ctxt t i =
  dresolve_tac ctxt [t] i

fun PlainProgCorrTac props ctxt i =
FIRST[rt ctxt (@{thm ProgCorr.prog_corr_seqs}) i,
      ((rt ctxt (@{thm ProgCorr.prog_corr_scheme})) THEN_ALL_NEW clarsimp_tac ctxt) i,
      ((rt ctxt (@{thm ProgCorr.prog_corr_parallels'})) THEN_ALL_NEW clarsimp_tac ctxt) i,
      rt ctxt (@{thm ProgCorr.prog_corr_whiles}) i,
      rt ctxt (@{thm ProgCorr.prog_corr_conds}) i,
      rt ctxt (@{thm ProgCorr.prog_corr_cjumps}) i,
        rt ctxt (@{thm ProgCorr.prog_corr_atomic2_basic}) i,
        rt ctxt (@{thm ProgCorr.prog_corr_atomic3_basic}) i,
      rt ctxt (@{thm ProgCorr.prog_corr_await_basic}) i,
      ((rt ctxt (@{thm ProgCorr.prog_corr_basics})) THEN_ALL_NEW clarsimp_tac ctxt) i,
      rt ctxt (@{thm ProgCorr.prog_corr_skips}) i,
      (et ctxt (@{thm PCasesE'}) i) THEN (safe_simp_tac ctxt i),
       rts ctxt props i
]

fun plain_prog_corr_tac props ctxt =
 SUBGOAL (fn (_, i) => REPEAT_ALL_NEW (PlainProgCorrTac props ctxt) i THEN TRYALL (clarsimp_tac ctxt))

val _ =
  Theory.setup
    (Method.setup @{binding plain_prog_corr_tac} (Attrib.thms >> (fn ths => fn ctxt =>
      SIMPLE_METHOD' (plain_prog_corr_tac ths ctxt)))
      "Plain syntax-directed tactic for the program correspondences")

\<close>

end


(*  Title:      HOL/Auth/n_germanSymIndex_lemma_inv__3_on_rules.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_germanSymIndex Protocol Case Study*}

theory n_germanSymIndex_lemma_inv__3_on_rules imports n_germanSymIndex_lemma_on_inv__3
begin
section{*All lemmas on causal relation between inv__3*}
lemma lemma_inv__3_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(f=inv__3  )"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_StoreVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqSVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqE__part__0  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqE__part__0Vsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendReqE__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqE__part__1Vsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqSVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvReqEVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__0Vsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__1Vsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInvAckVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvInvAckVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntSVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendGntEVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntSVsinv__3) done
    }

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_RecvGntEVsinv__3) done
    }

  ultimately show "invHoldForRule s f r (invariants N)"
  by satx
qed

end