theory Construction_Utility
  imports
    Fused_Resource
    State_Isomorphism
begin

\<comment> \<open>Dummy converters that return a constant value on their external interface\<close>

primcorec
  ldummy_converter :: "('a \<Rightarrow> 'b) \<Rightarrow> ('i_cnv, 'o_cnv, 'i_res, 'o_res) converter \<Rightarrow>
    ('a + 'i_cnv, 'b + 'o_cnv, 'i_res, 'o_res) converter"
  where
    "run_converter (ldummy_converter f conv) = (\<lambda>inp. case inp of
      Inl x \<Rightarrow> map_gpv (map_prod Inl (\<lambda>_. ldummy_converter f conv)) id (Done (f x, ()))
    | Inr x \<Rightarrow> map_gpv (map_prod Inr (\<lambda>c. ldummy_converter f c)) id (run_converter conv x))"

primcorec
  rdummy_converter :: "('a \<Rightarrow> 'b) \<Rightarrow> ('i_cnv, 'o_cnv, 'i_res, 'o_res) converter \<Rightarrow>
    ('i_cnv + 'a, 'o_cnv + 'b, 'i_res, 'o_res) converter"
  where
    "run_converter (rdummy_converter f conv) = (\<lambda>inp. case inp of
      Inl x \<Rightarrow> map_gpv (map_prod Inl (\<lambda>c. rdummy_converter f c)) id (run_converter conv x)
    | Inr x \<Rightarrow> map_gpv (map_prod Inr (\<lambda>_. rdummy_converter f conv)) id (Done (f x, ())))"

lemma ldummy_converter_of_callee:
  "ldummy_converter f (converter_of_callee callee state) =
    converter_of_callee (\<lambda>s q. case_sum (\<lambda>ql. Done (Inl (f ql), s)) (\<lambda>qr. map_gpv (map_prod Inr id) id (callee s qr))  q)  state"
  apply (coinduction arbitrary: callee state)
  apply(clarsimp intro!:rel_funI split!:sum.splits)
  subgoal by blast
  apply (simp add: gpv.rel_map map_prod_def split_def)
  by (rule gpv.rel_mono_strong0[of "(=)" "(=)"]) (auto simp add: gpv.rel_eq)

lemma rdummy_converter_of_callee:
  "rdummy_converter f (converter_of_callee callee state) =
    converter_of_callee (\<lambda>s q. case_sum (\<lambda>ql. map_gpv (map_prod Inl id) id (callee s ql)) (\<lambda>qr. Done (Inr (f qr), s))  q) state"
  apply (coinduction arbitrary: callee state)
  apply(clarsimp intro!:rel_funI split!:sum.splits)
  defer
  subgoal by blast
  apply (simp add: gpv.rel_map map_prod_def split_def)
  by (rule gpv.rel_mono_strong0[of "(=)" "(=)"]) (auto simp add: gpv.rel_eq)

\<comment> \<open>Commonly used wirings\<close>

context
  fixes
    cnv1 :: "('icnv_usr1, 'ocnv_usr1, 'iusr1_res1 + 'iusr1_res2, 'ousr1_res1 + 'ousr1_res2) converter" and
    cnv2 :: "('icnv_usr2, 'ocnv_usr2, 'iusr2_res1 + 'iusr2_res2, 'ousr2_res1 + 'ousr2_res2) converter"
begin

\<comment> \<open>c1r22: a converter that has 1 interface and sends queries to two resources,
   where the first and second resources have 2 and 2 interfaces respectively\<close>

definition
  wiring_c1r22_c1r22 :: "('icnv_usr1 + 'icnv_usr2, 'ocnv_usr1 + 'ocnv_usr2,
    ('iusr1_res1 + 'iusr2_res1) + 'iusr1_res2 + 'iusr2_res2,
    ('ousr1_res1 + 'ousr2_res1) + 'ousr1_res2 + 'ousr2_res2) converter"
  where
    "wiring_c1r22_c1r22  \<equiv> (cnv1 |\<^sub>= cnv2) \<odot> parallel_wiring"

end

\<comment> \<open>Special wiring converters used for the parallel composition of Fused resources\<close>

definition
  fused_wiring :: "
    ((('iadv_core1 + 'iadv_core2) + ('iadv_rest1 + 'iadv_rest2)) +
      (('iusr_core1 + 'iusr_core2) + ('iusr_rest1 + 'iusr_rest2)),
    (('oadv_core1 + 'oadv_core2) + ('oadv_rest1 + 'oadv_rest2)) +
      (('ousr_core1 + 'ousr_core2) + ('ousr_rest1 + 'ousr_rest2)),
    (('iadv_core1 + 'iadv_rest1) + ('iusr_core1 + 'iusr_rest1)) +
      (('iadv_core2 + 'iadv_rest2) + ('iusr_core2 + 'iusr_rest2)),
    (('oadv_core1 + 'oadv_rest1) + ('ousr_core1 + 'ousr_rest1)) +
      (('oadv_core2 + 'oadv_rest2) + ('ousr_core2 + 'ousr_rest2))) converter"
  where
    "fused_wiring \<equiv> (parallel_wiring |\<^sub>= parallel_wiring) \<odot> parallel_wiring"

definition
  fused_wiring\<^sub>w
  where
    "fused_wiring\<^sub>w \<equiv> (parallel_wiring\<^sub>w |\<^sub>w parallel_wiring\<^sub>w) \<circ>\<^sub>w parallel_wiring\<^sub>w"

schematic_goal
  wiring_fused_wiring[wiring_intro]: "wiring ?\<I>1 ?\<I>2 fused_wiring fused_wiring\<^sub>w"
  unfolding fused_wiring_def fused_wiring\<^sub>w_def
  by(rule wiring_intro)+

schematic_goal WT_fused_wiring [WT_intro]: "?\<I>1, ?\<I>2 \<turnstile>\<^sub>C fused_wiring \<surd>"
  unfolding fused_wiring_def
  by(rule WT_intro)+

\<comment> \<open>Commonlu used attachments\<close>

context
  fixes
    cnv1 :: "('icnv_usr1, 'ocnv_usr1, 'iusr1_core1 + 'iusr1_core2, 'ousr1_core1 + 'ousr1_core2) converter" and
    cnv2 :: "('icnv_usr2, 'ocnv_usr2, 'iusr2_core1 + 'iusr2_core2, 'ousr2_core1 + 'ousr2_core2) converter" and
    res1 :: "(('iadv_core1 + 'iadv_rest1) + ('iusr1_core1 + 'iusr2_core1) + 'iusr_rest1,
      ('oadv_core1 + 'oadv_rest1) + ('ousr1_core1 + 'ousr2_core1) + 'ousr_rest1) resource" and
    res2 :: "(('iadv_core2 + 'iadv_rest2) + ('iusr1_core2 + 'iusr2_core2) + 'iusr_rest2,
      ('oadv_core2 + 'oadv_rest2) + ('ousr1_core2 + 'ousr2_core2) + 'ousr_rest2) resource"
begin

\<comment> \<open>Attachement of two c1f22 ('f' instead of 'r' to indicate Fused Resources) converters
  to two 2-interface Fused Resources, the results will be a new 2-interface Fused Resource\<close>

definition
  attach_c1f22_c1f22 :: "((('iadv_core1 + 'iadv_core2) + 'iadv_rest1 + 'iadv_rest2) + ('icnv_usr1 + 'icnv_usr2) + 'iusr_rest1 + 'iusr_rest2,
    (('oadv_core1 + 'oadv_core2) + 'oadv_rest1 + 'oadv_rest2) + ('ocnv_usr1 + 'ocnv_usr2) + 'ousr_rest1 + 'ousr_rest2) resource"
  where
    "attach_c1f22_c1f22 = (((1\<^sub>C |\<^sub>= 1\<^sub>C) |\<^sub>= ((wiring_c1r22_c1r22 cnv1 cnv2) |\<^sub>= 1\<^sub>C)) \<odot> fused_wiring) \<rhd> (res1 \<parallel> res2)"
end

\<comment> \<open>Properties of Converters attaching to Fused resources\<close>
context
  fixes
    core1 :: "('s_core1, 'e1, 'iadv_core1, 'iusr_core1, 'oadv_core1, 'ousr_core1) core" and
    core2 :: "('s_core2, 'e2, 'iadv_core2, 'iusr_core2, 'oadv_core2, 'ousr_core2) core" and
    rest1 :: "('s_rest1, 'e1, 'iadv_rest1, 'iusr_rest1, 'oadv_rest1, 'ousr_rest1, 'm1) rest_scheme" and
    rest2 :: "('s_rest2, 'e2, 'iadv_rest2, 'iusr_rest2, 'oadv_rest2, 'ousr_rest2, 'm2) rest_scheme"
begin

lemma parallel_oracle_fuse:
  "apply_wiring fused_wiring\<^sub>w (parallel_oracle (fused_resource.fuse core1 rest1) (fused_resource.fuse core2 rest2)) =
    apply_state_iso parallel_state_iso (fused_resource.fuse (parallel_core core1 core2) (parallel_rest rest1 rest2))"
  supply fused_resource.fuse.simps[simp]
  apply(rule ext)+
  apply(clarsimp simp add: fused_wiring\<^sub>w_def apply_state_iso_def parallel_state_iso_def parallel_wiring\<^sub>w_def)
  apply(simp add: apply_wiring_def comp_wiring_def parallel2_wiring_def lassocr\<^sub>w_def swap_lassocr\<^sub>w_def rassocl\<^sub>w_def swap\<^sub>w_def)
  subgoal for s_core1 s_rest1 s_core2 s_rest2 i
    apply(cases "(parallel_rest rest1 rest2, ((s_core1, s_core2), (s_rest1, s_rest2)), i)" rule: fused_resource.fuse.cases)
       apply(auto split!: sum.splits)
    subgoal for iadv_core
      by (cases iadv_core) (auto simp add: map_spmf_bind_spmf bind_map_spmf intro!: bind_spmf_cong split!: sum.splits)
    subgoal for iadv_rest
      by (cases iadv_rest) (auto simp add: parallel_handler_left parallel_handler_right foldl_spmf_pair_left
        parallel_eoracle_def foldl_spmf_pair_right split_beta o_def map_spmf_bind_spmf bind_map_spmf)
    subgoal for iusr_core
      by (cases iusr_core) (auto simp add: map_spmf_bind_spmf bind_map_spmf intro!: bind_spmf_cong split!: sum.splits)
    subgoal for iusr_rest
      by (cases iusr_rest) (auto simp add: parallel_handler_left parallel_handler_right foldl_spmf_pair_left
        parallel_eoracle_def foldl_spmf_pair_right split_beta o_def map_spmf_bind_spmf bind_map_spmf)
    done
  done
end

lemma attach_callee_fuse:
  "attach_callee ((cnv_adv_core \<ddagger>\<^sub>I cnv_adv_rest) \<ddagger>\<^sub>I cnv_usr_core \<ddagger>\<^sub>I cnv_usr_rest) (fused_resource.fuse core rest) =
   apply_state_iso iso_trisplit (fused_resource.fuse (attach_core cnv_adv_core cnv_usr_core core) (attach_rest cnv_adv_rest cnv_usr_rest f_init rest))"
  (is "?lhs = ?rhs")
proof(intro ext; clarify)
  note fused_resource.fuse.simps [simp]
  let ?tri = "\<lambda>(((s11, s12), s13), (s21, s22), s23). (((s11, s21), s12, s22), s13, s23)"
  fix q :: "('g + 'h) + 'i + 'j"
  consider (ACore) qac where "q = Inl (Inl qac)"
    | (ARest) qar where "q = Inl (Inr qar)"
    | (UCore) quc where "q = Inr (Inl quc)"
    | (URest) qur where "q = Inr (Inr qur)"
    using fuse_callee.cases by blast
  then show "?lhs (((sac, sar), (suc, sur)), (sc, sr)) q = ?rhs (((sac, sar), (suc, sur)), (sc, sr)) q"
    for sac sar suc sur sc sr
  proof cases
    case ACore
    have "map_spmf rprodl (exec_gpv (fused_resource.fuse core rest)
       (left_gpv (map_gpv (map_prod Inl (\<lambda>s1'. (s1', suc, sur))) id (left_gpv (map_gpv (map_prod Inl (\<lambda>s1'. (s1', sar))) id (cnv_adv_core sac qac)))))
       (sc, sr)) =
     (map_spmf (map_prod (Inl \<circ> Inl) (?tri \<circ> prod.swap \<circ> Pair ((sar, sur), sr)))
       (map_spmf (\<lambda>((oadv, s_adv'), s_core'). (oadv, (s_adv', suc), s_core'))
         (exec_gpv (cfunc_adv core) (cnv_adv_core sac qac) sc)))"
    proof(induction arbitrary: sc cnv_adv_core rule: exec_gpv_fixp_parallel_induct)
      case adm show ?case by simp
      case bottom show ?case by simp
      case (step execl execr)
      show ?case
        apply(clarsimp simp add: gpv.map_sel map_bind_spmf bind_map_spmf intro!: bind_spmf_cong[OF refl] split!: generat.split)
        apply(subst step.IH[unfolded id_def])
        apply(simp add: spmf.map_comp o_def)
        done
    qed
    then show ?thesis using ACore
      by(simp add: apply_state_iso_def iso_trisplit_def map_spmf_conv_bind_spmf[symmetric] spmf.map_comp o_def split_def)
  next
    case ARest
    have "bind_spmf (foldl_spmf (cpoke core) (return_spmf sc) es) (\<lambda>sc'.
      map_spmf rprodl (exec_gpv (fused_resource.fuse core rest)
        (left_gpv (map_gpv (map_prod Inl (\<lambda>s1'. (s1', suc, sur))) id (right_gpv (map_gpv (map_prod Inr (Pair sac)) id (cnv_adv_rest sar qar)))))
        (sc', sr))) =
      bind_spmf
        (exec_gpv (\<lambda>(s, es) q. map_spmf (\<lambda>((out, e), s'). (out, s', es @ e)) (rfunc_adv rest s q)) (cnv_adv_rest sar qar) (sr, es))
        (map_spmf (map_prod id ?tri) \<circ>
          ((\<lambda>((o_rfunc, e_lst), s_rfunc). map_spmf (\<lambda>s_notify. (Inl (Inr o_rfunc), s_notify, s_rfunc))
            (map_spmf (Pair (sac, suc)) (foldl_spmf (cpoke core) (return_spmf sc) e_lst))) \<circ>
          (\<lambda>((oadv, s_adv'), s_rest', es). ((oadv, es), (s_adv', sur), s_rest'))))"
      for es
    proof(induction arbitrary: sc sr es cnv_adv_rest rule: exec_gpv_fixp_parallel_induct)
      case adm then show ?case by simp
      case bottom then show ?case by simp
      case (step execl execr)
      show ?case
        apply(clarsimp simp add: gpv.map_sel map_bind_spmf bind_map_spmf)
        apply(subst bind_commute_spmf)
        apply(clarsimp simp add: gpv.map_sel map_bind_spmf bind_map_spmf spmf.map_comp o_def map_spmf_conv_bind_spmf[symmetric] intro!: bind_spmf_cong[OF refl] split!: generat.split)
        apply(subst bind_commute_spmf)
        apply(clarsimp simp add: gpv.map_sel map_bind_spmf bind_map_spmf spmf.map_comp o_def map_spmf_conv_bind_spmf[symmetric] intro!: bind_spmf_cong[OF refl] split!: generat.split)
        apply(simp add: bind_spmf_assoc[symmetric] bind_foldl_spmf_return foldl_spmf_append[symmetric] del: bind_spmf_assoc )
        apply(subst step.IH[unfolded id_def])
        apply(simp add: split_def o_def spmf.map_comp)
        done
    qed
    from this[of "[]"]
    show ?thesis using ARest
      by(simp add: apply_state_iso_def iso_trisplit_def map_bind_spmf bind_map_spmf map_spmf_conv_bind_spmf[symmetric] foldl_spmf_pair_right)
  next
    case UCore
    have "map_spmf rprodl (exec_gpv (fused_resource.fuse core rest)
       (right_gpv (map_gpv (map_prod Inr (Pair (sac, sar))) id (left_gpv (map_gpv (map_prod Inl (\<lambda>s1'. (s1', sur))) id (cnv_usr_core suc quc)))))
       (sc, sr)) =
     (map_spmf (map_prod (Inr \<circ> Inl) (?tri \<circ> prod.swap \<circ> Pair ((sar, sur), sr)))
       (map_spmf (\<lambda>((ousr, s_usr'), s_core'). (ousr, (sac, s_usr'), s_core'))
         (exec_gpv (cfunc_usr core) (cnv_usr_core suc quc) sc)))"
    proof(induction arbitrary: sc cnv_usr_core rule: exec_gpv_fixp_parallel_induct)
      case adm show ?case by simp
      case bottom show ?case by simp
      case (step execl execr)
      show ?case
        apply(clarsimp simp add: gpv.map_sel map_bind_spmf bind_map_spmf intro!: bind_spmf_cong[OF refl] split!: generat.split)
        apply(subst step.IH[unfolded id_def])
        apply(simp add: spmf.map_comp o_def)
        done
    qed
    then show ?thesis using UCore
      by(simp add: apply_state_iso_def iso_trisplit_def map_spmf_conv_bind_spmf[symmetric] spmf.map_comp o_def split_def)
  next
    case URest
    have "bind_spmf (foldl_spmf (cpoke core) (return_spmf sc) es) (\<lambda>sc'.
      map_spmf rprodl (exec_gpv (fused_resource.fuse core rest)
        (right_gpv (map_gpv (map_prod Inr (Pair (sac, sar))) id (right_gpv (map_gpv (map_prod Inr (Pair suc)) id (cnv_usr_rest sur qur)))))
        (sc', sr))) =
      bind_spmf
        (exec_gpv (\<lambda>(s, es) q. map_spmf (\<lambda>((out, e), s'). (out, s', es @ e)) (rfunc_usr rest s q)) (cnv_usr_rest sur qur) (sr, es))
        (map_spmf (map_prod id ?tri) \<circ>
           ((\<lambda>((o_rfunc, e_lst), s_rfunc). map_spmf (\<lambda>s_notify. (Inr (Inr o_rfunc), s_notify, s_rfunc))
              (map_spmf (Pair (sac, suc)) (foldl_spmf (cpoke core) (return_spmf sc) e_lst))) \<circ>
           (\<lambda>((ousr, s_usr'), s_rest', es). ((ousr, es), (sar, s_usr'), s_rest'))))"
      for es
    proof(induction arbitrary: sc sr es cnv_usr_rest rule: exec_gpv_fixp_parallel_induct)
      case adm then show ?case by simp
      case bottom then show ?case by simp
      case (step execl execr)
      show ?case
        apply(clarsimp simp add: gpv.map_sel map_bind_spmf bind_map_spmf)
        apply(subst bind_commute_spmf)
        apply(clarsimp simp add: gpv.map_sel map_bind_spmf bind_map_spmf spmf.map_comp o_def map_spmf_conv_bind_spmf[symmetric] intro!: bind_spmf_cong[OF refl] split!: generat.split)
        apply(subst bind_commute_spmf)
        apply(clarsimp simp add: gpv.map_sel map_bind_spmf bind_map_spmf spmf.map_comp o_def map_spmf_conv_bind_spmf[symmetric] intro!: bind_spmf_cong[OF refl] split!: generat.split)
        apply(simp add: bind_spmf_assoc[symmetric] bind_foldl_spmf_return foldl_spmf_append[symmetric] del: bind_spmf_assoc )
        apply(subst step.IH[unfolded id_def])
        apply(simp add: split_def o_def spmf.map_comp)
        done
    qed
    from this[of "[]"] show ?thesis using URest
      by(simp add: apply_state_iso_def iso_trisplit_def map_bind_spmf bind_map_spmf map_spmf_conv_bind_spmf[symmetric] foldl_spmf_pair_right)
  qed
qed

lemma attach_parallel_fuse':
  "(CNV cnv_adv_core s_a_c |\<^sub>= CNV cnv_adv_rest s_a_r) |\<^sub>= (CNV cnv_usr_core s_u_c |\<^sub>= CNV cnv_usr_rest s_u_r) \<rhd>
   RES (fused_resource.fuse core rest) (s_r_c, s_r_r) =
   RES (fused_resource.fuse (attach_core cnv_adv_core cnv_usr_core core) (attach_rest cnv_adv_rest cnv_usr_rest f_init rest)) (((s_a_c, s_u_c), s_r_c), ((s_a_r, s_u_r), s_r_r))"
  apply(fold conv_callee_parallel)
  apply(unfold attach_CNV_RES)
  apply(subst attach_callee_fuse)
  apply(subst resource_of_oracle_state_iso)
   apply simp
  apply(simp add: iso_trisplit_def)
  done

\<comment> \<open>Moving event translators from rest to the core\<close>

context
  fixes
    einit :: 's_event and
    etran :: "('s_event, 'ievent, 'oevent list) oracle'" and
    rest :: "('s_rest, 'ievent, 'iadv_rest, 'iusr_rest, 'oadv_rest, 'ousr_rest) rest_wstate" and
    core :: "('s_core, 'oevent, 'iadv_core, 'iusr_core, 'oadv_core, 'ousr_core) core"
begin

primcorec
  translate_rest :: "('s_event \<times> 's_rest, 'oevent, 'iadv_rest, 'iusr_rest, 'oadv_rest, 'ousr_rest) rest_wstate"
  where
    "rinit translate_rest = (einit, rinit rest)"
  | "rfunc_adv translate_rest = translate_eoracle etran (extend_state_oracle (rfunc_adv rest))"
  | "rfunc_usr translate_rest = translate_eoracle etran (extend_state_oracle (rfunc_usr rest))"

primcorec
  translate_core :: "('s_event \<times> 's_core, 'ievent, 'iadv_core, 'iusr_core, 'oadv_core, 'ousr_core) core"
  where
    "cpoke translate_core = (\<lambda>(s_event, s_core) event.
      bind_spmf (etran s_event event) (\<lambda>(events, s_event').
        map_spmf (\<lambda>s_core'. (s_event', s_core')) (foldl_spmf (cpoke core) (return_spmf s_core) events)))"
  | "cfunc_adv translate_core = extend_state_oracle (cfunc_adv core)"
  | "cfunc_usr translate_core = extend_state_oracle (cfunc_usr core)"

lemma WT_translate_rest [WT_intro]:
  assumes "WT_rest \<I>_adv \<I>_usr I_rest rest"
  shows "WT_rest \<I>_adv \<I>_usr (pred_prod (\<lambda>_. True) I_rest) translate_rest"
  by(rule WT_rest.intros)(auto simp add: translate_eoracle_def simp add: WT_restD_rinit[OF assms] dest!: WT_restD(1,2)[OF assms])

lemma fused_resource_move_translate:
  "fused_resource.fuse core translate_rest = apply_state_iso iso_swapar (fused_resource.fuse translate_core rest)"
proof -
  note [simp] = exec_gpv_bind spmf.map_comp o_def map_bind_spmf bind_map_spmf bind_spmf_const

  show ?thesis
    apply (rule ext)
    apply (rule ext)
    subgoal for s query
      apply (cases s)
      subgoal for s_core s_event s_rest
        apply (cases query)
        subgoal for q_adv
          apply (cases q_adv)
          subgoal for q_acore
            by (simp add: apply_state_iso_def iso_swapar_def fused_resource.fuse.simps split_def map_prod_def)
          subgoal for q_arest
            apply (simp add: apply_state_iso_def iso_swapar_def fused_resource.fuse.simps)
            apply (simp add: translate_eoracle_def split_def)
            apply(rule bind_spmf_cong[OF refl])
            apply(subst foldl_spmf_chain[simplified split_def])
            by simp
          done
        subgoal for q_usr
          apply (cases q_usr)
          subgoal for q_ucore
            by (simp add: apply_state_iso_def iso_swapar_def fused_resource.fuse.simps split_def map_prod_def)
          subgoal for q_urest
            apply (simp add: apply_state_iso_def iso_swapar_def fused_resource.fuse.simps)
            apply (simp add: translate_eoracle_def split_def)
            apply(rule bind_spmf_cong[OF refl])
            apply(subst foldl_spmf_chain[simplified split_def])
            by simp
          done
        done
      done
    done
qed

end

\<comment> \<open>Moving interfaces between rest and core\<close>

lemma
  fuse_ishift_core_to_rest:
  assumes "cpoke core' = (\<lambda>s. case_sum (\<lambda>q. fn s q) (cpoke core s))"
      and "cfunc_adv core = cfunc_adv core'"
      and "cfunc_usr core = cfunc_usr core' \<oplus>\<^sub>O (\<lambda>s i. map_spmf (Pair (h_out i)) (fn s i))"
      and "rfunc_adv rest' = (\<lambda>s q. map_spmf (apfst (apsnd (map Inr))) (rfunc_adv rest s q))"
      and "rfunc_usr rest' = plus_eoracle (\<lambda>s i. return_spmf ((h_out i, [i]), s)) (rfunc_usr rest)"
    shows "fused_resource.fuse core rest = apply_wiring (1\<^sub>w |\<^sub>w lassocr\<^sub>w) (fused_resource.fuse core' rest')" (is "?L = ?R")
proof -
  note [simp] = fused_resource.fuse.simps apply_wiring_def lassocr\<^sub>w_def parallel2_wiring_def
    plus_eoracle_def map_spmf_conv_bind_spmf map_prod_def map_fun_def split_def o_def

  have "?L s q = ?R s q" for s q
    apply (cases q; cases s)
    subgoal for q_adv
      by (cases q_adv) (simp_all add: assms(1, 2, 4))
    subgoal for q_usr
      apply (cases q_usr)
      subgoal for q_usr_core
        apply (cases q_usr_core)
        subgoal for q_nrm
          by (simp add: assms(3))
        by (simp add: assms(1, 3, 5))
      by (simp add: assms(1, 5))
    done

  then show ?thesis
    by blast
qed

lemma move_simulator_interface:
  defines "x_ifunc \<equiv> (\<lambda>ifunc core (se, sc) q. do {
      ((out, es), se') \<leftarrow> ifunc se q;
      sc' \<leftarrow> foldl_spmf (cpoke core) (return_spmf sc) es;
      return_spmf (out, se', sc')   })"
  assumes "cpoke core' = cpoke (translate_core etran core)"
      and "cfunc_adv core' = \<dagger>(cfunc_adv core) \<oplus>\<^sub>O x_ifunc ifunc core"
      and "cfunc_usr core' = cfunc_usr (translate_core etran core)"
      and "rinit rest = (einit, rinit rest')"
      and "rfunc_adv rest = (\<lambda>s q. case q of
        Inl ql \<Rightarrow> map_spmf (apfst (map_prod Inl id)) ((ifunc\<dagger>) s ql)
      | Inr qr \<Rightarrow> map_spmf (apfst (map_prod Inr id)) ((translate_eoracle etran (\<dagger>(rfunc_adv rest'))) s qr))"
      and "rfunc_usr rest = translate_eoracle etran (\<dagger>(rfunc_usr rest'))"
  shows "fused_resource.fuse core rest =  apply_wiring (rassocl\<^sub>w |\<^sub>w (id, id))
       (apply_state_iso (rprodl o (apfst prod.swap), (apfst prod.swap) o lprodr)
         (fused_resource.fuse core' rest'))"
    (is "?L = ?R")
proof -
  note [simp] = fused_resource.fuse.simps apply_wiring_def rassocl\<^sub>w_def parallel2_wiring_def apply_state_iso_def
    exec_gpv_bind spmf.map_comp map_bind_spmf bind_map_spmf bind_spmf_const o_def split_def

  have "?L (sc, st, sr) q = ?R (sc, st, sr) q" for sc st sr q
  apply (simp add: map_fun_def map_prod_def prod.swap_def apfst_def lprodr_def rprodl_def id_def)
    using assms apply (cases q)
    subgoal for q_adv
      apply (cases q_adv)
      subgoal for q_adv_core
        by (simp add: map_prod_def)
      subgoal for q_adv_rest
        apply (cases q_adv_rest)
        subgoal for q_adv_rest_ifunc
          by simp
        subgoal for q_adv_rest_etran
          apply (simp add: translate_eoracle_def)
          apply(rule bind_spmf_cong[OF refl])
          apply(subst foldl_spmf_chain[simplified split_def])
          by simp
        done
      done
    subgoal for q_usr
      apply (cases q_usr)
      subgoal for q_usr_core
        by (simp add: map_prod_def)
      subgoal for q_usr_rest
        apply (simp add: translate_eoracle_def extend_state_oracle_def)
        apply(rule bind_spmf_cong[OF refl])
            apply(subst foldl_spmf_chain[simplified split_def])
          by simp
      done
    done

  then show ?thesis
    by force
qed

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)
 *)

(*
 * Tactic for solving monadic equalities, such as:
 *
 * (liftE (return 3) = returnOk 3
 *
 * Theorems of the form:
 *
 *   ((a, s') \<in> fst (A s)) = P a s s'
 *
 * and
 *
 *   snd (A s) = P s
 *
 * are added to the "monad_eq" set.
 *)
theory MonadEq
imports "wp/NonDetMonadVCG"
begin

(* Setup "monad_eq" attributes. *)
ML {*
structure MonadEqThms = Named_Thms (
    val name = Binding.name "monad_eq"
    val description = "monad equality-prover theorems"
    )
*}
attribute_setup monad_eq = {*
  Attrib.add_del
    (Thm.declaration_attribute MonadEqThms.add_thm)
    (Thm.declaration_attribute MonadEqThms.del_thm) *}
  "Monad equality-prover theorems"

(* Setup tactic. *)

ML {*
fun monad_eq_tac ctxt =
let
  (* Set a simpset as being hidden, so warnings are not printed from it. *)
  val ctxt' = Context_Position.set_visible false ctxt
in
  CHANGED (clarsimp_tac (ctxt' addsimps (MonadEqThms.get ctxt')) 1)
end
*}

method_setup monad_eq = {*
    Method.sections Clasimp.clasimp_modifiers >> (K (SIMPLE_METHOD o monad_eq_tac)) *}
  "prove equality on monads"

lemma monad_eq_simp_state [monad_eq]:
  "((A :: ('s, 'a) nondet_monad) s = B s') =
      ((\<forall>r t. (r, t) \<in> fst (A s) \<longrightarrow> (r, t) \<in> fst (B s'))
         \<and> (\<forall>r t. (r, t) \<in> fst (B s') \<longrightarrow> (r, t) \<in> fst (A s))
         \<and> (snd (A s) = snd (B s')))"
  apply (auto intro!: set_eqI prod_eqI)
  done

lemma monad_eq_simp [monad_eq]:
  "((A :: ('s, 'a) nondet_monad) = B) =
      ((\<forall>r t s. (r, t) \<in> fst (A s) \<longrightarrow> (r, t) \<in> fst (B s))
         \<and> (\<forall>r t s. (r, t) \<in> fst (B s) \<longrightarrow> (r, t) \<in> fst (A s))
         \<and> (\<forall>x. snd (A x) = snd (B x)))"
  apply (auto intro!: set_eqI prod_eqI)
  done

declare in_monad [monad_eq]
declare in_bindE [monad_eq]

(* Test *)
lemma "returnOk 3 = liftE (return 3)"
  apply monad_eq
  oops

end


(*  Title:       Jive Data and Store Model
    Author:      Norbert Schirmer <schirmer at informatik.tu-muenchen.de>  and
                 Nicole Rauch <rauch at informatik.uni-kl.de>, 2005
    Maintainer:  Nicole Rauch <rauch at informatik.uni-kl.de>
    License:     LGPL
*)

section \<open>Program-Independent Lemmas on Attributes\<close>

theory AttributesIndep
imports "../Isa_Counter_Store/Attributes"
begin

text \<open>The following lemmas validate the functions defined in the Attributes theory.
They also aid in subsequent proving tasks. Since they are
program-independent, it is of no use to add them to the generation process of
Attributes.thy. Therefore, they have been extracted to this theory.
\<close>

lemma cls_catt [simp]:
  "CClassT c \<le> dtype f \<Longrightarrow> cls (catt c f) = c"
  apply (case_tac c)
  apply (case_tac [!] f)
  apply simp_all
   \<comment> \<open>solves all goals where @{text "CClassT c \<le> dtype f"}\<close>
  apply (fastforce elim: subtype_wrong_elims simp add: subtype_defs)+
   \<comment> \<open>solves all the rest where @{text "\<not> CClassT c \<le> dtype f"} can be derived\<close>
  done

lemma att_catt [simp]:
  "CClassT c \<le> dtype f \<Longrightarrow> att (catt c f) = f"
  apply (case_tac c)
  apply (case_tac [!] f)
  apply simp_all
   \<comment> \<open>solves all goals where @{text "CClassT c \<le> dtype f"}\<close>
  apply (fastforce elim: subtype_wrong_elims simp add: subtype_defs)+
   \<comment> \<open>solves all the rest where @{text "\<not> CClassT c \<le> dtype f"} can be
        derived\<close>
  done

text \<open>The following lemmas are just a demonstration of simplification.\<close>

lemma rtype_att_catt:
  "CClassT c \<le> dtype f \<Longrightarrow> rtype (att (catt c f)) = rtype f"
  by simp

lemma widen_cls_dtype_att [simp,intro]:
  "(CClassT (cls cf) \<le> dtype (att cf)) "
  by (cases cf, simp_all)

end


theory RCU
imports RCU_model
begin

(*the following must be included in the proof:

con_assms ps        --- concerns allocation/bounds of C and rcu_0+i for all i
main_inv ms             --- main invariant has 3 parts

nts::
psem_rules ps               --- how allocation works on the inside

tedious - general_structure ms                      --- says how n \<noteq> s \<noteq> detaddrs
allocated_addresses ms ps *********        --- allocation for above are defined here
simple - observation_inv_ms ms         --- how own\<^sub>W affects loc status (own\<^sub>W loc = t \<longrightarrow> loc\<in>{s,n,det} t)
hard - observation_inv_sig ms ps \<sigma>       --- limits which values can be WM_read from C
simple - own\<^sub>W_n_by_t_imp ms

t \<le> T_max
step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'     --- defines a program step by t
last - preCond ms ps \<sigma> (pc ms t) t             --- defines preconditions for t to proceed with stepping

*)

(*the following describes originally reserved addresses*)
definition "default_locs \<equiv> {i | i a. i=C \<or> i = rcu_0+a \<and> a\<le>T_max }"

definition "reserved_bydef ps \<equiv> \<forall>i. i\<in>default_locs \<longrightarrow> \<not>isfree_addr i ps"

definition "reservations_differ \<equiv> \<forall>i. i\<le>T_max \<longrightarrow> C\<noteq>rcu_0+i"

definition "con_assms ps \<equiv> reserved_bydef ps \<and> reservations_differ  "

lemmas con_lemmas [simp] = reserved_bydef_def reservations_differ_def default_locs_def

(*----------------Main Invariant Shown--------------------*)

lemma main_invariant_1_preservation:
  "main_inv ms ps \<Longrightarrow>
  t\<le>T_max \<Longrightarrow>
  general_structure ms \<Longrightarrow>
  step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>' \<Longrightarrow>
  preCond ms ps \<sigma> (pc ms t) t \<Longrightarrow>
  cvd[C,vala] \<sigma> \<Longrightarrow>
  observation_inv_sig ms ps \<sigma> \<Longrightarrow>
  psem_rules ps \<Longrightarrow>
  own\<^sub>W_n_by_t_imp ms \<Longrightarrow>
    main_inv_1 ms'"
  apply simp
  apply(simp add: step_def preCond_def general_structure_lemmas main_inv_lemmas)
  apply(case_tac "pc ms t", simp_all add:abbr) apply clarsimp
  apply (metis insert_not_empty option.sel) apply clarsimp
  apply(case_tac "repeat ms t", simp_all)
  apply (metis option.sel)
  apply (metis option.sel)
  (*FAAZ*) defer
  apply clarsimp
  apply (metis option.sel)
  apply clarsimp
  apply(case_tac "snd (CAS t (a, b) ya y \<sigma> ts')", simp_all)
  apply (metis option.sel)
  apply (metis option.sel)
  apply (metis Diff_empty Diff_insert0 insert_Diff singleton_insert_inj_eq)
  apply(case_tac "CAS_succ ms t", simp_all add:abbr)
  apply clarsimp
  apply (metis option.sel)
  apply(case_tac "nondet_val ms t", simp_all add:abbr)
  apply(case_tac "det ms t \<noteq> []", simp_all add:abbr)
  apply (metis Diff_empty Diff_insert0 insert_absorb insert_iff)
  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all add:abbr)
  apply clarsimp
  apply (metis option.sel)
  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all add:abbr)
  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all add:abbr)
  apply clarsimp
  apply (metis option.sel)
  apply(case_tac "reg ms t = 1", simp_all add:abbr)
  apply(simp add: FAAZ_def get_C_val_def)
  apply(clarsimp)  (*y \<noteq> value \<sigma> (a, b), where value \<sigma> (a, b) is retrieved from reading C*)
  apply(simp_all add: covered_v_def lastWr_def observation_inv_sig_def visible_writes_def)
  by (metis option.sel own\<^sub>W_n_by_t_imp_def)

lemma main_invariant_2_preservation:
  "main_inv ms ps \<Longrightarrow>
  t\<le>T_max \<Longrightarrow>
  general_structure ms \<Longrightarrow>
  step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>' \<Longrightarrow>
  preCond ms ps \<sigma> (pc ms t) t \<Longrightarrow>
  observation_inv_sig ms ps \<sigma> \<Longrightarrow>
  cvd[C,vala] \<sigma> \<Longrightarrow>
  psem_rules ps \<Longrightarrow>
  own\<^sub>W_n_by_t_imp ms \<Longrightarrow>
    main_inv_2 ms' ps'"
  apply simp
  apply(simp add: step_def preCond_def general_structure_lemmas main_inv_lemmas)
  apply(case_tac "pc ms t", simp_all add:abbr)
  apply clarsimp
  apply clarsimp
  apply(case_tac "repeat ms t", simp_all)
  apply (metis subset_singleton_iff)
  (*FAAZ*) defer
  apply clarsimp
  apply clarsimp apply(case_tac " snd (CAS t (a, b) ya y \<sigma> ts')", simp_all)
  apply(case_tac "CAS_succ ms t", simp_all add:abbr)
  apply clarsimp
  apply(case_tac "nondet_val ms t", simp_all add:abbr)
  apply(case_tac "det ms t \<noteq> []", simp_all add:abbr)
  (*detached rules*) defer
  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all add:abbr)
  apply clarsimp
  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all add:abbr)
  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all add:abbr)
  apply clarsimp
  apply(case_tac "reg ms t = 1", simp_all add:abbr)
  apply(simp add: FAAZ_def get_C_val_def)
  apply(clarsimp)  (*y \<noteq> value \<sigma> (a, b), where value \<sigma> (a, b) is retrieved from reading C*)
  apply(simp add: covered_v_def observation_inv_sig_def visible_writes_def)
  apply blast
  (*the detached list property*)
  apply clarify apply(intro conjI impI)
  apply(subgoal_tac "hd(det ms t) \<in> detaddrs ms t", simp_all)
  apply(subgoal_tac "det ms t \<noteq> []") prefer 2
  apply blast
  apply(subgoal_tac "det ms t!0 = hd(det ms t)") prefer 2
  apply (metis hd_conv_nth)
  by blast

lemma main_invariant_3_preservation:
  "main_inv ms ps \<Longrightarrow>
  t\<le>T_max \<Longrightarrow>
  general_structure ms \<Longrightarrow>
  step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>' \<Longrightarrow>
  preCond ms ps \<sigma> (pc ms t) t \<Longrightarrow>
  observation_inv_sig ms ps \<sigma> \<Longrightarrow>
  psem_rules ps \<Longrightarrow>
  cvd[C,vala] \<sigma> \<Longrightarrow>
  own\<^sub>W_n_by_t_imp ms \<Longrightarrow>
    main_inv_3 ms' ps'"
  apply simp
  apply(simp add: step_def preCond_def general_structure_lemmas main_inv_lemmas)
  apply(case_tac "pc ms t", simp_all add:abbr Wcap_def Rcap_def)
  apply clarsimp
  apply (meson own\<^sub>W_n_by_t_imp_def)
  apply clarsimp
  apply(case_tac "repeat ms t", simp_all add:own\<^sub>W_n_by_t_imp_def)
  apply clarsimp
  apply(case_tac "loc = ya", simp_all)
  apply (metis less_nat_zero_code list.size(3) option.sel)
  (*FAAZ*) defer
  apply clarsimp apply clarsimp
  apply(case_tac "snd (CAS t (a, b) ya y \<sigma> ts')", simp_all)
  apply (meson option.distinct(1))
  apply (metis option.discI)
  apply(case_tac "CAS_succ ms t", simp_all add:abbr)
  apply clarsimp
  apply(case_tac "nondet_val ms t", simp_all add:abbr)
  apply(case_tac "det ms t \<noteq> []", simp_all add:abbr)
  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all add:abbr)
  apply clarsimp
  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all add:abbr)
  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all add:abbr)
  apply clarsimp
  apply(case_tac "reg ms t = 1", simp_all add:abbr)
  apply(simp add: FAAZ_def get_C_val_def)
  apply(clarsimp) (*y \<noteq> value \<sigma> (a, b), where value \<sigma> (a, b) is retrieved from reading C*)
  by(case_tac "loc = value \<sigma> (a, b)", simp_all)

lemma main_invariant_preservation:
  "main_inv ms ps \<Longrightarrow>
  t\<le>T_max \<Longrightarrow>
  general_structure ms \<Longrightarrow>
  step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>' \<Longrightarrow>
  preCond ms ps \<sigma> (pc ms t) t \<Longrightarrow>
  observation_inv_sig ms ps \<sigma> \<Longrightarrow>
  cvd[C,vala] \<sigma> \<Longrightarrow>
  psem_rules ps \<Longrightarrow>
  own\<^sub>W_n_by_t_imp ms  \<Longrightarrow>
main_inv ms' ps'"
  unfolding main_inv_def
  apply(intro conjI impI)
  using main_invariant_1_preservation main_inv_def apply blast
  using main_invariant_2_preservation main_inv_def apply blast
  using main_invariant_3_preservation main_inv_def apply blast
  done

(*--------------------------------------------------------------------*)

(*------------------------observation_inv_sig Correctness---------------------------*)

lemma supp1:
  "cvd[C,vala] \<sigma> \<Longrightarrow>
  \<sigma> [z \<leftarrow> ya]\<^sub>t \<sigma>' \<Longrightarrow>
  cvd[C,vala] \<sigma>'"
  apply(simp add:covered_v_def lastWr_def OpSem.step_def RdX_def visible_writes_def) unfolding writes_on_def
  read_trans_def
  by (smt (z3) Collect_cong rev_app_def surrey_state.ext_inject surrey_state.surjective surrey_state.update_convs(2) update_thrView_def value_def)

lemma supp2:
  "cvd[C,vala] \<sigma> \<Longrightarrow>
  \<sigma> [z := ya]\<^sub>t \<sigma>' \<Longrightarrow>
  z\<noteq>C \<Longrightarrow>
  cvd[C,vala] \<sigma>'"
  apply(simp add:covered_v_def lastWr_def OpSem.step_def WrX_def visible_writes_def value_def) unfolding writes_on_def
  write_trans_def update_thrView_def update_mods_def
  update_modView_def valid_fresh_ts_def
  rev_app_def tst_def
  apply auto
  sledgehammer

lemma Local_correctness:
  "main_inv ms ps \<Longrightarrow>
  t\<le>T_max \<Longrightarrow>
  general_structure ms \<Longrightarrow>
  step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>' \<Longrightarrow>
  preCond ms ps \<sigma> (pc ms t) t \<Longrightarrow>
  observation_inv_sig ms ps \<sigma> \<Longrightarrow>
  cvd[C,vala] \<sigma> \<Longrightarrow>
  psem_rules ps \<Longrightarrow>
  own\<^sub>W_n_by_t_imp ms  \<Longrightarrow>
observation_inv_sig ms' ps' \<sigma>'"
  apply(simp add:step_def preCond_def)
  apply(case_tac "pc ms t")
  apply simp_all
  apply (simp add:abbr)
  apply(simp add:observation_inv_sig_def)
  apply (simp add:abbr)
  apply(simp add:observation_inv_sig_def)
  apply (simp add:abbr)
  apply(simp add:observation_inv_sig_def)
  apply (simp add:abbr)
  apply(simp add:observation_inv_sig_def)
  apply clarsimp apply(simp add:covered_v_def)
  apply metis
  apply(simp add:abbr)
(*RCU_enter()*)defer
  (*RCU_exit()*) defer
  (*RCU_enter()*)defer
  apply(simp add:abbr FAAZ_def get_C_val_def)
  apply(simp add:covered_v_def visible_writes_def observation_inv_sig_def)
  apply(simp add:lastWr_def) apply clarify
                      defer
  apply (simp add: observation_inv_sig_def) apply clarify
  apply(simp add:abbr) apply clarsimp
  apply(simp add:general_structure_lemmas main_inv_lemmas own\<^sub>W_n_by_t_imp_def Wcap_def Rcap_def)
  unfolding covered_v_def writes_on_def
  apply clarify
  sledgehammer

(*--------------------------------------------------------------------*)

lemma preservation_of_variables_1_by_others:
  assumes "preCond ms ps \<sigma> (pc ms t) t"
  and "t \<le> T_max"
  and "ta \<le> T_max"
  and "step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'"
  and "general_structure ms"
  and "ta \<noteq> t"
shows "n ms ta = n ms' ta"
  using assms
  apply(simp add:step_def)
  apply(simp add:preCond_def)
  apply(case_tac "pc ms t", simp_all)
  apply(simp_all add:abbr)
  apply clarify
  apply(simp_all add:general_structure_lemmas) apply clarsimp  apply(simp add:get_C_val_def)
  apply(simp add:FAAZ_def)
  apply(simp add: visible_writes_def)
  apply clarsimp
  apply clarsimp
  apply clarsimp
  apply(case_tac "snd (CAS t (a, b) (the (s ms t)) (the (n ms t)) \<sigma> ts')", simp_all)
  apply(case_tac "CAS_succ ms t", simp_all add:abbr)
  apply(clarsimp)
  apply(case_tac "nondet_val ms t", simp_all add:abbr)
  apply(case_tac "det ms t \<noteq> []", simp_all add:abbr)
  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all add:abbr)
  apply(clarsimp)
  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all add:abbr)
  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all add:abbr)
  apply(clarsimp)
  by(case_tac "reg ms t = Suc 0", simp_all add:abbr)

lemma preservation_of_variables_2_by_others:
  assumes "preCond ms ps \<sigma> (pc ms t) t"
  and "t \<le> T_max"
  and "ta \<le> T_max"
  and "step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'"
  and "general_structure ms"
  and "ta \<noteq> t"
shows "s ms ta = s ms' ta"
  using assms
  apply(simp add:step_def)
  apply(simp add:preCond_def)
  apply(case_tac "pc ms t", simp_all)
  apply(simp_all add:abbr)
  apply clarify
  apply(simp_all add:general_structure_lemmas)apply(simp add:get_C_val_def)
  apply(simp add:FAAZ_def)
  apply(simp add: visible_writes_def)
  apply clarsimp
  apply clarsimp
  apply clarsimp
  apply(case_tac "snd (CAS t (a, b) (the (s ms t)) (the (n ms t)) \<sigma> ts')", simp_all)
  apply(case_tac "CAS_succ ms t", simp_all add:abbr)
  apply(clarsimp)
  apply(case_tac "nondet_val ms t", simp_all add:abbr)
  apply(case_tac "det ms t \<noteq> []", simp_all add:abbr)
  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all add:abbr)
  apply(clarsimp)
  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all add:abbr)
  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all add:abbr)
  apply(clarsimp)
  by(case_tac "reg ms t = Suc 0", simp_all add:abbr)

lemma preservation_of_variables_3_by_others:
  assumes "preCond ms ps \<sigma> (pc ms t) t"
  and "t \<le> T_max"
  and "ta \<le> T_max"
  and "step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'"
  and "general_structure ms"
  and "ta \<noteq> t"
shows "det ms ta = det ms' ta"
  using assms
  apply(simp add:step_def)
  apply(simp add:preCond_def)
  apply(case_tac "pc ms t", simp_all)
  apply(simp_all add:abbr)
  apply clarify
  apply(simp_all add:general_structure_lemmas)apply(simp add:get_C_val_def)
  apply(simp add:FAAZ_def)
  apply(simp add: visible_writes_def)
  apply clarsimp
  apply clarsimp
  apply clarsimp
  apply(case_tac "snd (CAS t (a, b) (the (s ms t)) (the (n ms t)) \<sigma> ts')", simp_all)
  apply(case_tac "CAS_succ ms t", simp_all add:abbr)
  apply(clarsimp)
  apply(case_tac "nondet_val ms t", simp_all add:abbr)
  apply(case_tac "det ms t \<noteq> []", simp_all add:abbr)
  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all add:abbr)
  apply(clarsimp)
  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all add:abbr)
  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all add:abbr)
  apply(clarsimp)
  by(case_tac "reg ms t = Suc 0", simp_all add:abbr)
lemma preservation_of_variables_inset_by_others:
  assumes "preCond ms ps \<sigma> (pc ms t) t"
  and "t \<le> T_max"
  and "ta \<noteq> t"
  and "ta \<le> T_max"
  and "step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'"
  and "general_structure ms"
  and "own\<^sub>W ms loc = Some ta"
  and "observation_inv_ms ms"
shows "(loc \<in> (detaddrs ms' ta) \<or> Some loc = s ms' ta \<or> Some loc = n ms' ta)"
  using assms
  apply(subgoal_tac "(det ms' ta) = (det ms ta)") prefer 2
  using preservation_of_variables_3_by_others
  apply force
  apply(subgoal_tac "the (s ms' ta) = the (s ms ta)") prefer 2
  using preservation_of_variables_2_by_others
  apply force
  apply(subgoal_tac "the (n ms' ta) = the (n ms ta)") prefer 2
  using preservation_of_variables_1_by_others
  apply force
  apply(simp add:observation_inv_ms_def)
  by (metis assms(5) preservation_of_variables_1_by_others preservation_of_variables_2_by_others)+

lemma preservation_of_variables_ninset_by_others:
  assumes "preCond ms ps \<sigma> (pc ms t) t"
  and "t \<le> T_max"
  and "ta \<noteq> t"
  and "ta \<le> T_max"
  and "step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'"
  and "general_structure ms"
  and "(loc \<notin> (detaddrs ms ta) \<and> Some loc \<noteq> s ms ta \<and> Some loc \<noteq> n ms ta)"
  and "observation_inv_ms ms"
shows "(loc \<notin> (detaddrs ms' ta) \<and> Some loc \<noteq> s ms' ta \<and> Some loc \<noteq> n ms' ta)"
  using assms apply simp
  by (simp add: preservation_of_variables_1_by_others
                preservation_of_variables_2_by_others
                preservation_of_variables_3_by_others)
lemma preservation_of_ownership_by_others:
  "preCond ms ps \<sigma> (pc ms t) t
\<Longrightarrow> own\<^sub>W ms loc = Some ta
\<Longrightarrow> ta\<noteq>t
\<Longrightarrow> ta\<le>T_max
\<Longrightarrow> t\<le>T_max
\<Longrightarrow> main_inv_2 ms ps
\<Longrightarrow> main_inv_3 ms ps
\<Longrightarrow> observation_inv_ms ms
\<Longrightarrow> own\<^sub>W_n_by_t_imp ms
\<Longrightarrow> general_structure ms
\<Longrightarrow> step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'
     \<Longrightarrow> own\<^sub>W ms' loc = Some ta"
  apply(simp add:step_def)
  apply(case_tac "pc ms t", simp_all add:abbr)
  (*n:=newint*) defer
  (*FAAZ*) defer
  apply force
  (*cas_step_rcu*) defer
  apply(case_tac "CAS_succ ms t", simp_all add:abbr)
  apply force
  apply(case_tac "nondet_val ms t", simp_all add:abbr)
  apply(case_tac "det ms t", simp_all add:abbr)
  (*kill*) defer
  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all add:abbr)
  apply force
  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all add:abbr)
  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all add:abbr)
  apply force
  apply(case_tac "reg ms t = Suc 0", simp_all add:abbr)
  apply clarsimp
  apply(case_tac "loc = loca", simp_all)
  using get_C_val_def mstate.simps(17) apply force apply clarify
  apply(case_tac "snd (CAS t (a, b) (the (s ms t)) (the (n ms t)) \<sigma> ts')", simp_all)
  apply(simp add:observation_inv_ms_def)
  apply(subgoal_tac "loc \<in> (detaddrs ms ta \<union> s_and_n ms ta)") prefer 2
  apply(simp add:detaddrs_def s_and_n_def)
  apply(simp add:general_structure_lemmas)
  apply(simp add:preCond_def)
  apply meson
  apply(simp add:general_structure_lemmas)
  apply(simp add:preCond_def observation_inv_ms_def own\<^sub>W_n_by_t_imp_def)
  apply(case_tac "Some loc = (n ms ta)")
  apply (metis (no_types, lifting) hd_conv_nth length_greater_0_conv option.distinct(1) option.sel)
  apply (metis (no_types, lifting) option.sel)
  apply(simp add:preCond_def Wcap_def)
  apply (metis option.sel)
  apply(simp add:preCond_def Wcap_def)
  apply(simp add:general_structure_lemmas)
  (*ta cannot own\<^sub>W ms LOC where LOC \<in> det_addrs ms t*)
  sorry

lemma preservation_of_nownership_by_others:
  "preCond ms ps \<sigma> (pc ms t) t
\<Longrightarrow> own\<^sub>W ms loc \<noteq> Some ta
\<Longrightarrow> ta\<noteq>t
\<Longrightarrow> t\<le>T_max
\<Longrightarrow> ta\<le>T_max
\<Longrightarrow> step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'
     \<Longrightarrow> own\<^sub>W ms' loc \<noteq> Some ta"
  apply (simp add:step_def)
  apply(case_tac "pc ms t", simp_all add:abbr)
  apply safe
  apply (smt (z3) fun_upd_apply mstate.simps(17) mstate.surjective mstate.update_convs(1) mstate.update_convs(16) mstate.update_convs(17) option.sel)
  apply(simp add:get_C_val_def FAAZ_def)
  apply safe
  apply simp+
  apply(case_tac "loc = the (n ms t)", simp_all)
  apply(case_tac "CAS_succ ms t", simp_all add:abbr)
  apply(case_tac "nondet_val ms t", simp_all add:abbr)
  apply(case_tac "det ms t", simp_all add:abbr)
  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all add:abbr)
  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all add:abbr)
  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all add:abbr)
  by(case_tac "reg ms t = Suc 0", simp_all add:abbr)

lemma preservation_of_observation_inv_ms:
  assumes "preCond ms ps \<sigma> (pc ms t) t"
  and "t \<le> T_max"
  and "step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'"
  and "general_structure ms"
  and "observation_inv_ms ms"
  and "main_inv_2 ms ps"
  and "main_inv_3 ms ps"
  and "observation_inv_sig ms ps \<sigma>"
  and "own\<^sub>W_n_by_t_imp ms"
  and "general_structure ms"
  and "psem_rules ps"
shows "observation_inv_ms ms'"
  using assms unfolding observation_inv_ms_def apply simp apply clarify
  apply(case_tac "ta \<noteq> t")
  (*ta\<noteq>t*)
  apply(simp add:step_def preCond_def)
  apply(case_tac "pc ms t", simp_all add:abbr)
  apply clarsimp
  apply blast
  apply blast
  apply blast
  apply clarsimp
  apply (meson own\<^sub>W_n_by_t_imp_def)
  apply (meson own\<^sub>W_n_by_t_imp_def)
  apply (meson own\<^sub>W_n_by_t_imp_def)
  apply (meson own\<^sub>W_n_by_t_imp_def)
  (*FAAZ, ta\<noteq>t*) defer
  apply(simp add:Wcap_def own\<^sub>W_n_by_t_imp_def general_structure_lemmas Rcap_def)
  sledgehammer

  sorry

lemma own\<^sub>W_imp_not_free:
  assumes "main_inv ms ps"
  and "own\<^sub>W ms loc \<noteq> None"
shows "\<not>isfree_addr loc ps"
  using assms apply (simp_all add:main_inv_def)
  by blast

lemma global_sig_invariant_preserved:
  "con_assms ps \<Longrightarrow>
main_inv ms ps\<Longrightarrow>
observation_inv_ms ms\<Longrightarrow>
main_inv_2 ms ps\<Longrightarrow>
main_inv_3 ms ps\<Longrightarrow>
observation_inv_sig ms ps \<sigma>\<Longrightarrow>
own\<^sub>W_n_by_t_imp ms\<Longrightarrow>
general_structure ms\<Longrightarrow>
psem_rules ps\<Longrightarrow>
t \<le> T_max\<Longrightarrow>
step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'\<Longrightarrow>
preCond ms ps \<sigma> (pc ms t) t\<Longrightarrow>
observation_inv_sig ms' ps' \<sigma>'
"
  unfolding observation_inv_sig_def step_def preCond_def
  apply(case_tac "pc ms t", simp_all add:abbr covered_v_def con_assms_def main_inv_def observation_inv_ms_def)
  apply(simp_all add:own\<^sub>W_n_by_t_imp_def general_structure_lemmas)
  apply meson
  apply meson
  apply meson
  apply (metis domI domIff)  apply clarsimp sledgehammer
  apply (metis domI domIff)
  apply (metis domI domIff)
  apply meson
  apply meson
  apply meson

lemma ms_observation_lemma_Correctness_supp_4:
  assumes "preCond ms ps \<sigma> (pc ms t) t"
  and "t \<le> T_max"
  and "ta \<le> T_max"
  and "step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'"
  and "general_structure ms"
  and "ta \<noteq> t"
  and "own\<^sub>W ms loc = Some ta"
  and "main_inv ms"
  and "main_inv_2 ms ps"
  and "main_inv_3 ms ps"
  and "observation_inv_ms ms"
shows "own\<^sub>W ms' loc = Some ta"
  using assms
  apply(subgoal_tac "\<not>isfree_addr loc ps") prefer 2
  apply (metis option.distinct(1) own_imp_1) apply (simp_all)
  apply(simp add:step_def)
  apply(simp add:preCond_def)
  apply(case_tac "pc ms t", simp_all)
  apply(simp_all add:abbr)
  apply clarify
  apply(simp_all add:general_structure_lemmas)
  apply(subgoal_tac "loc\<noteq>loca", simp_all add:Rcap_def Wcap_def)
  apply clarsimp apply(simp add:get_C_val_def)
  apply(simp add:FAAZ_def)
  apply(simp add: visible_writes_def)  apply clarsimp
  apply clarsimp
  apply(simp add: visible_writes_def)   apply clarsimp
  apply(case_tac "(snd (CAS t (a, b) (the (s ms t)) (the (n ms t)) \<sigma> ts'))", simp_all)
  apply (metis option.sel)
  apply(case_tac "CAS_succ ms t", simp_all add:abbr) apply clarsimp
  apply(case_tac "nondet_val ms t", simp_all add:abbr) apply clarsimp
  apply(case_tac "det ms t", simp_all add:abbr observation_inv_ms_def) apply clarify
  apply clarsimp
  sorry

lemma FAAZ_wm_prelim1:
  assumes "ms \<sigma> s:=\<^sup>FC t ms' \<sigma>'"
  and "wfs \<sigma>"
  and "cvd[C,valaa] \<sigma>"
shows "cvd[C,valaa] \<sigma>'"
  using assms apply (simp add:get_C_val_def FAAZ_def) apply(clarify)
  apply(simp add:update_trans_def covered_v_def Let_def rev_app_def add_cv_def update_mods_def update_modView_def
      update_thrView_def)
  apply(unfold writes_on_def value_def lastWr_def) apply safe
  apply (metis fst_conv var_def)
  apply (metis fst_conv var_def visible_var)
  apply (metis fst_conv var_def visible_var)
  apply (metis fst_conv var_def)
  apply(simp add:visible_writes_def tst_def var_def valid_fresh_ts_def)
  apply(unfold writes_on_def value_def lastWr_def wfs_def var_def) apply safe
  (*ts; is max, nempty \<and> finite*) defer
  apply auto[1]
  apply(simp) apply(intro conjI)
  apply (meson subset_iff visible_writes_in_writes)
  apply presburger
  apply (metis fst_conv)
  apply (metis fst_conv var_def visible_var)
  apply (metis fst_conv var_def visible_var)
  apply (metis fst_conv)
  (*ts; is max*) defer
  apply(simp) apply(intro conjI)
  apply (meson subset_iff visible_writes_in_writes)
  apply presburger
  sorry

lemma FAAZ_wm_prelim2:
  assumes "ms \<sigma> s:=\<^sup>FC t ms' \<sigma>'"
  and "wfs \<sigma>"
  and "\<exists>val. cvd[C,val] \<sigma> \<and> val\<noteq> loca"
shows "\<exists>val. cvd[C,val] \<sigma>' \<and> val\<noteq> loca"
  using assms
  using FAAZ_wm_prelim1 by blast

lemma FAAZ_wm_prelim3:
  assumes "ms \<sigma> s:=\<^sup>FC t ms' \<sigma>'"
  and "wfs \<sigma>"
  and "cvd[C,valaa] \<sigma>"
  and "valaa \<noteq> loca"
shows "\<exists>val. cvd[C,val] \<sigma>' \<and> val\<noteq> loca"
  using assms
  using FAAZ_wm_prelim1 by blast

lemma FAAZ_wm_prelim4:
  assumes "ms \<sigma> s:=\<^sup>FC t ms' \<sigma>'"
  and "wfs \<sigma>"
  and "observation_inv_sig ms ps \<sigma>"
  and "psem_rules ps "
  and "general_structure ms"
shows "observation_inv_sig ms' ps' \<sigma>'"
  using assms
  apply(simp add:observation_inv_sig_def general_structure_lemmas)
  apply clarify
  apply(intro conjI impI)
  apply(case_tac "ta = t")
  apply(subgoal_tac "own\<^sub>W ms loc = Some ta \<longrightarrow> own\<^sub>W ms' loc = Some ta", simp_all)
  apply(simp add:get_C_val_def)
  sledgehammer

lemma sigma_observation_lemma_Correctness:
  assumes "preCond ms ps \<sigma> (pc ms t) t"
  and "wfs \<sigma>"
  and "psem_rules ps"
  and "t \<le> T_max"
  and "step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'"
  and "general_structure ms"
  and "observation_inv_ms ms"
  and "observation_inv_sig ms ps \<sigma>"
  and "main_inv ms"
  and "main_inv_2 ms ps"
  and "main_inv_3 ms ps"
shows "observation_inv_sig ms' ps' \<sigma>'"
  using assms apply (simp_all)
  apply(simp add:preCond_def RCU.step_def)
  apply(case_tac "pc ms t", simp_all add:abbr)
  apply(simp add:covered_v_def general_structure_lemmas )
  apply clarify
  apply(unfold observation_inv_sig_def observation_inv_ms_def)
  apply clarify apply(simp_all)
  apply(case_tac "isfree_addr loc ps", simp_all)
  apply blast apply clarify
  apply(case_tac "isfree_addr loc ps", simp_all)
  apply clarify
  apply(case_tac "isfree_addr loc ps", simp_all)
  apply clarify apply(simp add:general_structure_lemmas)
  apply(case_tac "loc = loca", simp_all)
  apply metis
  apply meson
  defer (*rcu_enter*)
  defer (*rcu_exit*)
  defer (*rcu_enter*)
  apply clarify
  apply(intro conjI impI)
  using FAAZ_wm_prelim2 [where ms = ms and ms' = ms' and \<sigma> = \<sigma> and \<sigma>' = \<sigma>' and t=t and loca=loc]
  apply simp
  apply(clarsimp)
  apply(case_tac "t \<le> T_max \<and> own\<^sub>W ms loca = Some t", simp_all)
  apply (meson FAAZ_wm_prelim1)
  apply(case_tac "((\<forall>x. (\<forall>a. x = {a} \<longrightarrow> (\<forall>b. (a, b) \<notin> ran (A ps))) \<or> loca \<notin> x))")
  apply (metis FAAZ_wm_prelim1)
  apply clarify
  sledgehammer

  apply metis
  apply(simp add:general_structure_lemmas)
  sledgehammer

  by (metis (full_types))+

lemma ms_observation_lemma_Correctnesssss:
  assumes "preCond ms ps \<sigma> (pc ms t) t"
  and "wfs \<sigma>"
  and "psem_rules ps"
  and "t \<le> T_max"
  and "step ms ps \<sigma> (pc ms t) t ms' ps' \<sigma>'"
  and "general_structure ms"
  and "observation_inv_ms ms ps"
  and "observation_inv_sig ms ps \<sigma>"
  and "main_inv ms"
  and "main_inv_2 ms ps"
  and "main_inv_3 ms ps"
  and "cvd[C,vala] \<sigma>"
shows "observation_inv_ms ms' ps'"
  using assms apply (simp_all)
  apply(simp add:preCond_def)
  apply(case_tac "pc ms t", simp_all)
  apply(simp add:covered_v_def general_structure_lemmas)
  apply clarify
  apply(unfold observation_inv_sig_def observation_inv_ms_def)
  apply(subgoal_tac "\<forall>loc t. t\<le>T_max \<and> own\<^sub>W ms' loc  = Some t
  \<longrightarrow> loc\<in>(detaddrs ms' t \<union> s_and_n ms' t) ")
  apply clarify
  apply(subgoal_tac "loc \<in> detaddrs ms ta", simp add:detaddrs_def)
  apply blast

  sorry

lemma main_invariant_Correctness:
  assumes "preCond ms ps \<sigma> pcr t"
  and "t \<le> T_max"
  and "main_inv ms"
  and "main_inv_2 ms ps"
  and "pcr = pc ms t"
  and "step ms ps \<sigma> pcr t ms' ps' \<sigma>'"
  and "general_structure ms"
  and "pcr' = pc ms' t"
  and "observation_inv_ms ms ps"
  and "observation_inv_sig ms ps \<sigma>"
shows "main_inv ms'"
  using assms apply (simp add:preCond_def step_def)
  apply(case_tac[!] "pc ms t", simp_all add:abbr)
  apply(intro allI)
  apply(intro impI) apply(elim conjE exE) apply(simp add:isfree_addr_def)
  apply (metis insert_not_empty option.sel)
  apply(intro allI)
  apply(simp add:general_structure_lemmas)
  apply metis
  defer (*I8*)
  defer (*I9*)
  defer (*I11*)
  apply(simp add:general_structure_lemmas)
  apply metis
  apply(case_tac "CAS_succ ms t", simp_all)
  apply(simp_all add:abbr)
  defer (*R2*)
  apply(simp add:general_structure_lemmas) apply(case_tac "nondet_val ms t = True", simp_all)
  apply(simp_all add:abbr)
  apply(case_tac "det ms t \<noteq> []", simp_all)
  apply(simp_all add:abbr)
  apply(simp add:general_structure_lemmas)
  apply (metis Diff_empty Diff_insert0 insert_absorb insert_iff)
  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all)
  apply(simp_all add:abbr)
  defer (*S3*)
  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all)
  apply(simp_all add:abbr)
  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all)
  apply(simp_all add:abbr)
  defer (*S6*)
  apply(case_tac "reg ms t = Suc 0", simp_all)
  apply(simp add:abbr)
  apply(simp add:abbr)
  apply(clarify)
  apply(simp add:get_C_val_def)
  apply(subgoal_tac "(snd (FAAZ t (a, b) \<sigma> ts')) \<noteq> the(n ms ta)", simp add:FAAZ_def) (*need this as pre_cond*)

        apply (metis option.sel)
  defer
  apply clarify
  apply(subgoal_tac "own\<^sub>R ms (the(n ms ta)) = {ta}") prefer 2
  apply(simp add:general_structure_lemmas)
  apply (metis option.sel)
  apply(simp add:general_structure_lemmas)
  apply clarify
  apply(case_tac "snd (CAS t (a, b) (the (s ms t)) (the (n ms t)) \<sigma> ts') ")
  apply(subgoal_tac "n_dec ms' t = False") prefer 2
  apply(simp add:general_structure_lemmas)
  apply(simp add:general_structure_lemmas)
  apply (metis option.sel)
  apply(simp add:general_structure_lemmas)
  apply (metis option.sel)
  apply(simp add:general_structure_lemmas)
  apply clarify
  apply(case_tac "b", simp_all) prefer 2
  apply (metis option.sel)
  apply (metis option.sel)
  apply(simp add:general_structure_lemmas)
  apply clarify apply(simp add:names_2)
  apply (metis option.sel)
  apply(simp add:general_structure_lemmas)
  apply clarify
  apply(case_tac "v", simp_all) prefer 2
  apply (metis option.sel)
  apply (metis option.sel)
  apply(simp add: visible_writes_def)
  apply(simp add:observation_lemma_def general_structure_lemmas covered_v_def FAAZ_def)
  apply(simp add:Wcap_def)
  by (metis option.sel)

lemma main_invariant_2_Correctness:
  assumes "preCond ms ps \<sigma> pcr t"
  and "t \<le> T_max"
  and "main_inv ms"
  and "main_inv_2 ms ps"
  and "pcr = pc ms t"
  and "step ms ps \<sigma> pcr t ms' ps' \<sigma>'"       (*and "allocated_n_addr ms ps "     seems redundant*)
  and "general_structure ms"
  and "pcr' = pc ms' t"
  and "observation_lemma \<sigma> ms"
shows "main_inv_2 ms' ps'"
  using assms apply simp
  apply(simp add:step_def) apply(case_tac "pc ms t", simp_all add:abbr)
  apply(simp add:general_structure_lemmas preCond_def)
  apply(elim conjE exE, intro allI impI)
  apply(simp add:names_2)
  (*FAAZ*)
  defer
  apply(simp add:general_structure_lemmas preCond_def)
  apply(elim conjE exE, intro allI impI)
  apply(simp add:names_2)
  apply(simp add:general_structure_lemmas preCond_def)
  apply(elim conjE exE, intro allI impI)
  apply(simp add:names_2)
  apply(case_tac "snd (CAS t (a, b) (the (s ms t)) y \<sigma> ts') ") prefer 2
  apply simp
  apply simp
  apply(case_tac "CAS_succ ms t", simp_all)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(elim conjE exE, intro allI impI)
  apply(simp add:names_2)
  apply(case_tac "nondet_val ms t", simp_all)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(case_tac "det ms t \<noteq> []", simp_all)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(elim conjE exE, intro allI impI)
  apply(simp add:names_2)
  (*show that own\<^sub>R ms i \<in> det ms t \<longrightarrow> at some point is only held by {t}*)
  defer
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(elim conjE exE, intro allI impI)
  apply(simp add:names_2)
  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(elim conjE exE, intro allI impI)
  apply(simp add:names_2)
  apply(case_tac "reg ms t = Suc 0", simp_all)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  (*FAAZ*)
  apply(simp add:general_structure_lemmas preCond_def abbr)
  apply(elim conjE exE, intro allI impI)
  apply(simp add:names_2)
   defer

  sledgehammer
  oops

lemma General_Structure_Correctness:
  assumes "preCond ms ps \<sigma> pcr t"
  and "t \<le> T_max"
  and "main_inv ms"
  and "main_inv_2 ms ps"
  and "pcr = pc ms t"
  and "step ms ps \<sigma> pcr t ms' ps' \<sigma>'"
  and "general_structure ms"
  and "pcr' = pc ms' t"
  and "observation_lemma \<sigma> ms"
  and "\<exists>prov loc. prov \<notin> dom(A ps) \<and> isfree_addr loc ps"
shows "general_structure ms'"
  using assms apply simp
  apply(simp add:step_def) apply(case_tac "pc ms t", simp_all add:abbr)
  apply(simp_all add:general_structure_lemmas preCond_def names_2)
  apply metis
  apply metis
  defer
  apply metis
  defer
  defer
  defer
  apply metis
  defer
  defer
  apply(elim conjE exE)
  apply(case_tac "b", simp_all)
  apply(case_tac "nondet_val ms t", simp_all add:abbr)
  apply(case_tac "det ms t = []", simp_all add:abbr)
  defer
  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all add:abbr)
  defer
  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all add:abbr)
  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all add:abbr)
  defer
  apply(case_tac "reg ms t = Suc 0", simp_all add:abbr)
  prefer 2
  apply(simp add:FAAZ_def)
  apply(simp add:allocated_addresses_def observation_lemma_def)
  apply (metis option.sel)
  apply(intro conjI impI) prefer 2
  apply clarify
  apply(case_tac "ta = t", simp_all) prefer 2
  apply (metis option.sel) apply clarify
  apply(intro conjI impI)
  apply(subgoal_tac "y \<notin> alloc_addrs ps") prefer 2
  apply blast
  apply(subgoal_tac "the (s ms t) \<in> alloc_addrs ps")
  apply blast
  apply(subgoal_tac "allocated_addresses ms ps", simp_all add:allocation_lemmas)
  oops

lemma Global_Correctness:
  assumes "preCond ms ps \<sigma> pcr\<^sub>t t"
  and "preCond ms ps \<sigma> pcr\<^sub>t\<^sub>' t'"
  and "pcr\<^sub>t = pc ms t"
  and "pcr\<^sub>t\<^sub>' = pc ms t'"
  and "t \<noteq> t'"
  and "main_inv ms"
  and "main_inv_2 ms ps"
  and "step ms ps \<sigma> pcr\<^sub>t t ms' ps' \<sigma>'"       (*and "allocated_n_addr ms ps "     seems redundant*)
  and "general_structure ms"
  and "pcr' = pc ms' t"
shows "preCond ms' ps' \<sigma>' pcr\<^sub>t\<^sub>' t'"
  using assms apply simp
  apply(simp add:step_def) apply(case_tac "pc ms t", simp_all add:abbr)
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  (*existential complication*) defer
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  (*existential complication, FAAZ*) defer
  (*weak memory read s*)defer

  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  (*existential complication, CAS*)defer

  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(case_tac "CAS_succ ms t", simp_all)
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(simp add:general_structure_lemmas preCond_def)
  apply(elim conjE impE exE)
  apply(case_tac "b", simp_all)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(case_tac "nondet_val ms t", simp_all)
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(case_tac "det ms t \<noteq> []", simp_all)
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  (*existential complication, kill(x)*)defer

  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(case_tac "CTRsync\<^sub>1 ms t < T_max", simp_all)
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  (*existential complication, (rcu_0 + CTRsync\<^sub>1) weak memory read*)defer

  apply(case_tac "CTRsync\<^sub>2 ms t < T_max", simp_all)
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  apply(case_tac "r ms t (CTRsync\<^sub>2 ms t) = 0", simp_all)
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

  defer

  apply(case_tac "reg ms t = Suc 0", simp_all)
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)

  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis
  apply(simp add:general_structure_lemmas preCond_def)
  apply(case_tac "pc ms t'", simp_all add:abbr names_2)
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis    apply metis
  apply metis   apply metis    apply metis    apply metis    apply metis

(*weak memory guarantees needed, I think (maybe I'm wrong)*)
  oops

(*lemma test2:
  assumes "wfs \<sigma>"
  and "get_C_val ms \<sigma> t ms' \<sigma>'"
  and "cvd[C,u] \<sigma>"
shows "cvd[C,u] \<sigma>'"
  using assms apply (simp add:get_C_val_def FAAZ_def) apply(clarify)
  apply(simp add:update_trans_def covered_v_def Let_def rev_app_def add_cv_def update_mods_def update_modView_def
      update_thrView_def)
  apply(unfold writes_on_def value_def lastWr_def) apply safe
  apply (metis fst_conv var_def)
  apply (metis fst_conv var_def visible_var)
  apply (metis fst_conv var_def visible_var)
  apply (metis fst_conv var_def)
  apply(simp add:visible_writes_def tst_def var_def valid_fresh_ts_def)
  apply(unfold writes_on_def value_def lastWr_def wfs_def var_def) apply safe
  (*ts; is max, nempty \<and> finite*) defer
  apply auto[1]
  apply(simp) apply(intro conjI)
  apply (meson subset_iff visible_writes_in_writes)
  apply presburger
  apply (metis fst_conv)
  apply (metis fst_conv var_def visible_var)
  apply (metis fst_conv var_def visible_var)
  apply (metis fst_conv)
  (*ts; is max*) defer
  apply(simp) apply(intro conjI)
  apply (meson subset_iff visible_writes_in_writes)
  apply presburger
  sorry*)

(*
OWNERSHIP IDEAS:

\<forall>i. (i\<in>addrs) \<longleftrightarrow> (the(own\<^sub>W ms i)=t)

We have to get to this stage after sync():
\<forall>s i j. (s\<in>det\<^sub>i \<and> i\<noteq>j) \<longrightarrow> T\<^sub>j \<notin> own\<^sub>R(s)

because:
 T\<^sub>j \<notin> own\<^sub>R(s) \<longrightarrow> T\<^sub>j \<noteq> own\<^sub>W(s)

This allows for pop() operation to guarantee that no thread could allocate n:=newint as n:=s
unless:

own\<^sub>W(s) = T\<^sub>i \<and> own\<^sub>R(s) = { T\<^sub>i }
pop()
own\<^sub>W(s) = None \<and> own\<^sub>R(s) = {}

(Call threads t, t...)

This is absolutely guaranteed if sync() occurs deterministically:
\<forall>j. j<N \<longrightarrow> |det\<^sub>j| \<le> 1
\<forall>s j i. (s\<in>det\<^sub>j \<and> i\<noteq>j \<and> i<CTRsync\<^sub>1(j) \<and> r[i] = 0) \<longrightarrow> T\<^sub>i \<notin> own\<^sub>R(s)     (backward sync)
\<forall>s j i. (s\<in>det\<^sub>j \<and> i\<noteq>j \<and> i<CTRsync\<^sub>2(j)) \<longrightarrow> T\<^sub>i \<notin> own\<^sub>R(s)                (backward sync)
\<forall>s j i. (s\<in>det\<^sub>j \<and> i\<noteq>j \<and> CTRsync\<^sub>2(j) < N \<and> i = CTRsync\<^sub>2(j) \<and> [rcu[i] \<approx> 0]\<^sub>j) \<longrightarrow> T\<^sub>i \<notin> own\<^sub>R(s)                (backward sync)
No thread i. (j\<noteq>i) can allocate n:=newint to have address s, since own\<^sub>W(s) = T\<^sub>j
If a thread i attemps to read s=C while in rcu[i] (weak memory), this can only happen if:
CTRsync\<^sub>1 = N \<and> r[i] = 1 \<and> i\<ge>CTRsync\<^sub>2
In that case, it should be impossible for CAS\<^sub>j to succeed, resulting in eventual rcu_exit() by j with no swap,
(no matter how many times j performs rcu_enter()/rcu_exit()       ***careful in WM setting - fence*** )
which should cause {while rcu[j]} to terminate and perform CTRsync\<^sub>2++

Nondeterministically:
\<forall>j. j<N \<longrightarrow> |det\<^sub>j| \<ge> 0
\<forall>s j i. (s\<in>det\<^sub>j \<and> i\<noteq>j \<and> i<CTRsync\<^sub>2) \<longrightarrow> T\<^sub>i \<notin> own\<^sub>R(s)                (backward sync)
\<forall>s j i. (s\<in>det\<^sub>j \<and> i\<noteq>j \<and> i<CTRsync\<^sub>1 \<and> r[i] = 0) \<longrightarrow> T\<^sub>i \<notin> own\<^sub>R(s)     (backward sync)

only requirement is that own\<^sub>W(s) = T\<^sub>j to limit allocation of n:=newint to s by T\<^sub>i
T\<^sub>j faces the same problem, since n:=newint, where newint=s, requires own\<^sub>W(s) = Null.

REASONS FOR OWNERSHIP OVER NO-OWNERSHIP:
limited in Deterministic setting.
no requirement of insert(det\<^sub>j) to track order of insertion.
ease of visualisation when n:=newint happens

pop of A\<^sub>2 doesnt occur.
*)

(*definition "FAAZ t w \<sigma> ts' \<equiv>
        (update_trans t w (value \<sigma> w) \<sigma> ts', value \<sigma> w)"*)

github-repos/isabelle/MSemenyuk-PhD_Isabelle/PhD_Isabelle-179f5d346a721b15940a271323e3487f4ea51338/Treiber Stack C11/RCU (Brijesh Dongol's conflicted copy 2022-11-01).thy