theory AbstractLock_Proof_Rules
  imports AbstractLock_Lib OpSem_Proof_Rules Lib_ProofRules
begin

lemma lock_acqure_wfs_pres:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "lock_acquire_step t x ls cs  ls' cs' res ver"
    shows "wfs cs'"
  using assms
  apply(simp add: lock_acquire_step_def lock_acquire_def lib_update_def lib_read_def)
  apply(elim exE conjE)
  apply(subgoal_tac "a = x", simp)
   defer
   apply(simp add:  lib_writes_on_def lib_visible_writes_def)
  apply(case_tac "even (lib_value ls (x, b))", simp_all)
   apply(simp add:  lib_writes_on_def lib_value_def lib_valid_fresh_ts_def lib_visible_writes_def)
   apply(unfold wfs_def lib_update_def, simp)
     apply(simp add: lib_add_cv_def lib_update_thrView_def lib_update_modView_def lib_update_mods_def lib_lastWr_def lib_writes_on_def)
   apply(elim conjE)
   apply(case_tac "\<not>lib_releasing ls (x, b)", simp_all)
  apply(simp add: update_thrView_def)
  apply(simp add: update_thrView_def)
   apply(unfold writes_on_def ts_oride_def, simp)
   apply(intro allI impI conjI)
  apply(simp add: var_def lib_wfs_def)
  apply (simp add: var_def writes_on_def)
  apply(simp add:  lib_wfs_def)
  by (metis (no_types, lifting) mem_Collect_eq writes_on_def)

lemma lock_release_lib_wfs_pres:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "lock_release_step t x ls cs  ls' cs'"
    shows "lib_wfs ls' cs'"
  using assms
  apply(simp add: lib_wfs_def lock_release_step_def lib_writes_on_def lock_release_def lib_write_def)
  apply(elim exE conjE)
  apply(simp add: lib_update_mods_def lib_update_modView_def lib_update_thrView_def lib_lastWr_def lib_writes_on_def)
  apply(intro conjI allI impI)
  apply(case_tac "xa=a", simp_all)
  using finite_lib_writes apply blast

  using finite_lib_writes_2 apply blast
    apply blast
  apply(case_tac "aa=a", simp_all)
    apply(case_tac "lib_lastWr ls a = (a, b)")
  apply(subgoal_tac "Max (tst `
                {w. var w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)}) = ts'", simp_all)
  apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def)
  apply blast
     apply(simp add: lib_lastWr_def lib_writes_on_def tst_def var_def)
     apply(subgoal_tac "finite ({w. fst w = a \<and> w \<in> lib_writes ls})")
      apply(subgoal_tac "{w. fst w = a \<and> w \<in> lib_writes ls} \<noteq> {}")
  apply(subgoal_tac "{w. fst w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)} = {w. fst w = a \<and> (w \<in> lib_writes ls)} \<union> {(a,ts')}")
        apply simp
  apply(subgoal_tac "ts' > Max (snd ` {w. fst w = a \<and> w \<in> lib_writes ls}) ")
         apply linarith
        apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def)
  apply simp
  apply auto[1]
      apply blast+
    defer
  apply(simp add: tst_def var_def)
  apply(subgoal_tac "{w. fst w = aa \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)} = {w. fst w = aa \<and> ( w \<in> lib_writes ls)}")
     apply auto[1]
    apply auto[1]
   apply(simp add: tst_def var_def)
  apply(unfold wfs_def writes_on_def lastWr_def)
  using tst_def apply auto[1]

  apply(simp add: var_def tst_def lib_lastWr_def lib_valid_fresh_ts_def lib_writes_on_def)

  apply(subgoal_tac " Max (snd `
                {w. fst w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)}) =  Max (snd `
                {w. fst w = a \<and> (w \<in> lib_writes ls)})")
   apply simp
  apply(subgoal_tac "{w. fst w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)} = {w. fst w = a \<and> (w \<in> lib_writes ls)} \<union> {(a,ts')}")
   defer
  apply auto[1]
  apply simp
     apply(subgoal_tac "b < Max (snd ` {w. fst w = a \<and> w \<in> lib_writes ls}) ")
   defer
   apply(subgoal_tac "snd ` {w. fst w = a \<and> w \<in> lib_writes ls} \<noteq> {}")
    apply(subgoal_tac "finite (snd ` {w. fst w = a \<and> w \<in> lib_writes ls})")
     apply(subgoal_tac "b \<in>  (snd ` {w. fst w = a \<and> w \<in> lib_writes ls}) ")
      apply (simp add: member_less_max)
     apply(simp add: lib_visible_writes_def lib_writes_on_def)
  defer  apply simp
   apply blast
     apply(subgoal_tac "ts' < Max (snd ` {w. fst w = a \<and> w \<in> lib_writes ls}) ")
   apply(subgoal_tac "snd ` {w. fst w = a \<and> w \<in> lib_writes ls} \<noteq> {}")
    apply(subgoal_tac "finite (snd ` {w. fst w = a \<and> w \<in> lib_writes ls})")
  apply auto[1]
  apply auto[1]
   apply blast
  apply(elim conjE)
  apply(erule_tac x = " Max (snd ` {w. fst w = a \<and> w \<in> lib_writes ls})" in allE)
  apply(subgoal_tac " (a, Max (snd ` {w. fst w = a \<and> w \<in> lib_writes ls}))
       \<in> lib_writes ls")
   apply blast
   apply(subgoal_tac "snd ` {w. fst w = a \<and> w \<in> lib_writes ls} \<noteq> {}")
   apply(subgoal_tac "finite (snd ` {w. fst w = a \<and> w \<in> lib_writes ls})")
  apply(subgoal_tac "Max (snd ` {w. fst w = a \<and> w \<in> lib_writes ls}) \<in> (snd ` {w. fst w = a \<and> w \<in> lib_writes ls})")
    apply force
  apply auto[1]
    apply blast+
proof -
fix a :: nat and b :: rat and ts' :: rat and aa :: nat
assume a1: "a = x \<and> (a, b) \<in> lib_writes ls \<and> tst (lib_thrView ls t x) \<le> b"
  assume "\<forall>a b. (a, b) \<in> lib_writes ls \<longrightarrow> lib_modView ls (a, b) LVARS a = (a, b)"
  assume "\<forall>a b x. fst (lib_modView ls (a, b) LVARS x) = x \<and> lib_modView ls (a, b) LVARS x \<in> lib_writes ls"
  have "(x, b) \<in> {p. fst p = x \<and> p \<in> lib_writes ls}"
    using a1 by auto
  then show "b \<in> snd ` {p. fst p = x \<and> p \<in> lib_writes ls}"
    by (metis (no_types) rev_image_eqI snd_conv)
qed

lemma lock_release_wfs_pres:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "lock_release_step t x ls cs  ls' cs'"
    shows "wfs cs"
  using assms
  apply(simp add: lib_wfs_def lock_release_step_def lib_writes_on_def lock_release_def lib_write_def)
  done

lemma lock_acqure_unsuccessfulib_pres_d_obs:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "[lib(x) =\<^sub>t u] ls"
      and "lock_acquire_step t x ls cs  ls' cs' False ver"
  shows "[lib(x) =\<^sub>t u] ls'"
  using assms
 apply (simp add: lock_acquire_step_def lock_acquire_def lib_d_obs_t_def lib_d_obs_def)
  apply(elim exE conjE)
  apply(subgoal_tac "a = x", simp_all)
  apply safe
   apply(case_tac "even (lib_value ls (x, b))", simp)
   apply simp
  apply(simp add: lib_read_def lib_value_def  lib_update_thrView_def)
  by(simp add: lib_visible_writes_def lib_writes_on_def)

lemma lock_acqure_successful_pres_d_obs:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "[lib(x) =\<^sub>t u] ls"
      and "lock_acquire_step t x ls cs  ls' cs' True ver"
    shows "[lib(x) =\<^sub>t (u + 1) ] ls'"
  using assms
  apply(simp add: lib_d_obs_t_def lib_d_obs_def lock_acquire_step_def lock_acquire_def lib_update_def)
  apply(elim conjE exE)
  apply(simp add: lib_update_def all_updates_l var_def tst_def lib_lastWr_def lib_writes_on_def)
  apply(case_tac "even (lib_value ls (a, b))", simp_all)
  apply(subgoal_tac "finite {w. fst w = a \<and>  w \<in> lib_writes ls}")
   apply(subgoal_tac " {w. fst w = a \<and> w \<in> lib_writes ls} \<noteq> {}")
  apply(subgoal_tac " {w. fst w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)} =  {w. fst w = a \<and>  w \<in> lib_writes ls} \<union> {(a, ts')}")
     defer
  apply(simp add: lib_wfs_def lib_writes_on_def)
  using Collect_cong apply auto[1]
  apply(simp add: lib_wfs_def lib_writes_on_def)
  apply (metis prod.collapse var_def)
  apply(simp add: lib_wfs_def lib_writes_on_def)
  using var_def apply auto[1]
  apply(subgoal_tac "lib_visible_writes ls t x = {lib_lastWr ls x}")
  apply(simp add: lib_value_def ts_oride_def lib_releasing_def tst_def var_def lib_visible_writes_def lib_writes_on_def lib_valid_fresh_ts_def )
  apply(intro conjI impI allI)
  apply(simp_all add: lib_wfs_def lib_writes_on_def var_def tst_def)
  using max.absorb2 apply auto[1]
  apply auto[1]
  using less_eq_rat_def apply auto[1]
      defer
  using less_eq_rat_def apply auto[1]
  using less_eq_rat_def apply auto[1]
  using less_eq_rat_def apply auto[1]
   apply (metis (no_types, lifting) max.absorb1 max.coboundedI2 max.strict_order_iff)
   apply (meson assms(2) assms(3) d_obs_vw)
  apply(simp add: lib_lastWr_def lib_writes_on_def)
  apply(case_tac "b =  Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})", simp_all)

  apply(simp add: tst_def var_def)
  by (metis (no_types, lifting) antisym mem_Collect_eq singletonI snd_conv)

lemma lock_acqure_unsuccessful_client_pres_d_obs:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "[x =\<^sub>t v] cs"
      and "lock_acquire_step t y ls cs  ls' cs' False ver"
    shows "[x =\<^sub>t v ] cs'"
  using assms
  apply (simp add: lock_acquire_step_def lock_acquire_def )
  apply (elim exE conjE)
  apply(subgoal_tac "a = y", simp_all)
   apply (case_tac "even (lib_value ls (y, b))", simp_all)
  by (simp add: lib_visible_writes_def lib_writes_on_def)

lemma last_client_lock_acquire:
 assumes "wfs cs"
      and "lib_wfs ls cs"
      and "lock_acquire_step t y ls cs  ls' cs' res ver"
    shows "lastWr cs' x = lastWr cs x"
  using assms
  apply(simp add: lock_acquire_step_def lastWr_def)
  apply(simp add: lock_acquire_def)
  apply(elim exE conjE)
  apply(case_tac " even (lib_value ls (a, b))", simp_all)
  apply(simp add: lib_update_def)
  apply(simp add: update_thrView_def lib_add_cv_def lib_update_thrView_def lib_update_modView_def lib_update_mods_def  lib_writes_on_def)
  apply safe
  apply(case_tac "lib_releasing ls (a, b)", simp_all)
   apply(unfold writes_on_def)[1]
   by simp

lemma writes_client_lock_acquire:
 assumes "wfs cs"
      and "lib_wfs ls cs"
      and "lock_acquire_step t y ls cs  ls' cs' res ver"
    shows "writes_on cs x = writes_on cs' x"
  using assms
  apply(simp add: lock_acquire_step_def)
  apply (elim exE conjE)
  apply(simp add: lock_acquire_def)
  apply(case_tac " even (lib_value ls (a,b))", simp_all)
   apply(simp add: lib_update_def)
  apply(unfold writes_on_def)
  by(simp add: update_thrView_def lib_add_cv_def lib_update_thrView_def lib_update_modView_def lib_update_mods_def  lib_writes_on_def)

lemma mods_client_lock_acquire:
 assumes "wfs cs"
      and "lib_wfs ls cs"
      and "lock_acquire_step t y ls cs  ls' cs' res ver"
    shows "mods cs  = mods cs'"
  using assms
  apply(simp add: lock_acquire_step_def)
  apply (elim exE conjE)
  apply(simp add: lock_acquire_def)
  apply(case_tac " even (lib_value ls (a,b))", simp_all)
   by(simp add: lib_update_def update_thrView_def)

lemma lock_acqure_successfulib_client_pres_d_obs:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "[x =\<^sub>t v] cs"
      and "lock_acquire_step t y ls cs  ls' cs' True ver"
    shows "[x =\<^sub>t v ] cs'"
  using assms
  apply(simp add: d_obs_t_def d_obs_def)
  apply safe
  apply(simp add: lastWr_def)
   apply(subgoal_tac "writes_on cs' x = writes_on cs x")
  defer
  using writes_client_lock_acquire apply blast
   apply (simp add: last_client_lock_acquire mods_client_lock_acquire value_def)
  apply simp
  apply (simp add: lock_acquire_step_def lock_acquire_def lib_update_def)
  apply (elim conjE exE)
  apply(case_tac "even (lib_value ls (a, b))", simp_all)
  apply(simp add: lib_update_def all_updates_l)
  apply(case_tac "lib_releasing ls (a, b)", simp_all)
  apply(subgoal_tac "tst (thrView cs t x) \<ge> tst ((lib_modView ls (a, b) CVARS) x)")
  defer
   apply (simp add: lib_wfs_def)
  apply(subgoal_tac "ts_oride (thrView cs t) (lib_modView ls (a, b) CVARS) x = thrView cs t x")
   apply simp
  apply(simp add: ts_oride_def)
  apply(intro impI)
  apply(unfold wfs_def writes_on_def, simp)
  by (metis (no_types, lifting) antisym assms(1) lib_pair lib_wfs_def writes_on_var)

lemma lock_acquire_unsuccessful_p_obs:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "[lib(x) =\<^sub>t v] ls"
      and "\<not>[lib(x) \<approx>\<^sub>t' u] ls"
      and "u\<noteq>v "
      and "lock_acquire_step t x ls cs  ls' cs' False ver"
    shows "\<not>[lib(x) \<approx>\<^sub>t' u] ls'"
  using assms
    apply (simp add: lock_acquire_step_def lib_read_def lock_acquire_def)
  apply safe
 by(case_tac "even (lib_value ls (a, b))", simp_all)

lemma lock_acquire_unsuccessful_d_obs_pres:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "[lib(x) =\<^sub>t' v] ls"
      and "lock_acquire_step t x ls cs  ls' cs' False ver"
    shows "[lib(x) =\<^sub>t' v] ls'"
  using assms
    apply (simp add: lock_acquire_step_def lib_read_def lock_acquire_def)
  apply(elim exE conjE)
  by(case_tac "even (lib_value ls (a,b))", simp_all)

lemma lock_acquire_unsuccessfulib_c_obs_pres:
  assumes "wfs cs"
  and "lib_wfs ls cs"
and "[lib(y) = v]\<lparr>x =\<^sub>t u\<rparr> ls cs"
      and "lock_acquire_step t' y ls cs  ls' cs' False ver"
    shows "[lib(y) = v]\<lparr>x =\<^sub>t u\<rparr> ls' cs'"
  using assms
      apply (simp add: lock_acquire_step_def lib_read_def lock_acquire_def)
  apply safe
  by(case_tac "even (lib_value ls (a,b))", simp_all)

lemma lock_acquire_successfulib_version:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "odd m"
      and "even n"
      and "\<forall> z . z\<notin>{m,n} \<longrightarrow> \<not>[lib(x) \<approx>\<^sub>t z] ls "
      and "lock_acquire_step t x ls cs  ls' cs' True ver"
    shows "ver = n"
  using assms
  apply (simp add: lock_acquire_step_def lock_acquire_def)
  apply safe
  apply(case_tac "even (lib_value ls (a,b))", simp_all)
  apply(simp add: lib_update_def)
  apply(case_tac "lib_releasing ls (a,b)", simp_all)
  apply(simp add: lib_add_cv_def lib_update_modView_def lib_update_mods_def lib_update_thrView_def update_thrView_def)
  apply(simp add: lib_visible_writes_def lib_valid_fresh_ts_def lib_writes_on_def lib_p_obs_def lib_value_def)
  apply safe
  apply metis
  by (metis lib_p_obs_def)

lemma lock_acquire_successful_c_o_s:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "[lib(y) = n]\<lparr>x =\<^sub>t u\<rparr> ls cs"
      and "lock_acquire_step t y ls cs  ls' cs' True n"
    shows "[x =\<^sub>t u] cs'"
  using assms
  apply (simp add: lock_acquire_step_def lock_acquire_def)
  apply safe
  apply(case_tac "even (lib_value ls (a,b))", simp_all)
  apply(simp add: lib_update_def)
  apply(simp add: lib_add_cv_def lib_update_modView_def lib_update_mods_def lib_update_thrView_def update_thrView_def)
   apply(simp add: lib_visible_writes_def lib_valid_fresh_ts_def lib_writes_on_def lib_p_obs_def lib_value_def lib_c_obs_def d_obs_def d_obs_t_def)
  apply(simp add: lastWr_def lib_writes_on_def ts_oride_def)
  apply safe
   apply(unfold writes_on_def)
   apply simp_all
    apply(simp_all add: value_def)
  apply(simp add: lib_wfs_def lib_writes_on_def)
  apply(simp add: tst_def var_def)
  apply(unfold wfs_def writes_on_def, simp)
  apply clarsimp
  apply(subgoal_tac "tst (thrView cs t x) \<le> tst (lastWr cs x)")
   defer
  apply (meson assms(1) last_write_max wfs_def)
  by(simp add: tst_def var_def lastWr_def)

lemma lock_acquire_successful_c_o:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "odd m"
      and "even n"
      and "\<forall> z . z\<notin>{m,n} \<longrightarrow> \<not>[lib(x) \<approx>\<^sub>t z] ls "
      and "lock_acquire_step t x ls cs  ls' cs' True ver"
      and "[lib(x) = n]\<lparr>x =\<^sub>t u\<rparr> ls cs"
    shows "[x =\<^sub>t u] cs'"
  using assms
  apply (simp add: lock_acquire_step_def lock_acquire_def)
  apply safe
  apply(case_tac "even (lib_value ls (a,b))", simp_all)
  apply(simp add: lib_update_def)
  apply(case_tac "ver \<noteq> n", simp_all)
  apply (metis OpSem.null_def assms(3)  lib_p_obs_def numeral_2_eq_2)
  apply(case_tac "lib_releasing ls (a,b)", simp_all)
  using assms(6) lock_acquire_successful_c_o_s apply blast
  using lib_c_obs_def by blast

lemma lock_acquire_successful_not_p_obs_pres:
  assumes "wfs cs"
      and "lib_wfs ls cs"
and "\<not>[lib(x) \<approx>\<^sub>t u] ls"
 and "lock_acquire_step t x ls cs  ls' cs' False ver"
shows "\<not>[lib(x) \<approx>\<^sub>t u] ls'"
  using assms
  apply (simp add: lock_acquire_step_def lock_acquire_def)
  apply safe
  by(case_tac "even (lib_value ls (a,b))", simp_all)

lemma lock_acquire_unsuccessful_diff_t_d_p_obs_pres:
  assumes "wfs cs"
      and "lib_wfs ls cs"
and "[x =\<^sub>t u] cs"
and "t \<noteq> t'"
 and "lock_acquire_step t' y ls cs  ls' cs' False ver"
shows "[x =\<^sub>t u] cs'"
  using assms
  apply (simp add: lock_acquire_step_def lock_acquire_def)
  apply safe
  by(case_tac "even (lib_value ls (a,b))", simp_all)

  lemma lock_acquire_successfulib_diff_t_d_p_obs_pres:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "[x =\<^sub>t u] cs"
      and "t \<noteq> t'"
      and "lock_acquire_step t' y ls cs  ls' cs' True ver"
    shows "[x =\<^sub>t u] cs'"
  using assms
  apply (simp add: lock_acquire_step_def lock_acquire_def)
  apply safe
  apply(case_tac "even (lib_value ls (a,b))", simp_all)
  apply(simp add: d_obs_t_def d_obs_def lastWr_def lib_read_def)
  apply safe
   apply(simp_all add: lib_update_def update_thrView_def)
   apply safe
   apply(unfold writes_on_def)
   apply(case_tac "lib_releasing ls (a,b)", simp_all)
  by (simp add: value_def)

lemma lock_acquire_unsuccessfulib_cvd_pres:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "cvd[lib(x), u] ls"
      and "lock_acquire_step t' x ls cs  ls' cs' False ver"
    shows "cvd[lib(x), u] ls'"
  using assms
  apply(simp add: lock_acquire_step_def lock_acquire_def)
  apply(elim exE)
  by(case_tac "even (lib_value ls (a,b))", simp_all)

lemma lock_acquire_successfulib_cvd:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "cvd[lib(x), u] ls"
      and "lock_acquire_step t' x ls cs  ls' cs' True ver"
    shows "cvd[lib(x), (u+1)] ls'"
   using assms
  apply(simp add: lock_acquire_step_def lock_acquire_def)
   apply(elim exE conjE)
   apply(case_tac "(a, b) \<noteq> lib_lastWr ls a")
   apply(simp add: lib_update_def all_updates_l lib_covered_v_def lib_visible_writes_def lib_writes_on_def lib_lastWr_def)
   apply blast
   apply(case_tac "even (lib_value ls (a, b))", simp_all)
   apply(simp add: lib_update_def all_updates_l lib_covered_v_def)
   apply(simp_all add: lib_writes_on_def lib_lastWr_def var_def tst_def lib_valid_fresh_ts_def)
   apply(subgoal_tac "a = x", simp_all)
   apply(subgoal_tac "finite {w. fst w = x \<and> w \<in> lib_writes ls}")
     apply(subgoal_tac "{w. fst w = x \<and> w \<in> lib_writes ls} \<noteq> {}")
      defer
   apply(simp add: lib_visible_writes_def lib_writes_on_def)
   apply blast
   apply(simp add: lib_wfs_def lib_writes_on_def)
   using var_def apply auto[1]
   apply(simp add: lib_visible_writes_def lib_writes_on_def)
   apply(subgoal_tac "{w. fst w = x \<and>
                      (w = (x, ts') \<or> w \<in> lib_writes ls)} = {w. fst w = x \<and>
                      (w \<in> lib_writes ls)} \<union> {(x, ts')}")
   defer
    apply auto[1]
   apply simp
   apply(intro allI conjI impI, case_tac "lib_releasing ls
                 (x, Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}))", simp_all)
      apply(elim conjE)
   apply(subgoal_tac "Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}) < ts'")
   apply(subgoal_tac "Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}) \<in> (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})")

        apply (meson max.strict_order_iff)
   apply(subgoal_tac "finite (snd `{w. fst w = x \<and> w \<in> lib_writes ls})")
   apply(subgoal_tac "(snd `{w. fst w = x \<and> w \<in> lib_writes ls}) \<noteq> {}")
   apply (meson Max_in)
   apply force
       apply blast
   apply(subgoal_tac "Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}) \<in> (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})")
   apply simp
   apply(subgoal_tac "finite (snd `{w. fst w = x \<and> w \<in> lib_writes ls})")
       apply(subgoal_tac "(snd `{w. fst w = x \<and> w \<in> lib_writes ls}) \<noteq> {}")
   apply auto[1]
   apply simp
      apply blast
     apply(simp add: lib_value_def lib_wfs_def lib_writes_on_def lib_visible_writes_def )
   apply(intro conjI impI, elim conjE)
     apply blast
   apply(elim conjE disjE)
     apply(simp add: lib_value_def lib_wfs_def lib_writes_on_def lib_visible_writes_def )
   apply (simp add: max.strict_order_iff)
     apply(simp add: lib_value_def lib_wfs_def lib_writes_on_def lib_visible_writes_def )
     apply(simp add: lib_value_def lib_wfs_def lib_writes_on_def lib_visible_writes_def )
   by auto

lemma lock_acquire_cvd_odd_false:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "cvd[lib(x), u] ls"
      and "odd u"
      and "lock_acquire_step t' x ls cs  ls' cs' res ver"
    shows "\<not>res"
  using assms
  apply(simp add: lock_acquire_step_def lib_covered_v_def lock_acquire_def)
  apply(elim conjE exE)
  apply(case_tac "even (lib_value ls (a,b))")
  apply(simp add: lib_visible_writes_def lib_writes_on_def lib_value_def)
  by auto

lemma lock_rel_c_obs_intro:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "\<not> [lib(y) \<approx>\<^sub>t' u] ls"
      and "[x =\<^sub>t m] cs"
      and "cvd[lib(y), v] ls"
      and "t \<noteq> t'"
      and "lock_release_step t y ls cs ls' cs'"
    shows "[lib(y) = u]\<lparr>x =\<^sub>t' m\<rparr> ls' cs'"
  using assms
  apply(simp add: lock_release_step_def lib_p_obs_def lib_d_obs_def lib_d_obs_t_def d_obs_def d_obs_t_def)
  apply(elim exE conjE)
  apply(simp add: lock_release_def lib_write_def lib_update_mods_def lib_update_modView_def lib_update_thrView_def)
  apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def lib_visible_writes_def lib_c_obs_def d_obs_def)
  apply safe
    apply(simp add: lib_releasing_def)
   apply(simp add: lastWr_def value_def lib_value_def)
   apply(unfold writes_on_def)
   apply blast
    apply(simp add: lib_releasing_def lib_value_def)
  by blast

lemma lock_acqure_lib_wfs_pres:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "lock_acquire_step t x ls cs  ls' cs' res ver"
    shows "lib_wfs ls' cs'"
  using assms
  apply(simp add: lock_acquire_step_def)
  apply(elim exE conjE)
  apply(simp add: lock_acquire_def)
  apply(case_tac "even (lib_value ls (a, b))")
  apply(simp add: lib_update_def all_updates_l)
  apply(case_tac "lib_releasing ls (a, b)")
   apply(simp add: lib_wfs_def lib_writes_on_def)
   apply(intro allI conjI impI)
  apply(simp add: var_def ts_oride_def)
                 apply (simp add: ts_oride_def)
  apply(unfold writes_on_def var_def wfs_def ts_oride_def, simp)[1]
  apply(unfold writes_on_def var_def wfs_def ts_oride_def, simp)[1]
  apply(simp add: var_def ts_oride_def)
             apply (simp add: ts_oride_def)
  defer
  apply (metis (no_types, lifting) lib_visible_writes_def lib_writes_on_def mem_Collect_eq)

           apply blast
          apply(simp add: lib_valid_fresh_ts_def ts_oride_def)
          apply(intro impI)
          apply(subgoal_tac "lib_modView ls (a, b) LVARS a = (a,b)")
  apply(simp add: tst_def)
  apply (metis (no_types, lifting) lib_visible_writes_def lib_writes_on_def mem_Collect_eq)
          apply(simp add: lib_valid_fresh_ts_def ts_oride_def)
          apply(intro impI)
          apply(subgoal_tac "lib_modView ls (a, b) LVARS a = (a,b)")
  apply(simp add: tst_def)
  apply (metis (no_types, lifting) lib_visible_writes_def lib_writes_on_def mem_Collect_eq)
        apply blast
       apply(simp add: lib_lastWr_def lib_writes_on_def)
       apply(intro impI)
       apply(subgoal_tac "ts'>b")
  apply(subgoal_tac "ts' \<in> tst ` {w. var w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)}")
         apply(subgoal_tac "finite (tst ` {w. var w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)})")
  apply(simp add: var_def tst_def)
  using Max_less_iff not_max apply blast
         apply (simp add: finite_lib_writes)
        apply(simp add: tst_def var_def)
  apply(subgoal_tac " (a, ts')\<in>{w. fst w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)}")
  apply (simp add: image_iff)
        apply auto[1]
       apply(simp add: lib_valid_fresh_ts_def)
      apply(simp add: lib_lastWr_def lib_writes_on_def)
      apply(case_tac "xa \<noteq> a", simp_all)
  apply(subgoal_tac "{w. var w = xa \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)} = {w. var w = xa \<and> w \<in> lib_writes ls}")
        apply simp
  apply(simp add: var_def)
       apply auto[1]
      defer
      apply(simp add: tst_def lastWr_def ts_oride_def var_def)
      apply(unfold writes_on_def var_def wfs_def, simp)[1]
     apply(simp add: tst_def lastWr_def ts_oride_def var_def)
     apply(unfold writes_on_def var_def wfs_def, simp)[1]
  apply(simp add: lib_wfs_def lib_writes_on_def)
    apply(intro conjI impI allI)
         defer
  apply(simp add: lib_visible_writes_def)
  using lib_writes_on_def apply auto[1]
        apply blast
       apply(simp add: lib_lastWr_def lib_writes_on_def)
       apply(intro impI)
       apply(simp add: tst_def var_def lib_visible_writes_def lib_writes_on_def)
  defer
       apply(simp add: lib_lastWr_def lib_writes_on_def)
       apply(simp add: tst_def var_def lib_visible_writes_def lib_writes_on_def)
       defer
  apply(unfold wfs_def writes_on_def, simp)[1]
       apply (meson assms(1) last_write_max wfs_def)
      defer
      apply(case_tac "lib_lastWr ls a = (a,b)")
  apply(subgoal_tac "b = Max (tst ` {w. var w = a \<and>  w \<in> lib_writes ls})", simp_all)
        apply(subgoal_tac "ts' > b", simp_all)
         apply(subgoal_tac "ts'= Max (tst ` {w. var w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)})", simp_all)
  apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def)
          apply blast
  apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def)
        apply(subgoal_tac "ts' > Max (tst ` {w. var w = a \<and>  w \<in> lib_writes ls})", simp_all)
  apply(subgoal_tac " {w. var w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)} =  {w. var w = a \<and> ( w \<in> lib_writes ls)} \<union> {(a, ts')}")
          apply(subgoal_tac " finite {w. var w = a \<and> ( w \<in> lib_writes ls)}")
          apply(subgoal_tac "{w. var w = a \<and> ( w \<in> lib_writes ls)} \<noteq> {}")
          apply simp
  apply (metis (no_types, lifting) lib_visible_writes_def lib_writes_on_def max.strict_order_iff mem_Collect_eq)
  apply blast
  apply blast
  apply(simp add: var_def lib_valid_fresh_ts_def lib_writes_on_def)
  apply auto[1]
  apply(simp add: var_def lib_valid_fresh_ts_def lib_writes_on_def)
       apply (simp add: lib_lastWr_def lib_writes_on_def)
      apply(subgoal_tac "lib_lastWr ls a \<in> lib_writes_on ls a")
      apply(subgoal_tac "b < tst (lib_lastWr ls a)")
      apply(subgoal_tac "ts' < tst (lib_lastWr ls a)")
         apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def)
  apply(subgoal_tac "Max (tst ` {w. var w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)})
= Max (tst ` {w. var w = a \<and>  w \<in> lib_writes ls})")
          apply simp
  apply(subgoal_tac " {w. var w = a \<and> (w = (a, ts') \<or> w \<in> lib_writes ls)} =  {w. var w = a \<and> ( w \<in> lib_writes ls)} \<union> {(a, ts')}")
          apply(subgoal_tac " finite {w. var w = a \<and> ( w \<in> lib_writes ls)}")
           apply(subgoal_tac "{w. var w = a \<and> ( w \<in> lib_writes ls)} \<noteq> {}")
apply (simp add: var_def tst_def lib_lastWr_def lib_writes_on_def)
apply (simp add: var_def tst_def lib_lastWr_def lib_writes_on_def)
  apply blast
  apply blast
apply (simp add: var_def tst_def lib_lastWr_def lib_writes_on_def)
  using Collect_cong apply auto[1]
        apply (simp add: var_def tst_def lib_lastWr_def lib_writes_on_def lib_valid_fresh_ts_def)
       apply (simp add: var_def tst_def lib_visible_writes_def  lib_lastWr_def lib_writes_on_def lib_valid_fresh_ts_def)

       apply(elim conjE, simp add: lib_value_def)
  apply(erule_tac x = "Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})" in allE, simp)
  apply(subgoal_tac "finite {w. fst w = x \<and> w \<in> lib_writes ls}")
  apply(subgoal_tac "{w. fst w = x \<and> w \<in> lib_writes ls} \<noteq> {}")
  apply(subgoal_tac "b \<in> snd `{w. fst w = x \<and> w \<in> lib_writes ls}")
  apply(subgoal_tac "Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}) \<in> snd `{w. fst w = x \<and> w \<in> lib_writes ls}")
  apply simp
           apply (simp add: member_less_max)
  using Max_in apply blast

  apply (simp add: image_iff)
  apply blast

       apply blast
      apply(simp add: lib_lastWr_def lib_writes_on_def)
      apply(simp add: var_def tst_def lib_visible_writes_def lib_writes_on_def)
      apply(elim conjE)
  apply(subgoal_tac "finite( snd ` {w. fst w = x \<and> w \<in> lib_writes ls})")
  apply(subgoal_tac "snd ` {w. fst w = x \<and> w \<in> lib_writes ls} \<noteq> {}")
        defer
  apply blast
       apply blast
  apply(case_tac "xa = a", simp_all)
  apply (simp add: finite_lib_writes)
      apply (simp add: finite_lib_writes_2)
     apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def)
     apply(elim conjE)
      apply(case_tac "lib_lastWr ls x = (x,b)")
  apply(subgoal_tac "b = Max (tst ` {w. var w = x \<and>  w \<in> lib_writes ls})", simp_all)
        apply(subgoal_tac "ts' > b")
       apply(subgoal_tac "ts'= Max (tst ` {w. var w = x \<and> (w = (x, ts') \<or> w \<in> lib_writes ls)})", simp_all)

  using tst_def var_def apply force

        apply(subgoal_tac "ts' > Max (tst ` {w. var w = x \<and>  w \<in> lib_writes ls})")
  apply(subgoal_tac " {w. var w = x \<and> (w = (x, ts') \<or> w \<in> lib_writes ls)} =  {w. var w = x \<and> ( w \<in> lib_writes ls)} \<union> {(x, ts')}")
          apply(subgoal_tac " finite {w. var w = x \<and> ( w \<in> lib_writes ls)}")
          apply(subgoal_tac "{w. var w = x \<and> ( w \<in> lib_writes ls)} \<noteq> {}")
          apply simp
          apply (metis (no_types, lifting) max.strict_order_iff )
  apply auto[1]
  using var_def apply auto[1]
       apply(simp add: var_def tst_def)
  apply auto[1]
      apply(simp add: var_def tst_def)
  apply(simp add: lib_lastWr_def lib_writes_on_def tst_def var_def)
      apply(subgoal_tac "lib_lastWr ls x \<in> lib_writes_on ls x")
      apply(subgoal_tac "b < tst (lib_lastWr ls x)")
      apply(subgoal_tac "ts' < tst (lib_lastWr ls x)")
         apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def)
  apply(subgoal_tac "Max (tst ` {w. var w = x \<and> (w = (x, ts') \<or> w \<in> lib_writes ls)})
= Max (tst ` {w. var w = x \<and>  w \<in> lib_writes ls})")
          apply simp
  apply(subgoal_tac " {w. var w = x \<and> (w = (x, ts') \<or> w \<in> lib_writes ls)} =  {w. var w = x \<and> ( w \<in> lib_writes ls)} \<union> {(x, ts')}")
          apply(subgoal_tac " finite {w. var w = x \<and> ( w \<in> lib_writes ls)}")
           apply(subgoal_tac "{w. var w = x \<and> ( w \<in> lib_writes ls)} \<noteq> {}")
apply (simp add: var_def tst_def lib_lastWr_def lib_writes_on_def)
apply (simp add: var_def tst_def lib_lastWr_def lib_writes_on_def)
           apply blast
  apply(simp add: var_def) apply auto[1]
  apply(subgoal_tac " {w. var w = x \<and> (w = (x, ts') \<or> w \<in> lib_writes ls)} =  {w. var w = x \<and> ( w \<in> lib_writes ls)} \<union> {(x, ts')}")
          apply(subgoal_tac " finite {w. var w = x \<and> ( w \<in> lib_writes ls)}")
          apply(subgoal_tac "{w. var w = x \<and> ( w \<in> lib_writes ls)} \<noteq> {}")
apply (simp add: var_def tst_def lib_lastWr_def lib_writes_on_def)
          apply blast+
  apply (simp add: var_def)
apply (simp add: var_def tst_def )
        apply auto[1]
apply (simp add: var_def tst_def lib_lastWr_def lib_writes_on_def)

      apply(simp add:  tst_def lib_lastWr_def lib_writes_on_def var_def)
          apply(subgoal_tac " finite {w. fst w = x \<and> ( w \<in> lib_writes ls)}")
          apply(subgoal_tac "{w. fst w = x \<and> ( w \<in> lib_writes ls)} \<noteq> {}")
  apply (simp add: image_iff member_less_max)
       apply blast+
     apply(simp add: lib_lastWr_def lib_writes_on_def tst_def var_def)
  apply(subgoal_tac "finite ( (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}))")
      apply(subgoal_tac " (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}) \<noteq> {}")
       defer
       apply blast+

     apply(case_tac "xa = x")
      apply(elim conjE, simp)
  apply(subgoal_tac "finite ((snd ` {w. fst w = x \<and> (w = (x, ts') \<or> w \<in> lib_writes ls)}))")
  apply(subgoal_tac "((snd ` {w. fst w = x \<and> (w = (x, ts') \<or> w \<in> lib_writes ls)})) \<noteq> {}")
    apply(subgoal_tac " {w. var w = x \<and>  (w = (x, ts') \<or> w \<in> lib_writes ls)} =  {w. var w = x \<and> ( w \<in> lib_writes ls)} \<union> {(x, ts')}")
      apply(case_tac "lib_lastWr ls x = (x, b)", simp_all)
  apply(case_tac "ts' = Max (snd ` {w. fst w = x \<and> (w = (x, ts') \<or> w \<in> lib_writes ls)})", simp_all)
  apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def)
           apply blast
          apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def)
          apply(case_tac "ts' < Max (snd ` {w. fst w = x \<and>  w \<in> lib_writes ls})")
  apply(simp add: lib_lastWr_def lib_writes_on_def var_def tst_def)
          apply (simp add: var_def tst_def lib_lastWr_def lib_writes_on_def)
apply(subgoal_tac "ts' > Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})", simp)
  apply(subgoal_tac "ts' = Max (insert ts' (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}))")
              apply linarith
  using max_of_union [where s = "(snd ` {w. fst w = x \<and> w \<in> lib_writes ls})"]
  apply simp
  apply (metis (no_types, lifting) Max_insert Max_singleton finite_imageI)
          apply blast+
  apply(simp add: lib_lastWr_def lib_writes_on_def tst_def var_def)
  apply(subgoal_tac "Max (insert ts' (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})) = Max  (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})")
          apply simp
  apply(subgoal_tac "ts' <  Max  (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})")
  apply(subgoal_tac "finite ( (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}))")
  apply(subgoal_tac " (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}) \<noteq> {}")
  using member_less_max apply auto[1]
           apply blast+
         apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def)
         apply(elim conjE)
         apply(erule_tac x = "Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})" in allE)
         apply simp
         apply(subgoal_tac " (x, Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})) \<in> lib_writes ls")
         apply(subgoal_tac " b < Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})")
   apply(subgoal_tac "finite ( (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}))")
            apply(subgoal_tac " (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}) \<noteq> {}")
             apply blast
  using image_is_empty apply blast

           apply blast
   apply(subgoal_tac "b\<in> (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})")
   apply(subgoal_tac "finite ( (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}))")
            apply(subgoal_tac " (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}) \<noteq> {}")

  apply (simp add: member_less_max)

  apply blast+
  apply(subgoal_tac "(x,b)\<in> {w. fst w = x \<and> w \<in> lib_writes ls} ")
  apply (simp add: image_iff)

          apply simp
   apply(subgoal_tac "finite ( (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}))")
            apply(subgoal_tac " (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}) \<noteq> {}")
  apply(subgoal_tac "(x, Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}))\<in>{w. fst w = x \<and> w \<in> lib_writes ls}")
            apply blast
   apply(subgoal_tac "finite ( ( {w. fst w = x \<and> w \<in> lib_writes ls}))")
            apply(subgoal_tac " ( {w. fst w = x \<and> w \<in> lib_writes ls}) \<noteq> {}")
  apply(subgoal_tac "Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})\<in>snd ` {w. fst w = x \<and> w \<in> lib_writes ls}")
              apply (simp add: image_iff)
   apply(subgoal_tac "finite ( (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}))")
            apply(subgoal_tac " (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}) \<noteq> {}")
  apply simp
              apply blast+
        apply(simp add: var_def tst_def lib_valid_fresh_ts_def lib_writes_on_def)
  apply auto[1]
       apply blast
  apply auto[1]
        apply(simp add: var_def tst_def lib_valid_fresh_ts_def lib_writes_on_def)
      defer
  apply(subgoal_tac "{w. fst w = xa \<and> (w = (x, ts') \<or> w \<in> lib_writes ls)} = {w. fst w = xa \<and> (w \<in> lib_writes ls)}")
  apply simp
      apply auto[1]
  apply(case_tac "xa = a")
  apply (simp add: finite_lib_writes)
     apply (simp add: finite_lib_writes_2)
  defer
    defer
    apply(subgoal_tac "finite (snd `{w. fst w = x \<and> (w \<in> lib_writes ls)})")
  apply(case_tac "(x, ts')\<in>{w. fst w = x \<and> (w \<in> lib_writes ls)}")
      apply blast
      apply(subgoal_tac " {w. var w = x \<and>  (w = (x, ts') \<or> w \<in> lib_writes ls)} =  {w. var w = x \<and> ( w \<in> lib_writes ls)} \<union> {(x, ts')}")
  apply simp
  using var_def apply auto[1]
apply auto[1]
    apply blast
  apply(subgoal_tac "(x, Max (snd ` {w. fst w = x \<and> w \<in> lib_writes ls}))\<in> {w. fst w = x \<and> w \<in> lib_writes ls}")
    apply blast
   apply(subgoal_tac "finite ( snd`{w. fst w = x \<and> w \<in> lib_writes ls})")
  apply(subgoal_tac "snd` {w. fst w = x \<and> w \<in> lib_writes ls}\<noteq>{}")
  defer
  apply blast+
   apply(subgoal_tac "finite ( snd`{w. fst w = x \<and> w \<in> lib_writes ls})")
  apply(subgoal_tac "snd` {w. fst w = x \<and> w \<in> lib_writes ls}\<noteq>{}")
  defer
     apply blast+
   defer
  proof -
    fix a :: nat and b :: rat and ts' :: rat and aa :: nat and ba :: rat and xa :: nat
    assume a1: "finite (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})"
    assume a2: "snd ` {w. fst w = x \<and> w \<in> lib_writes ls} \<noteq> {}"
    obtain pp :: "(nat \<times> rat) set \<Rightarrow> (nat \<times> rat \<Rightarrow> rat) \<Rightarrow> rat \<Rightarrow> nat \<times> rat" where
      "\<forall>x0 x1 x2. (\<exists>v3. x2 = x1 v3 \<and> v3 \<in> x0) = (x2 = x1 (pp x0 x1 x2) \<and> pp x0 x1 x2 \<in> x0)"
      by moura
    then have f3: "Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls}) = snd (pp {p. fst p = x \<and> p \<in> lib_writes ls} snd (Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls}))) \<and> pp {p. fst p = x \<and> p \<in> lib_writes ls} snd (Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls})) \<in> {p. fst p = x \<and> p \<in> lib_writes ls}"
      using a2 a1 by (meson Max_in imageE)
    then have "fst (pp {p. fst p = x \<and> p \<in> lib_writes ls} snd (Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls}))) = x \<and> pp {p. fst p = x \<and> p \<in> lib_writes ls} snd (Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls})) \<in> lib_writes ls"
      by blast
    then show "(x, Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls})) \<in> lib_writes ls"
      using f3 by (metis (no_types) prod.collapse)
  next
    fix a :: nat and b :: rat and ts' :: rat and aa :: nat and ba :: rat and xa :: nat
    assume a1: "finite (snd ` {w. fst w = x \<and> w \<in> lib_writes ls})"
    assume a2: "snd ` {w. fst w = x \<and> w \<in> lib_writes ls} \<noteq> {}"
    obtain pp :: "(nat \<times> rat) set \<Rightarrow> (nat \<times> rat \<Rightarrow> rat) \<Rightarrow> rat \<Rightarrow> nat \<times> rat" where
      "\<forall>x0 x1 x2. (\<exists>v3. x2 = x1 v3 \<and> v3 \<in> x0) = (x2 = x1 (pp x0 x1 x2) \<and> pp x0 x1 x2 \<in> x0)"
  by moura
  then have f3: "Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls}) = snd (pp {p. fst p = x \<and> p \<in> lib_writes ls} snd (Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls}))) \<and> pp {p. fst p = x \<and> p \<in> lib_writes ls} snd (Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls})) \<in> {p. fst p = x \<and> p \<in> lib_writes ls}"
  using a2 a1 by (meson Max_in imageE)
  then have "fst (pp {p. fst p = x \<and> p \<in> lib_writes ls} snd (Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls}))) = x \<and> pp {p. fst p = x \<and> p \<in> lib_writes ls} snd (Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls})) \<in> lib_writes ls"
  by blast
  then have "(x, Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls})) = pp {p. fst p = x \<and> p \<in> lib_writes ls} snd (Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls}))"
    using f3 by (metis (no_types) prod.collapse)
    then show "(x, Max (snd ` {p. fst p = x \<and> p \<in> lib_writes ls})) \<in> {p. fst p = x \<and> p \<in> lib_writes ls}"
      using f3 by presburger
  qed

lemma lock_acquire_successful_p_obs:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "[lib(x) =\<^sub>t v] ls"
      and "\<not>[lib(x) \<approx>\<^sub>t' u] ls"
      and "u \<ge> v + 2 "
      and "lock_acquire_step t x ls cs  ls' cs' True ver"
    shows "\<not>[lib(x) \<approx>\<^sub>t' u] ls'"
  using assms
  apply(subgoal_tac "[lib(x) =\<^sub>t (v+1)] ls'")
   defer
  using lock_acqure_successful_pres_d_obs apply blast
  apply (case_tac "t = t'", simp_all)
  using d_obs_vw [where ls = ls' and t = t and x = x and u = "(Suc v)" and cs = cs']
  apply simp
    apply(simp add: lib_d_obs_t_def lib_d_obs_def lib_p_obs_def)
   apply(intro allI impI, elim conjE)
  apply(case_tac "(a, b) = lib_lastWr ls' x")
    apply simp
  using lock_acqure_lib_wfs_pres lock_acqure_wfs_pres apply blast
  apply(simp add: lock_acquire_step_def lock_acquire_def)
  apply(elim conjE exE)
  apply(case_tac "even (lib_value ls (a, b))")
  apply(simp add: lib_update_def all_updates_l)
  apply(case_tac "lib_releasing ls (a, b)", simp_all)
   apply(simp add: lib_p_obs_def lib_visible_writes_def lib_writes_on_def)
  apply(simp add: lib_value_def lib_d_obs_t_def lib_d_obs_def)
   apply(intro  impI)
  apply(subgoal_tac "(x, b) = lib_lastWr ls x")
    apply simp
   apply(elim conjE, simp)
  using ts_ge_last_is_last  apply blast
   apply(simp add: lib_p_obs_def lib_visible_writes_def lib_writes_on_def)
  apply(simp add: lib_value_def lib_d_obs_t_def lib_d_obs_def)
   apply(intro  impI)
  apply(subgoal_tac "(x, b) = lib_lastWr ls x")
    apply simp
   apply(elim conjE, simp)
  using ts_ge_last_is_last  by blast

lemma cvd_cvv_val:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "cvd[lib(l),x] ls"
      and "lock_acquire_step t l ls cs  ls' cs' True ver"
    shows "cvv[lib(l),x] ls'"
  using assms
 apply (simp add: lock_acquire_step_def lock_acquire_def all_updates_l lib_covered_v_def lib_covered_val_def lib_d_obs_t_def lib_d_obs_def)
  apply(elim exE conjE)
  apply(case_tac "even (lib_value ls (a, b))", simp_all)
  apply(simp add: lib_update_def)
  apply(simp add: all_updates_l  lib_lastWr_def lib_writes_on_def)
  apply(case_tac "lib_releasing ls (a,b)", simp_all)
   apply(intro conjI)
    apply(simp add: lib_value_def)
    apply(rule_tac x="b" in exI)
  apply(intro conjI impI)
   apply(simp add: lib_valid_fresh_ts_def)
      apply(simp add: lib_visible_writes_def)
  apply (metis (no_types, lifting) assms(3) lib_covered_v_def lib_lastWr_def lib_writes_on_def mem_Collect_eq prod.inject)
    apply(simp add: lib_visible_writes_def)
  apply (metis assms(3) lib_covered_v_def lib_lastWr_def lib_value_def prod.inject)
  apply(intro allI conjI impI)
   apply(simp add: lib_value_def)
  apply(intro conjI impI)
   apply(simp add: lib_visible_writes_def)
  using lib_writes_on_def apply blast
   apply(simp add: lib_visible_writes_def lib_writes_on_def)
  using lib_writes_on_def apply blast
   apply(intro conjI)
    apply(simp add: lib_value_def)
    apply(rule_tac x=b in exI)
  apply(intro conjI impI)
   apply(simp add: lib_valid_fresh_ts_def)
   apply(simp add: lib_visible_writes_def lib_writes_on_def)
  using lib_writes_on_def apply blast
   apply(simp add: lib_visible_writes_def lib_writes_on_def)
  using lib_writes_on_def apply blast
  apply(intro allI conjI impI)
   apply(simp add: lib_value_def)
  apply(intro conjI impI)
   apply(simp add: lib_visible_writes_def)
  using lib_writes_on_def apply blast
   apply(simp add: lib_visible_writes_def lib_writes_on_def)
  using lib_writes_on_def by blast

lemma cvv_lock_acquire_pres:
  assumes "wfs cs"
      and "l_wfs ls cs"
      and "cvv[lib(l),x] ls"
      and "lock_acquire_step t l ls cs  ls' cs' b ver"
    shows "cvv[lib(l),x] ls'"
  using assms
 apply (simp add: lock_acquire_step_def lock_acquire_def lib_update_def lib_covered_v_def lib_covered_val_def lib_d_obs_t_def lib_d_obs_def)
  apply(elim exE conjE)
  apply(case_tac "even (lib_value ls (a, ba))", simp_all)
  apply(simp add: lib_update_def)
   apply(simp add: all_updates_l   lib_lastWr_def lib_writes_on_def)
   apply(case_tac "lib_releasing ls (a, ba)", simp_all)
  apply(intro conjI)
     apply(rule_tac x = baa in exI)
  apply(intro conjI)
      apply blast
     apply(simp add: lib_value_def lib_valid_fresh_ts_def lib_visible_writes_def lib_writes_on_def)
  apply(intro impI)
  using lib_writes_on_def apply blast
  apply(intro allI impI conjI)
     apply(simp add: lib_value_def lib_valid_fresh_ts_def lib_visible_writes_def)
   using lib_writes_on_def less_Suc_eq apply blast
  apply(intro allI impI conjI)
     apply(rule_tac x = baa in exI)
  apply(intro conjI)
      apply blast
     apply(simp add: lib_value_def lib_valid_fresh_ts_def lib_visible_writes_def lib_writes_on_def)
  apply(intro impI)
  using lib_writes_on_def apply blast
     apply(simp add: lib_value_def lib_valid_fresh_ts_def lib_visible_writes_def)
   using lib_writes_on_def less_Suc_eq apply blast
   by blast

  lemma lock_acquire_successful_rv:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "[lib(l) =\<^sub>t u] ls"
      and "lock_acquire_step t l ls cs  ls' cs' True ver"
    shows "ver = u"
  using assms
  apply (simp add: lock_acquire_step_def lock_acquire_def)
  apply safe
  apply(case_tac "even (lib_value ls (a,b))", simp_all)
  apply(simp_all add: lib_update_def update_thrView_def)
  apply(case_tac "lib_releasing ls (a,b)", simp_all)
  apply(simp_all add:all_updates_l  lib_value_def   )
   apply(simp_all add: lib_d_obs_t_def lib_d_obs_def lastWr_def lib_read_def)
  apply (metis assms(3) lib_dobs_visible_writes_last lib_value_def)
  by (metis assms(3) lib_dobs_visible_writes_last lib_value_def)

lemma cvv_val:
  assumes "wfs cs"
      and "lib_wfs ls cs"
      and "cvv[lib(l),x] ls"
      and "lock_acquire_step t l ls cs  ls' cs' True ver"
    shows "ver \<noteq> x"
  using assms
  apply (simp add: lock_acquire_step_def lock_acquire_def lib_d_obs_t_def lib_d_obs_def)
  apply(simp add: lib_covered_val_def)
  apply (elim exE conjE)
  apply(case_tac "even (lib_value ls (a,b))", simp_all)
  apply(simp add: lib_update_def)
  apply(simp add: all_updates_l lib_lastWr_def lib_writes_on_def)
  apply(case_tac "lib_releasing ls (a,b)", simp_all)
  apply(simp add: lib_value_def lib_visible_writes_def lib_writes_on_def)
  using lib_writes_on_def apply blast
  apply(case_tac "lib_releasing ls (a,b)", simp_all)
  apply(simp add: lib_value_def lib_visible_writes_def lib_writes_on_def)
    using lib_writes_on_def by blast

lemma cvv_release:
  assumes "lib_wfs ls cs"
      and "wfs cs"
      and "cvv[lib(l),x] ls"
      and "lock_release_step t l ls cs ls' cs'"
    shows "cvv[lib(l),x] ls'"
  using assms
 apply (simp add: lock_release_step_def lock_release_def lib_covered_val_def lib_d_obs_t_def lib_d_obs_def)
  apply(elim conjE exE, intro conjI allI)
   apply(rule_tac x = a in exI)
   apply(rule_tac x = ba in exI)
   apply(intro conjI)
    apply(simp add: lib_write_def all_updates_l)
  apply(simp add:  lib_lastWr_def lib_writes_on_def)
    apply(simp add: lib_value_def  lib_lastWr_def lib_writes_on_def)
  using a_is_x lib_visible_writes_def lib_writes_on_def apply blast
     apply(simp add: lib_write_def all_updates_l)
  apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def lib_value_def lib_visible_writes_def tst_def var_def)
   apply safe
  using lib_writes_on_def apply blast
     apply(simp add: lib_write_def all_updates_l)
  apply(simp add: lib_valid_fresh_ts_def lib_writes_on_def lib_value_def lib_visible_writes_def tst_def var_def)
  using less_SucI by blast

end


(*
 * Copyright 2014, NICTA
 *
 * 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(NICTA_BSD)
 *)

(* License: BSD, terms see file ./LICENSE *)

theory Vanilla32
imports CTypes "../../lib/WordLib"
begin

section "Words and Pointers"

instantiation unit :: c_type
begin
instance ..
end

definition "unit_tag \<equiv> TypDesc (TypScalar 1 0
      (\<lparr> field_access = (\<lambda>v bs. [0]), field_update = (\<lambda>bs v. ())\<rparr>)) ''unit''"

declare unit_tag_def [simp]

defs (overloaded)
  typ_info_unit [simp]: "typ_info_t (x::unit itself) \<equiv> unit_tag"

instantiation unit :: mem_type
begin
  definition
    to_bytes_unit :: "unit \<Rightarrow> byte list" where
    "to_bytes_unit a \<equiv> [0]"

  definition
    from_bytes_unit :: "byte list \<Rightarrow> unit" where
    "from_bytes_unit bs \<equiv> ()"

  definition
    size_of_unit :: "unit itself \<Rightarrow> nat" where
    "size_of_unit x \<equiv> 0"

  definition
    align_of_unit :: "unit itself \<Rightarrow> nat" where
    "align_of_unit x \<equiv> 1"

  instance
    apply intro_classes
    apply (auto simp: size_of_def typ_info_unit align_of_def align_field_def addr_card
                      wf_lf_def fd_cons_desc_def
                      fd_cons_double_update_def fd_cons_update_access_def
                      fd_cons_access_update_def fd_cons_length_def)
  done
end

definition
  "bogus_log2lessthree (n::nat) ==
             if n = 64 then (3::nat)
             else if n = 32 then 2
             else if n = 16 then 1
             else if n = 8 then 0
             else undefined"
definition
  "len_exp (x::('a::len) itself) \<equiv> bogus_log2lessthree (len_of TYPE('a))"

lemma lx8' [simp] : "len_exp (x::8 itself) = 0"
by (simp add: len_exp_def bogus_log2lessthree_def)

lemma lx16' [simp]: "len_exp (x::16 itself) = 1"
by (simp add: len_exp_def bogus_log2lessthree_def)

lemma lx32' [simp]: "len_exp (x::32 itself) = 2"
by (simp add: len_exp_def bogus_log2lessthree_def)

lemma lx64' [simp]: "len_exp (x::64 itself) = 3"
by (simp add: len_exp_def bogus_log2lessthree_def)

lemma lx_signed' [simp]: "len_exp (x::('a::len) signed itself) = len_exp (TYPE('a))"
  by (simp add: len_exp_def)

class len8 = len +
  (* this constraint gives us (in the most convoluted way possible) that we're only
     interested in words with a length that is divisible by 8 *)
  assumes len8_bytes: "len_of TYPE('a::len) = 8 * (2^len_exp TYPE('a))"
  (* len8_len class gives us that the words are \<le> than 128 bits.
     This is a wacky restriction really, but we're really only interested in words
     up to 64 bits, so who cares. *)
  assumes len8_width: "len_of TYPE('a::len) \<le> 128"
begin

lemma len8_size:
  "len_of TYPE('a) div 8 < addr_card"
apply(subgoal_tac "len_of TYPE('a) \<le> 128")
 apply(simp add: addr_card)
apply(rule len8_width)
done

lemma len8_dv8:
  "8 dvd len_of TYPE('a)"
  by (simp add: len8_bytes)

lemma len8_pow:
  "\<exists>k. len_of TYPE('a) div 8 = 2^k"
  by (simp add: len8_bytes)

end

fun
  nat_to_bin_string :: "nat \<Rightarrow> char list"
  where
  ntbs: "nat_to_bin_string n = (if (n = 0) then ''0'' else (if n mod 2 = 1 then CHR ''1'' else CHR ''0'') # nat_to_bin_string (n div 2))"

declare nat_to_bin_string.simps [simp del]

lemma nat_to_bin_string_simps:
  "nat_to_bin_string 0 = ''0''"
  "n > 0 \<Longrightarrow> nat_to_bin_string n =
      (if n mod 2 = 1 then CHR ''1'' else CHR ''0'') # nat_to_bin_string (n div 2)"
  apply (induct n, auto simp: nat_to_bin_string.simps)
  done

(* Little-endian encoding *)
definition
  word_tag :: "'a::len8 word itself \<Rightarrow> 'a word typ_info"
where
  "word_tag (w::'a::len8 word itself) \<equiv> TypDesc (TypScalar (len_of TYPE('a) div 8) (len_exp TYPE('a)) \<lparr> field_access = \<lambda>v bs. (rev o word_rsplit) v, field_update = \<lambda>bs v. (word_rcat (rev bs)::'a::len8 word) \<rparr>)  (''word'' @  nat_to_bin_string (len_of TYPE('a)) )"

instantiation word :: (len8) c_type
begin
instance ..
end

instance signed :: (len8) len8
  apply intro_classes
   apply (metis len8_bytes len_exp_def len_signed)
  apply (metis len8_width len_signed)
  done

defs (overloaded)
  typ_info_word: "typ_info_t (w::'a::len8 word itself) \<equiv> word_tag w"

defs (overloaded)
  typ_name_itself_word: "typ_name_itself (w::'a::len8 word itself) \<equiv> typ_name (typ_info_t w)"

lemma align_of_word:
  "align_of TYPE('a::len8 word) = len_of TYPE('a) div 8"
  by (simp add: align_of_def typ_info_word word_tag_def len8_bytes)

instantiation word :: (len8) mem_type
begin

instance
proof intro_classes
  show "\<And>bs v w. length bs = size_of TYPE('a word) \<longrightarrow>
       update_ti_t (typ_info_t TYPE('a word)) bs v =
       update_ti_t (typ_info_t TYPE('a word)) bs w"
    by (simp add: typ_info_word word_tag_def size_of_def)
next
  show "wf_desc (typ_info_t TYPE('a word))"
    by (simp add: typ_info_word word_tag_def)
next
  have "8 dvd len_of TYPE('a)" by (rule len8_dv8)
  moreover have "0 < len_of TYPE('a)" by simp
  ultimately have "0 < len_of TYPE('a) div 8" by - (erule dvdE, simp)
  thus "wf_size_desc (typ_info_t TYPE('a word))"
    by (simp add: typ_info_word word_tag_def len8_pow)
next
  have "8 dvd len_of TYPE('a)" by (rule len8_dv8)
  thus "wf_lf (lf_set (typ_info_t TYPE('a word)) [])"
  by (auto simp: typ_info_word word_tag_def wf_lf_def
    fd_cons_def fd_cons_double_update_def fd_cons_update_access_def
    word_rcat_rsplit fd_cons_access_update_def fd_cons_length_def
    length_word_rsplit_exp_size' word_size fd_cons_update_normalise_def
    fd_cons_desc_def
    field_norm_def elim: dvdE)
next
  show "size_of TYPE('a word) < addr_card"
    by (simp add: size_of_def typ_info_word word_tag_def)
       (rule len8_size)
next
  show "align_of TYPE('a word) dvd size_of TYPE('a word)"
    by (clarsimp simp: size_of_def align_of_word typ_info_word
                       word_tag_def)
next
  show "align_field (typ_info_t TYPE('a word))"
    by (clarsimp simp: typ_info_word word_tag_def align_field_def)
qed

end

instantiation word :: (len8) simple_mem_type
begin

instance
  apply intro_classes
  apply(clarsimp simp: typ_info_word word_tag_def typ_uinfo_t_def)
  done

end

class len_eq1 = len +
  assumes len_eq1: "len_of TYPE('a::len) = 1"
instance num1 :: len_eq1
by (intro_classes, simp)

(* naming scheme len_lg<digit1><digit2> means the log of the length is between
   digit1 and digit2 inclusive *)
class len_lg01 = len +
  assumes len_lg01: "len_of TYPE('a::len) \<in> {1,2}"
instance bit0 :: (len_eq1) len_lg01
by (intro_classes, simp add: len_eq1)
instance num1 :: len_lg01
by (intro_classes, simp)

class len_lg02 = len +
  assumes len_lg02: "len_of TYPE('a::len) \<in> {1,2,4}"
instance bit0 :: (len_lg01) len_lg02
apply intro_classes
apply (insert len_lg01[where 'a = 'a])
apply simp
done
instance num1 :: len_lg02
by (intro_classes, simp)

class len_lg03 = len +
  assumes len_lg03: "len_of TYPE('a::len) \<in> {1,2,4,8}"
instance bit0 :: (len_lg02) len_lg03
apply intro_classes
apply (insert len_lg02[where 'a = 'a])
apply simp
done
instance num1 :: len_lg03
by (intro_classes, simp)

class len_lg14 = len +
  assumes len_lg14: "len_of TYPE('a::len) \<in> {2,4,8,16}"
instance bit0 :: (len_lg03) len_lg14
apply intro_classes
apply (insert len_lg03[where 'a = 'a])
apply simp
done

class len_lg25 = len +
  assumes len_lg25: "len_of TYPE('a::len) \<in> {4,8,16,32}"
instance bit0 :: (len_lg14) len_lg25
apply intro_classes
apply (insert len_lg14[where 'a = 'a])
apply simp
done

instance bit0 :: (len_lg25) len8
apply intro_classes
  apply simp
  apply (insert len_lg25[where 'a = 'a])
  apply (simp add: len_exp_def)
  apply (erule disjE)
    apply (simp add: bogus_log2lessthree_def len8_bytes len8_width)
  apply (erule disjE)
    apply (simp add: bogus_log2lessthree_def)
  apply (erule disjE)
    apply (simp add: bogus_log2lessthree_def)
  apply (simp add: bogus_log2lessthree_def)
apply simp
apply auto
done

instance signed :: (len_eq1) len_eq1     using len_eq1  by (intro_classes, simp)
instance signed :: (len_lg01) len_lg01   using len_lg01 by (intro_classes, simp)
instance signed :: (len_lg02) len_lg02   using len_lg02 by (intro_classes, simp)
instance signed :: (len_lg03) len_lg03   using len_lg03 by (intro_classes, simp)
instance signed :: (len_lg14) len_lg14   using len_lg14 by (intro_classes, simp)
instance signed :: (len_lg25) len_lg25   using len_lg25 by (intro_classes, simp)

lemma
  "to_bytes (1*256*256*256 + 2*256*256 + 3*256 + (4::32 word)) bs = [4, 3, 2, 1]"
  by (simp add: to_bytes_def typ_info_word word_tag_def Let_def)

lemma size_td_words [simp]:
  "size_td (typ_info_t TYPE(8 word)) = 1"
  "size_td (typ_info_t TYPE(16 word)) = 2"
  "size_td (typ_info_t TYPE(32 word)) = 4"
  "size_td (typ_info_t TYPE(64 word)) = 8"
  by (auto simp: typ_info_word word_tag_def)

lemma align_td_words [simp]:
  "align_td (typ_info_t TYPE(8 word)) = 0"
  "align_td (typ_info_t TYPE(16 word)) = 1"
  "align_td (typ_info_t TYPE(32 word)) = 2"
  "align_td (typ_info_t TYPE(64 word)) = 3"
  by (auto simp: typ_info_word word_tag_def len8_bytes)

lemma size_of_words [simp]:
  "size_of TYPE(8 word) = 1"
  "size_of TYPE(16 word) = 2"
  "size_of TYPE(32 word) = 4"
  "size_of TYPE(64 word) = 8"
  by (auto simp: size_of_def)

lemma align_of_words [simp]:
  "align_of TYPE(8 word) = 1"
  "align_of TYPE(16 word) = 2"
  "align_of TYPE(32 word) = 4"
  "align_of TYPE(64 word) = 8"
  by (auto simp: align_of_word)

lemma size_td_swords [simp]:
  "size_td (typ_info_t TYPE(8 sword)) = 1"
  "size_td (typ_info_t TYPE(16 sword)) = 2"
  "size_td (typ_info_t TYPE(32 sword)) = 4"
  "size_td (typ_info_t TYPE(64 sword)) = 8"
  by (auto simp: typ_info_word word_tag_def)

lemma align_td_swords [simp]:
  "align_td (typ_info_t TYPE(8 sword)) = 0"
  "align_td (typ_info_t TYPE(16 sword)) = 1"
  "align_td (typ_info_t TYPE(32 sword)) = 2"
  "align_td (typ_info_t TYPE(64 sword)) = 3"
  by (auto simp: typ_info_word word_tag_def len8_bytes)

lemma size_of_swords [simp]:
  "size_of TYPE(8 sword) = 1"
  "size_of TYPE(16 sword) = 2"
  "size_of TYPE(32 sword) = 4"
  "size_of TYPE(64 sword) = 8"
  by (auto simp: size_of_def)

lemma align_of_swords [simp]:
  "align_of TYPE(8 sword) = 1"
  "align_of TYPE(16 sword) = 2"
  "align_of TYPE(32 sword) = 4"
  "align_of TYPE(64 sword) = 8"
  by (auto simp: align_of_word)

instantiation ptr :: (type) c_type
begin
instance ..
end

defs (overloaded)
  typ_info_ptr:
  "typ_info_t (p::'a::c_type ptr itself) \<equiv> TypDesc
    (TypScalar 4 2 \<lparr> field_access = \<lambda>p bs. rev (word_rsplit (ptr_val p)),
        field_update = \<lambda>bs v. Ptr (word_rcat (rev bs)::addr) \<rparr> )
    (typ_name_itself TYPE('a) @ ''+ptr'')"

defs (overloaded)
  typ_name_itself_ptr:
  "typ_name_itself (p::'a::c_type ptr itself) \<equiv>
    typ_name_itself TYPE('a) @ ''+ptr''"

defs (overloaded)
  typ_name_itself_unit [simp]:
  "typ_name_itself (p::unit itself) \<equiv> ''void''"

lemma align_of_ptr [simp]:
  "align_of (p::'a::c_type ptr itself) = 4"
  by (simp add: align_of_def typ_info_ptr)

instantiation ptr :: (c_type) mem_type
begin
instance
  apply (intro_classes)
    apply (auto simp:  to_bytes_def from_bytes_def
                 length_word_rsplit_exp_size' word_size align_of_ptr
                 word_rcat_rsplit size_of_def  addr_card
                 typ_info_ptr fd_cons_double_update_def
                 fd_cons_update_access_def fd_cons_access_update_def
                 fd_cons_length_def fd_cons_update_normalise_def field_norm_def
                 super_update_bs_def word_rsplit_rcat_size norm_bytes_def
                 fd_consistent_def fd_cons_def wf_lf_def
                 fd_cons_desc_def align_field_def)
  done
end

instantiation ptr :: (c_type) simple_mem_type
begin
instance
  apply intro_classes
  apply(clarsimp simp: typ_info_ptr typ_uinfo_t_def)
  done
end

lemma size_td_ptr [simp]:
  "size_td (typ_info_t TYPE('a::c_type ptr)) = 4"
  by (simp add: typ_info_ptr)

lemma size_of_ptr [simp]:
  "size_of TYPE('a::c_type ptr) = 4"
  by (simp add: size_of_def)

lemma align_td_ptr [simp]: "align_td (typ_info_t TYPE('a::c_type ptr)) = 2"
  by (simp add: typ_info_ptr)

lemma ptr_add_word32_signed [simp]:
  fixes a :: "32 word ptr"
  shows "ptr_val (a +\<^sub>p x) = ptr_val a + 4 * of_int x"
  by (cases a) (simp add: ptr_add_def scast_id)

lemma ptr_add_word32 [simp]:
  fixes a :: "32 word ptr" and x :: "32 word"
  shows "ptr_val (a +\<^sub>p uint x) = ptr_val a + 4 * x"
  by (cases a) (simp add: ptr_add_def scast_id)

lemma ptr_add_0_id[simp]:"x +\<^sub>p 0 = x"
  by (clarsimp simp:ptr_add_def)

lemma from_bytes_ptr_to_bytes_ptr:
  "from_bytes (to_bytes (v::32 word) bs) = (Ptr v :: 'a::c_type ptr)"
  by (simp add: from_bytes_def to_bytes_def typ_info_ptr word_tag_def
                typ_info_word word_size
                length_word_rsplit_exp_size' word_rcat_rsplit)

lemma ptr_aligned_coerceI:
  "ptr_aligned (ptr_coerce x::32 word ptr) \<Longrightarrow>
      ptr_aligned (x::'a::mem_type ptr ptr)"
  by (simp add: ptr_aligned_def)

lemma lift_ptr_ptr [simp]:
  "\<And>p::'a::mem_type ptr ptr.
  lift h (ptr_coerce p) = ptr_val (lift h p)"
  by (simp add: lift_def h_val_def from_bytes_def from_bytes_def
                typ_info_word word_tag_def typ_info_ptr)

lemmas Vanilla32_tags [simp] =
  typ_info_word typ_info_ptr typ_name_itself_ptr word_tag_def
  typ_name_itself_word

lemma ptr_typ_name [simp]:
  "typ_name (typ_info_t TYPE(('a :: c_type) ptr)) =  typ_name_itself TYPE('a) @ ''+ptr'' "
  by simp

lemma word_typ_name [simp]:
  "typ_name (typ_info_t TYPE('a::len8 word)) = ''word'' @ nat_to_bin_string (len_of TYPE('a))"
  by simp

lemma typ_name_words [simp]:
   "typ_name (typ_uinfo_t TYPE(8 word))  = ''word00010''"
   "typ_name (typ_uinfo_t TYPE(16 word)) = ''word000010''"
   "typ_name (typ_uinfo_t TYPE(32 word)) = ''word0000010''"
   "typ_name (typ_uinfo_t TYPE(64 word)) = ''word00000010''"
   "typ_name (typ_info_t  TYPE(8 word))  = ''word00010''"
   "typ_name (typ_info_t  TYPE(16 word)) = ''word000010''"
   "typ_name (typ_info_t  TYPE(32 word)) = ''word0000010''"
   "typ_name (typ_info_t  TYPE(64 word)) = ''word00000010''"
  by (auto simp: typ_uinfo_t_def nat_to_bin_string.simps)

lemma typ_name_swords [simp]:
   "typ_name (typ_uinfo_t TYPE(8 sword))  = ''word00010''"
   "typ_name (typ_uinfo_t TYPE(16 sword)) = ''word000010''"
   "typ_name (typ_uinfo_t TYPE(32 sword)) = ''word0000010''"
   "typ_name (typ_uinfo_t TYPE(64 sword)) = ''word00000010''"
   "typ_name (typ_info_t  TYPE(8 sword))  = ''word00010''"
   "typ_name (typ_info_t  TYPE(16 sword)) = ''word000010''"
   "typ_name (typ_info_t  TYPE(32 sword)) = ''word0000010''"
   "typ_name (typ_info_t  TYPE(64 sword)) = ''word00000010''"
  by (auto simp: typ_uinfo_t_def nat_to_bin_string.simps)

lemma ptr_arith[simp]:
  "(x +\<^sub>p a = y +\<^sub>p a) = ((x::('a::c_type) ptr) = (y::'a ptr))"
  by (clarsimp simp:ptr_add_def)

lemma ptr_arith'[simp]:
  "(ptr_coerce (x +\<^sub>p a) = ptr_coerce (y +\<^sub>p a)) = ((x::('a::c_type) ptr) = (y::'a ptr))"
  by (clarsimp simp:ptr_add_def)

end


(*  Title:      HOL/MicroJava/J/Conform.thy
    Author:     David von Oheimb
    Copyright   1999 Technische Universitaet Muenchen
*)

section {* Conformity Relations for Type Soundness Proof *}

theory Conform imports State WellType Exceptions begin

type_synonym 'c env' = "'c prog \<times> (vname \<rightharpoonup> ty)"  -- "same as @{text env} of @{text WellType.thy}"

definition hext :: "aheap => aheap => bool" ("_ <=| _" [51,51] 50) where
 "h<=|h' == \<forall>a C fs. h a = Some(C,fs) --> (\<exists>fs'. h' a = Some(C,fs'))"

definition conf :: "'c prog => aheap => val => ty => bool"
                                   ("_,_ |- _ ::<= _"  [51,51,51,51] 50) where
 "G,h|-v::<=T == \<exists>T'. typeof (map_option obj_ty o h) v = Some T' \<and> G\<turnstile>T'\<preceq>T"

definition lconf :: "'c prog => aheap => ('a \<rightharpoonup> val) => ('a \<rightharpoonup> ty) => bool"
                                   ("_,_ |- _ [::<=] _" [51,51,51,51] 50) where
 "G,h|-vs[::<=]Ts == \<forall>n T. Ts n = Some T --> (\<exists>v. vs n = Some v \<and> G,h|-v::<=T)"

definition oconf :: "'c prog => aheap => obj => bool" ("_,_ |- _ [ok]" [51,51,51] 50) where
 "G,h|-obj [ok] == G,h|-snd obj[::<=]map_of (fields (G,fst obj))"

definition hconf :: "'c prog => aheap => bool" ("_ |-h _ [ok]" [51,51] 50) where
 "G|-h h [ok]    == \<forall>a obj. h a = Some obj --> G,h|-obj [ok]"

definition xconf :: "aheap \<Rightarrow> val option \<Rightarrow> bool" where
  "xconf hp vo  == preallocated hp \<and> (\<forall> v. (vo = Some v) \<longrightarrow> (\<exists> xc. v = (Addr (XcptRef xc))))"

definition conforms :: "xstate => java_mb env' => bool" ("_ ::<= _" [51,51] 50) where
 "s::<=E == prg E|-h heap (store s) [ok] \<and>
            prg E,heap (store s)|-locals (store s)[::<=]localT E \<and>
            xconf (heap (store s)) (abrupt s)"

notation (xsymbols)
  hext  ("_ \<le>| _" [51,51] 50) and
  conf  ("_,_ \<turnstile> _ ::\<preceq> _" [51,51,51,51] 50) and
  lconf  ("_,_ \<turnstile> _ [::\<preceq>] _" [51,51,51,51] 50) and
  oconf  ("_,_ \<turnstile> _ \<surd>" [51,51,51] 50) and
  hconf  ("_ \<turnstile>h _ \<surd>" [51,51] 50) and
  conforms  ("_ ::\<preceq> _" [51,51] 50)

subsection "hext"

lemma hextI:
" \<forall>a C fs . h  a = Some (C,fs) -->
      (\<exists>fs'. h' a = Some (C,fs')) ==> h\<le>|h'"
apply (unfold hext_def)
apply auto
done

lemma hext_objD: "[|h\<le>|h'; h a = Some (C,fs) |] ==> \<exists>fs'. h' a = Some (C,fs')"
apply (unfold hext_def)
apply (force)
done

lemma hext_refl [simp]: "h\<le>|h"
apply (rule hextI)
apply (fast)
done

lemma hext_new [simp]: "h a = None ==> h\<le>|h(a\<mapsto>x)"
apply (rule hextI)
apply auto
done

lemma hext_trans: "[|h\<le>|h'; h'\<le>|h''|] ==> h\<le>|h''"
apply (rule hextI)
apply (fast dest: hext_objD)
done

lemma hext_upd_obj: "h a = Some (C,fs) ==> h\<le>|h(a\<mapsto>(C,fs'))"
apply (rule hextI)
apply auto
done

subsection "conf"

lemma conf_Null [simp]: "G,h\<turnstile>Null::\<preceq>T = G\<turnstile>RefT NullT\<preceq>T"
apply (unfold conf_def)
apply (simp (no_asm))
done

lemma conf_litval [rule_format (no_asm), simp]:
  "typeof (\<lambda>v. None) v = Some T --> G,h\<turnstile>v::\<preceq>T"
apply (unfold conf_def)
apply (rule val.induct)
apply auto
done

lemma conf_AddrI: "[|h a = Some obj; G\<turnstile>obj_ty obj\<preceq>T|] ==> G,h\<turnstile>Addr a::\<preceq>T"
apply (unfold conf_def)
apply (simp)
done

lemma conf_obj_AddrI: "[|h a = Some (C,fs); G\<turnstile>C\<preceq>C D|] ==> G,h\<turnstile>Addr a::\<preceq> Class D"
apply (unfold conf_def)
apply (simp)
done

lemma defval_conf [rule_format (no_asm)]:
  "is_type G T --> G,h\<turnstile>default_val T::\<preceq>T"
apply (unfold conf_def)
apply (rule_tac y = "T" in ty.exhaust)
apply  (erule ssubst)
apply  (rename_tac prim_ty, rule_tac y = "prim_ty" in prim_ty.exhaust)
apply    (auto simp add: widen.null)
done

lemma conf_upd_obj:
"h a = Some (C,fs) ==> (G,h(a\<mapsto>(C,fs'))\<turnstile>x::\<preceq>T) = (G,h\<turnstile>x::\<preceq>T)"
apply (unfold conf_def)
apply (rule val.induct)
apply auto
done

lemma conf_widen [rule_format (no_asm)]:
  "wf_prog wf_mb G ==> G,h\<turnstile>x::\<preceq>T --> G\<turnstile>T\<preceq>T' --> G,h\<turnstile>x::\<preceq>T'"
apply (unfold conf_def)
apply (rule val.induct)
apply (auto intro: widen_trans)
done

lemma conf_hext [rule_format (no_asm)]: "h\<le>|h' ==> G,h\<turnstile>v::\<preceq>T --> G,h'\<turnstile>v::\<preceq>T"
apply (unfold conf_def)
apply (rule val.induct)
apply (auto dest: hext_objD)
done

lemma new_locD: "[|h a = None; G,h\<turnstile>Addr t::\<preceq>T|] ==> t\<noteq>a"
apply (unfold conf_def)
apply auto
done

lemma conf_RefTD [rule_format]:
 "G,h\<turnstile>a'::\<preceq>RefT T \<Longrightarrow> a' = Null \<or>
  (\<exists>a obj T'. a' = Addr a \<and>  h a = Some obj \<and>  obj_ty obj = T' \<and>  G\<turnstile>T'\<preceq>RefT T)"
unfolding conf_def by (induct a') auto

lemma conf_NullTD: "G,h\<turnstile>a'::\<preceq>RefT NullT ==> a' = Null"
apply (drule conf_RefTD)
apply auto
done

lemma non_npD: "[|a' \<noteq> Null; G,h\<turnstile>a'::\<preceq>RefT t|] ==>
  \<exists>a C fs. a' = Addr a \<and>  h a = Some (C,fs) \<and>  G\<turnstile>Class C\<preceq>RefT t"
apply (drule conf_RefTD)
apply auto
done

lemma non_np_objD: "!!G. [|a' \<noteq> Null; G,h\<turnstile>a'::\<preceq> Class C|] ==>
  (\<exists>a C' fs. a' = Addr a \<and>  h a = Some (C',fs) \<and>  G\<turnstile>C'\<preceq>C C)"
apply (fast dest: non_npD)
done

lemma non_np_objD' [rule_format (no_asm)]:
  "a' \<noteq> Null ==> wf_prog wf_mb G ==> G,h\<turnstile>a'::\<preceq>RefT t -->
  (\<exists>a C fs. a' = Addr a \<and>  h a = Some (C,fs) \<and>  G\<turnstile>Class C\<preceq>RefT t)"
apply(rule_tac y = "t" in ref_ty.exhaust)
 apply (fast dest: conf_NullTD)
apply (fast dest: non_np_objD)
done

lemma conf_list_gext_widen [rule_format (no_asm)]:
  "wf_prog wf_mb G ==> \<forall>Ts Ts'. list_all2 (conf G h) vs Ts -->
  list_all2 (\<lambda>T T'. G\<turnstile>T\<preceq>T') Ts Ts' -->  list_all2 (conf G h) vs Ts'"
apply(induct_tac "vs")
 apply(clarsimp)
apply(clarsimp)
apply(frule list_all2_lengthD [THEN sym])
apply(simp (no_asm_use) add: length_Suc_conv)
apply(safe)
apply(frule list_all2_lengthD [THEN sym])
apply(simp (no_asm_use) add: length_Suc_conv)
apply(clarify)
apply(fast elim: conf_widen)
done

subsection "lconf"

lemma lconfD: "[| G,h\<turnstile>vs[::\<preceq>]Ts; Ts n = Some T |] ==> G,h\<turnstile>(the (vs n))::\<preceq>T"
apply (unfold lconf_def)
apply (force)
done

lemma lconf_hext [elim]: "[| G,h\<turnstile>l[::\<preceq>]L; h\<le>|h' |] ==> G,h'\<turnstile>l[::\<preceq>]L"
apply (unfold lconf_def)
apply  (fast elim: conf_hext)
done

lemma lconf_upd: "!!X. [| G,h\<turnstile>l[::\<preceq>]lT;
  G,h\<turnstile>v::\<preceq>T; lT va = Some T |] ==> G,h\<turnstile>l(va\<mapsto>v)[::\<preceq>]lT"
apply (unfold lconf_def)
apply auto
done

lemma lconf_init_vars_lemma [rule_format (no_asm)]:
  "\<forall>x. P x --> R (dv x) x ==> (\<forall>x. map_of fs f = Some x --> P x) -->
  (\<forall>T. map_of fs f = Some T -->
  (\<exists>v. map_of (map (\<lambda>(f,ft). (f, dv ft)) fs) f = Some v \<and>  R v T))"
apply( induct_tac "fs")
apply auto
done

lemma lconf_init_vars [intro!]:
"\<forall>n. \<forall>T. map_of fs n = Some T --> is_type G T ==> G,h\<turnstile>init_vars fs[::\<preceq>]map_of fs"
apply (unfold lconf_def init_vars_def)
apply auto
apply( rule lconf_init_vars_lemma)
apply(   erule_tac [3] asm_rl)
apply(  intro strip)
apply(  erule defval_conf)
apply auto
done

lemma lconf_ext: "[|G,s\<turnstile>l[::\<preceq>]L; G,s\<turnstile>v::\<preceq>T|] ==> G,s\<turnstile>l(vn\<mapsto>v)[::\<preceq>]L(vn\<mapsto>T)"
apply (unfold lconf_def)
apply auto
done

lemma lconf_ext_list [rule_format (no_asm)]:
  "G,h\<turnstile>l[::\<preceq>]L ==> \<forall>vs Ts. distinct vns --> length Ts = length vns -->
  list_all2 (\<lambda>v T. G,h\<turnstile>v::\<preceq>T) vs Ts --> G,h\<turnstile>l(vns[\<mapsto>]vs)[::\<preceq>]L(vns[\<mapsto>]Ts)"
apply (unfold lconf_def)
apply( induct_tac "vns")
apply(  clarsimp)
apply( clarsimp)
apply( frule list_all2_lengthD)
apply( auto simp add: length_Suc_conv)
done

lemma lconf_restr: "\<lbrakk>lT vn = None; G, h \<turnstile> l [::\<preceq>] lT(vn\<mapsto>T)\<rbrakk> \<Longrightarrow> G, h \<turnstile> l [::\<preceq>] lT"
apply (unfold lconf_def)
apply (intro strip)
apply (case_tac "n = vn")
apply auto
done

subsection "oconf"

lemma oconf_hext: "G,h\<turnstile>obj\<surd> ==> h\<le>|h' ==> G,h'\<turnstile>obj\<surd>"
apply (unfold oconf_def)
apply (fast)
done

lemma oconf_obj: "G,h\<turnstile>(C,fs)\<surd> =
  (\<forall>T f. map_of(fields (G,C)) f = Some T --> (\<exists>v. fs f = Some v \<and>  G,h\<turnstile>v::\<preceq>T))"
apply (unfold oconf_def lconf_def)
apply auto
done

lemmas oconf_objD = oconf_obj [THEN iffD1, THEN spec, THEN spec, THEN mp]

subsection "hconf"

lemma hconfD: "[|G\<turnstile>h h\<surd>; h a = Some obj|] ==> G,h\<turnstile>obj\<surd>"
apply (unfold hconf_def)
apply (fast)
done

lemma hconfI: "\<forall>a obj. h a=Some obj --> G,h\<turnstile>obj\<surd> ==> G\<turnstile>h h\<surd>"
apply (unfold hconf_def)
apply (fast)
done

subsection "xconf"

lemma xconf_raise_if: "xconf h x \<Longrightarrow> xconf h (raise_if b xcn x)"
by (simp add: xconf_def raise_if_def)

subsection "conforms"

lemma conforms_heapD: "(x, (h, l))::\<preceq>(G, lT) ==> G\<turnstile>h h\<surd>"
apply (unfold conforms_def)
apply (simp)
done

lemma conforms_localD: "(x, (h, l))::\<preceq>(G, lT) ==> G,h\<turnstile>l[::\<preceq>]lT"
apply (unfold conforms_def)
apply (simp)
done

lemma conforms_xcptD: "(x, (h, l))::\<preceq>(G, lT) ==> xconf h x"
apply (unfold conforms_def)
apply (simp)
done

lemma conformsI: "[|G\<turnstile>h h\<surd>; G,h\<turnstile>l[::\<preceq>]lT; xconf h x|] ==> (x, (h, l))::\<preceq>(G, lT)"
apply (unfold conforms_def)
apply auto
done

lemma conforms_restr: "\<lbrakk>lT vn = None; s ::\<preceq> (G, lT(vn\<mapsto>T)) \<rbrakk> \<Longrightarrow> s ::\<preceq> (G, lT)"
by (simp add: conforms_def, fast intro: lconf_restr)

lemma conforms_xcpt_change: "\<lbrakk> (x, (h,l))::\<preceq> (G, lT); xconf h x \<longrightarrow> xconf h x' \<rbrakk> \<Longrightarrow> (x', (h,l))::\<preceq> (G, lT)"
by (simp add: conforms_def)

lemma preallocated_hext: "\<lbrakk> preallocated h; h\<le>|h'\<rbrakk> \<Longrightarrow> preallocated h'"
by (simp add: preallocated_def hext_def)

lemma xconf_hext: "\<lbrakk> xconf h vo; h\<le>|h'\<rbrakk> \<Longrightarrow> xconf h' vo"
by (simp add: xconf_def preallocated_def hext_def)

lemma conforms_hext: "[|(x,(h,l))::\<preceq>(G,lT); h\<le>|h'; G\<turnstile>h h'\<surd> |]
  ==> (x,(h',l))::\<preceq>(G,lT)"
by (fast dest: conforms_localD conforms_xcptD elim!: conformsI xconf_hext)

lemma conforms_upd_obj:
  "[|(x,(h,l))::\<preceq>(G, lT); G,h(a\<mapsto>obj)\<turnstile>obj\<surd>; h\<le>|h(a\<mapsto>obj)|]
  ==> (x,(h(a\<mapsto>obj),l))::\<preceq>(G, lT)"
apply(rule conforms_hext)
apply  auto
apply(rule hconfI)
apply(drule conforms_heapD)
apply(auto elim: oconf_hext dest: hconfD)
done

lemma conforms_upd_local:
"[|(x,(h, l))::\<preceq>(G, lT); G,h\<turnstile>v::\<preceq>T; lT va = Some T|]
  ==> (x,(h, l(va\<mapsto>v)))::\<preceq>(G, lT)"
apply (unfold conforms_def)
apply( auto elim: lconf_upd)
done

end


           (*-------------------------------------------------*
            |                 (a part of) ep2                 |
            |                  September 2004                 |
            |                   December 2004 (modified)      |
            |                   November 2005 (modified)      |
            |                      April 2006 (modified)      |
            |                      March 2007 (modified)      |
            |                                                 |
            |        CSP-Prover on Isabelle2009               |
            |                       June 2009  (modified)     |
            |                                                 |
            |        CSP-Prover on Isabelle2016               |
            |                        May 2016  (modified)     |
            |                                                 |
            |  Markus Roggenbach (Univ of Wales Swansea, UK)  |
            |  Yoshinao Isobe    (AIST, Japan)                |
            *-------------------------------------------------*)

theory ep2_ccl
imports ep2_acl
begin

(*********************************************************
                    functions
 *********************************************************)

(* pair *)
definition
  state  :: "TerminalState * Trigger => TerminalState"
  where
  state_def  : "state p == fst p"

definition
  trigger:: "TerminalState * Trigger => Trigger"
  where
  trigger_def: "trigger p == snd p"

(* Session start *)
consts
  sessionStart:: "Trigger => D_SI_Init_SessionStart"

(* ConfigDataRequest *)
consts
  configDataResponse::
    "D_SI_Init_ConfigDataRequest * TerminalState =>
     D_SI_Init_ConfigDataResponse"

(* ConfigDataNotification *)
consts
  configDataAcknowledge:: D_SI_Init_ConfigDataAcknowledge
  configData::
    "D_SI_Init_ConfigDataNotification * TerminalState =>
     TerminalState"

(* ConfigDataRemove *)
consts
  removeDataAcknowledge:: D_SI_Init_RemoveConfigDataAcknowledge
  removeData:: "D_SI_Init_RemoveConfigDataNotification * TerminalState =>
                TerminalState"

(* ActivateConfigDataNotification *)
consts
  activateDataAcknowledge:: D_SI_Init_ActivateConfigDataAcknowledge
  activateData:: "D_SI_Init_ActivateConfigDataNotification * TerminalState =>
                  TerminalState"

(* Message *)
consts
  AcqConnectionFailed    :: Message
  InitialisationFinished :: Message
  InitialisationFailed   :: Message

(*********************************************************
         concrete component description level
 *********************************************************)

datatype CCName = CTInit "TerminalState * Trigger"
                | CTConfigurationManagement "TerminalState * Trigger"
                | CAcquirerInit
                | CConfigurationManagement

fun
  CCfun :: "CCName => (CCName, Event) proc"
where
  "CCfun (CTInit p)
    = C_SI_Init ! (SStart (sessionStart (trigger p)))
      -> $(CTConfigurationManagement p)"

| "CCfun (CTConfigurationManagement p)
    = C_SI_Init ? x ->
       IF (x:range CDReq)
       THEN (C_SI_Init !
               (CDRes (configDataResponse
               (((inv CDReq) x),(state p))))
            -> $(CTConfigurationManagement p))

       ELSE IF (x:range CDN)
       THEN (C_SI_Init ! (CDA configDataAcknowledge)
            -> $(CTConfigurationManagement
                ((configData (((inv CDN) x),(state p))), (trigger p))))

       ELSE IF (x:range RCDN)
       THEN (C_SI_Init ! (RCDA removeDataAcknowledge)
            -> $(CTConfigurationManagement
                (removeData((inv RCDN) x,(state p)), (trigger p))))

       ELSE IF (x:range ACDN)
       THEN (C_SI_Init ! (ACDA activateDataAcknowledge)
            -> $(CTConfigurationManagement
                (activateData((inv ACDN) x,(state p)), (trigger p))))

       ELSE IF (x:range SEnd)
       THEN (C_TerminalDisplay ! InitialisationFinished -> SKIP)
       ELSE STOP"

| "CCfun (CAcquirerInit)
    = C_SI_Init ? sessionStart: (range SStart)
      -> $(CConfigurationManagement)"

| "CCfun (CConfigurationManagement)
    =     C_SI_Init !? sessionEnd:(range SEnd) -> SKIP
      |~| C_SI_Init !? request:(range CDReq)
          -> C_SI_Init ? response:(range CDRes)
          -> $(CConfigurationManagement)
      |~| C_SI_Init !? notification:(range CDN)
          -> C_SI_Init ? acknowledge:(range CDA)
          -> $(CConfigurationManagement)
      |~| C_SI_Init !? notification:(range RCDN)
          -> C_SI_Init ? acknowledge:(range RCDA)
          -> $(CConfigurationManagement)
      |~| C_SI_Init !? notification:(range ACDN)
          -> C_SI_Init ? acknowledge:(range ACDA)
          -> $(CConfigurationManagement)"

overloading Set_CCfun ==
  "PNfun :: (CCName, Event) pnfun"
begin
  definition "PNfun == CCfun"
end

declare Set_CCfun_def [simp]

(*
defs (overloaded)
  Set_CCfun_def [simp]: "PNfun == CCfun"
*)

definition
  CC :: "(TerminalState * Trigger) => (CCName, Event) proc"
  where
  CC_def: "CC p == $(CTInit p)-- (range C_TerminalDisplay)
                   |[range C_SI_Init]| $(CAcquirerInit)"

(*********************************************************
                gProc lemmas (routine work)
 *********************************************************)

lemma guarded_CC[simp]:
      "guardedfun CCfun"
by (simp add: guardedfun_def, rule allI, induct_tac p, simp_all)+

(*********************************************************
        relating function between AbsName and ACName
 *********************************************************)

primrec
  AC_to_CC :: "ACName => (CCName, Event) proc"
where
  "AC_to_CC (TInit)                    =
     !<PairTT> p .. ($(CTInit p))-- range C_TerminalDisplay"

 |"AC_to_CC (TConfigurationManagement) =
     !<PairTT> p ..  ($(CTConfigurationManagement p)) -- range C_TerminalDisplay"

 |"AC_to_CC (AcquirerInit)             = $CAcquirerInit"
 |"AC_to_CC (ConfigurationManagement)  = $CConfigurationManagement"

(*********************************************************
           a theorem for verifying !!p. AC <=F CC p
 *********************************************************)

declare inj_on_def [simp]

lemma ep2_ccl_terminal_step1:
    "(ACfun TInit)<<AC_to_CC <=F AC_to_CC TInit"
apply (auto)
apply (cspF_unwind)+
apply (cspF_step)+
apply (simp add: image_iff)
apply (cspF_simp)+
apply (rule cspF_decompo_subset)
apply (auto)
apply (rule cspF_Rep_int_choice_left)
apply (simp)
apply (rule_tac x="(a,b)" in exI)
apply (simp)
done

(*** loop (terminal) ***)

lemma ep2_ccl_terminal_step2:
    "(ACfun TConfigurationManagement)<<AC_to_CC <=F
          AC_to_CC TConfigurationManagement"
apply (auto)
apply (cspF_unwind)
apply (cspF_step)+
apply (simp add: image_iff)
apply (subgoal_tac "range C_SI_Init Int range C_TerminalDisplay = {}")
apply (cspF_simp)
apply (auto)

apply (case_tac "x : range CDReq")
apply (subgoal_tac "(EX xa. x = CDReq xa)", erule exE)
apply (cspF_step)+
apply (subgoal_tac "(C_SI_Init (CDRes (configDataResponse (xa, state (a, b))))
                    ~: range C_TerminalDisplay)")
apply (cspF_simp)
apply (rule cspF_decompo_subset)
apply (auto)
apply (rule cspF_Rep_int_choice_left)
apply (simp)
apply (rule_tac x="(a, b)" in exI)
apply (simp)

apply (case_tac "(EX xa. x = CDReq xa)")
apply (auto)
apply (cspF_step)+

apply (case_tac "(EX xa. x = CDN xa)")
apply (auto)
apply (cspF_step)+

apply (subgoal_tac "(C_SI_Init (CDA configDataAcknowledge) ~: range C_TerminalDisplay)")
apply (cspF_simp)
apply (auto)

apply (rule cspF_decompo_subset)
apply (auto)
apply (rule cspF_Rep_int_choice_left)
apply (simp)
apply (rule_tac x="(configData (xa, state (a, b)), trigger (a, b))" in exI)
apply (simp)

apply (cspF_simp)
apply (case_tac "(EX xa. x = RCDN xa) ")
apply (auto)
apply (cspF_step)+
apply (subgoal_tac "(C_SI_Init (RCDA removeDataAcknowledge) ~: range C_TerminalDisplay)")
apply (auto)
apply (cspF_simp)

apply (rule cspF_decompo_subset)
apply (auto)
apply (rule cspF_Rep_int_choice_left)
apply (simp)
apply (rule_tac x="(removeData (xa, state (a, b)), trigger (a, b))" in exI)
apply (simp)

apply (cspF_simp)
apply (case_tac "(EX xa. x = ACDN xa)")
apply (auto)
apply (cspF_step)+
apply (subgoal_tac "(C_SI_Init (ACDA activateDataAcknowledge) ~: range C_TerminalDisplay)")
apply (auto)
apply (cspF_simp)+

apply (rule cspF_decompo_subset)
apply (auto)
apply (rule cspF_Rep_int_choice_left)
apply (simp)
apply (rule_tac x="(activateData (xa, state (a, b)), trigger (a, b))" in exI)
apply (simp)

 (*** C_TerminalDisplay ***)

apply (cspF_simp)
apply (case_tac "(EX xa. x = SEnd xa)")
apply (auto)
apply (cspF_step)+
done

lemma ACDef_AC_to_CC: "(ACfun p)<<AC_to_CC <=F AC_to_CC p"
apply (induct_tac p)
apply (simp add: ep2_ccl_terminal_step1 del: ACfun.simps AC_to_CC.simps)
apply (simp add: ep2_ccl_terminal_step2 del: ACfun.simps AC_to_CC.simps)
apply (cspF_unwind)+
done

(****************************
      !!p. AC p <=F CC p
 ****************************)

theorem ep2_acl_ccl: "!!p. AC <=F CC p"
apply (simp add: AC_def CC_def)
apply (rule cspF_decompo)
apply (simp)

(*** TInit ***)

 (* by fixed point induction *)

apply (rule cspF_fp_induct_left[of _ "AC_to_CC"])
apply (simp_all)
apply (simp)
apply (rule cspF_Rep_int_choice_left)
apply (simp)
apply (rule_tac x="p" in exI)
apply (simp)

apply (simp add: ACDef_AC_to_CC)

(*** AcquirerInit ***)

 (* by fixed point induction *)

apply (rule cspF_fp_induct_left[of _ "AC_to_CC"])
apply (simp_all)
apply (simp)
apply (simp add: ACDef_AC_to_CC)
done

(****************************
      !!p. Abs <=F CC p
 ****************************)

theorem ep2_abs_ccl: "!!p. Abs <=F CC p"
apply (rule cspF_trans)
apply (rule ep2_abs)
apply (rule ep2_acl_ccl)
done

declare inj_on_def [simp del]

end


(*  Title:      HOL/HOLCF/IOA/Storage/Correctness.thy
    Author:     Olaf Müller
*)

section {* Correctness Proof *}

theory Correctness
imports SimCorrectness Spec Impl
begin

default_sort type

definition
  sim_relation :: "((nat * bool) * (nat set * bool)) set" where
  "sim_relation = {qua. let c = fst qua; a = snd qua ;
                            k = fst c;   b = snd c;
                            used = fst a; c = snd a
                        in
                        (! l:used. l < k) & b=c}"

declare split_paired_Ex [simp del]

(* Idea: instead of impl_con_lemma do not rewrite impl_ioa, but derive
         simple lemmas asig_of impl_ioa = impl_sig, trans_of impl_ioa = impl_trans
   Idea: ?ex. move .. should be generally replaced by a step via a subst tac if desired,
         as this can be done globally *)

lemma issimulation:
      "is_simulation sim_relation impl_ioa spec_ioa"
apply (simp (no_asm) add: is_simulation_def)
apply (rule conjI)
txt {* start states *}
apply (auto)[1]
apply (rule_tac x = " ({},False) " in exI)
apply (simp add: sim_relation_def starts_of_def spec_ioa_def impl_ioa_def)
txt {* main-part *}
apply (rule allI)+
apply (rule imp_conj_lemma)
apply (rename_tac k b used c k' b' a)
apply (induct_tac "a")
apply (simp_all (no_asm) add: sim_relation_def impl_ioa_def impl_trans_def trans_of_def)
apply auto
txt {* NEW *}
apply (rule_tac x = "(used,True)" in exI)
apply simp
apply (rule transition_is_ex)
apply (simp (no_asm) add: spec_ioa_def spec_trans_def trans_of_def)
txt {* LOC *}
apply (rule_tac x = " (used Un {k},False) " in exI)
apply (simp add: less_SucI)
apply (rule transition_is_ex)
apply (simp (no_asm) add: spec_ioa_def spec_trans_def trans_of_def)
apply fast
txt {* FREE *}
apply (rename_tac nat, rule_tac x = " (used - {nat},c) " in exI)
apply simp
apply (rule transition_is_ex)
apply (simp (no_asm) add: spec_ioa_def spec_trans_def trans_of_def)
done

lemma implementation:
"impl_ioa =<| spec_ioa"
apply (unfold ioa_implements_def)
apply (rule conjI)
apply (simp (no_asm) add: impl_sig_def spec_sig_def impl_ioa_def spec_ioa_def
  asig_outputs_def asig_of_def asig_inputs_def)
apply (rule trace_inclusion_for_simulations)
apply (simp (no_asm) add: impl_sig_def spec_sig_def impl_ioa_def spec_ioa_def
  externals_def asig_outputs_def asig_of_def asig_inputs_def)
apply (rule issimulation)
done

end