theory PhiSem_Mem_OO
  imports PhiSem_OO_Class_Algebra
begin

chapter \<open>Object Oriented Programming Model\<close>

section \<open>Semantics & Fictions\<close>

subsection \<open>Models\<close>

(*not ready to use*)

subsubsection \<open>Type\<close>

virtual_datatype \<phi>OO_ty =
  T_ref :: unit

debt_axiomatization T_ref :: \<open>unit type_entry\<close>
  where \<phi>OO_ty_ax: \<open>\<phi>OO_ty TY_CONS_OF T_ref\<close>

interpretation \<phi>OO_ty TY_CONS_OF \<open>TYPE(TY_N)\<close> \<open>TYPE(TY)\<close> T_ref using \<phi>OO_ty_ax .

(*does user really need to input the semantic type manually?*)
abbreviation \<open>reference \<equiv> T_ref.mk ()\<close>

subsubsection \<open>Value\<close>

declare [[typedef_overloaded]]

datatype object_ref = object_ref ("class": \<open>class\<close>) ("instance_id": nat) | Nil
hide_const (open) "class" instance_id

lemma object_ref_all:
  \<open>All P \<longleftrightarrow> (\<forall>cls i. P (object_ref cls i)) \<and> P Nil\<close>
  by (metis object_ref.exhaust)

lemma object_ref_ex:
  \<open>Ex P \<longleftrightarrow> (\<exists>cls i. P (object_ref cls i)) \<or> P Nil\<close>
  by (metis object_ref.exhaust)

declare [[typedef_overloaded = false]]

paragraph \<open>Properties\<close>

primrec of_class
  where \<open>of_class cls (object_ref cls' _) \<longleftrightarrow> cls = cls'\<close>
  | \<open>of_class _ Nil \<longleftrightarrow> True\<close>

instantiation object_ref :: zero begin
definition \<open>zero_object_ref = Nil\<close>
instance ..
end

paragraph \<open>The Model\<close>

virtual_datatype \<phi>OO_val =
  V_ref :: \<open>object_ref\<close>

debt_axiomatization V_ref :: \<open>object_ref value_entry\<close>
  where \<phi>OO_val_ax: \<open>\<phi>OO_val VAL_CONS_OF V_ref\<close>

interpretation \<phi>OO_val VAL_CONS_OF \<open>TYPE(VAL_N)\<close> \<open>TYPE(VAL)\<close> V_ref using \<phi>OO_val_ax .

debt_axiomatization
        WT_ref[simp]: \<open>Well_Type reference = UNIV\<close>
  and   zero_ref[simp]: \<open>Zero reference = Some (V_ref.mk Nil)\<close>
  and   Can_EqCompare_ref[simp]: \<open>Can_EqCompare res (V_ref.mk ref1) (V_ref.mk ref2)\<close>
  and   EqCompare_ref[simp]:     \<open>EqCompare (V_ref.mk ref1) (V_ref.mk ref2) \<longleftrightarrow> ref1 = ref2\<close>

subsubsection \<open>Resource\<close>

type_synonym object_heap = \<open>(object_ref \<Rightarrow> field_name \<Rightarrow> VAL nosep option)\<close>

definition \<open>Valid_Objs = {h::object_heap. h Nil = 1} \<inter> {h. finite (dom1 h)}
       \<inter> {h. (\<forall>cls id. dom (h (object_ref cls id)) = {} \<or>
                       dom (h (object_ref cls id)) = dom (class.fields_of cls) ) }\<close>

lemma In_Valid_Objs[simp]:
  \<open>h \<in> Valid_Objs \<longleftrightarrow> h Nil = 1 \<and> finite (dom1 h) \<and>
     ((\<forall>cls id. dom (h (object_ref cls id)) = {} \<or> dom (h (object_ref cls id)) = dom (class.fields_of cls) ))\<close>
  unfolding Valid_Objs_def by simp

resource_space \<phi>OO =
  Objs :: \<open>Valid_Objs\<close> (partial_map_resource2)
  by (standard; simp)

lemma objref_infinite_cls:
  \<open>infinite {a. a \<noteq> Nil \<and> object_ref.class a = cls}\<close>
  using inj_on_finite[where A = \<open>UNIV::nat set\<close> and B = \<open>{a. a \<noteq> Nil \<and> object_ref.class a = cls}\<close>
        and f = \<open>\<lambda>n. object_ref cls n\<close>]
  using inj_def by fastforce

lemma Sep_Closed_Valid_Objs[simp]:
  \<open>Sep_Closed Valid_Objs\<close>
  unfolding Valid_Objs_def
  apply (rule Sep_Closed_inter, rule Sep_Closed_inter)
  apply (simp add: Sep_Closed_def times_fun)
   apply simp
  apply simp
  apply (rule Sep_Closed_pointwise[where P=\<open>\<lambda>k v.
          case k of object_ref cls i \<Rightarrow> dom v = {} \<or> dom v = dom (class.fields_of cls)
                  | _ \<Rightarrow> True\<close>,
      simplified object_ref_all, simplified])
  apply (clarsimp simp add: dom_mult one_partial_map[symmetric])
  by (metis dom_1 sup.idem sup_bot.right_neutral sup_commute)

(*
lemma Valid_Objs_1[simp]: \<open>1 \<in> Valid_Objs\<close>
  unfolding Valid_Objs_def one_fun_def by (simp add: dom1_def one_fun_def)
*)

lemma obj_map_freshness:
  \<open>finite (dom1 f) \<Longrightarrow> \<exists>k. f k = 1 \<and> k \<noteq> Nil \<and> object_ref.class k = cls\<close>
  unfolding dom1_def
  by (metis (mono_tags, lifting) finite_subset mem_Collect_eq objref_infinite_cls subsetI)

fiction_space \<phi>OO_fic =
  OO_share :: RES.Objs.share_fiction (share_fiction_for_partial_mapping_resource2 RES.Objs) ..

lemma "__case_prod_ref_field__":
  \<open>(\<lambda>(x, y). (1(ref := 1(field \<mapsto> n \<Znrres> v))) x y) = 1((ref,field) \<mapsto> n \<Znrres> v)\<close>
  unfolding fun_eq_iff by simp

section \<open>\<phi>Types\<close>

subsection \<open>Reference\<close>

(*Do we really need the class annotation here?*)

definition Ref :: \<open>class \<Rightarrow> (VAL, object_ref) \<phi>\<close>
  where \<open>Ref cls ref = ({ V_ref.mk ref } \<s>\<u>\<b>\<j> of_class cls ref)\<close>

lemma \<phi>Ref_expns[\<phi>expns]:
  \<open>v \<in> (ref \<Ztypecolon> Ref cls) \<longleftrightarrow> v = V_ref.mk ref \<and> of_class cls ref\<close>
  unfolding Ref_def \<phi>Type_def by (simp add: \<phi>expns)

lemma \<phi>Ref_inhabited[\<phi>inhabitance_rule, elim!]:
  \<open>Inhabited (ref \<Ztypecolon> Ref cls) \<Longrightarrow> (of_class cls ref \<Longrightarrow> C) \<Longrightarrow> C\<close>
  unfolding Inhabited_def by (simp add: \<phi>expns)

lemma \<phi>Ref_zero[\<phi>reason 1000]:
  \<open>\<phi>Zero reference (Ref cls) Nil\<close>
  unfolding \<phi>Zero_def by (simp add: \<phi>expns)

lemma \<phi>Ref_eq[\<phi>reason 1000]:
  \<open>\<phi>Equal (Ref cls) (\<lambda>_ _. True) (=)\<close>
  unfolding \<phi>Equal_def by (simp add: \<phi>expns)

lemma \<phi>Ref_semty[\<phi>reason 1000]:
  \<open>\<phi>SemType (ref \<Ztypecolon> Ref cls) reference\<close>
  unfolding \<phi>SemType_def by (simp add: \<phi>expns)

subsection \<open>Object\<close>

paragraph \<open>Fields in A Object\<close>

notation FIC.OO_share.\<phi> ("obj: _" [52] 51)

section \<open>Instructions\<close>

paragraph \<open>Reference Value\<close>

(* definition \<open>\<phi>M_getV_ref v F = \<phi>M_getV reference V_ref.dest v F\<close> *)

paragraph \<open>Allocation\<close>

definition initial_value_of_class
  where \<open>initial_value_of_class cls = map_option (map_nosep (the o Zero)) o class.fields_of cls\<close>

lemma dom_initial_value_of_class:
  \<open>dom (initial_value_of_class cls) = dom (class.fields_of cls)\<close>
  unfolding initial_value_of_class_def dom_def set_eq_iff by simp

definition op_obj_allocate :: \<open>class \<Rightarrow> VAL proc\<close>
  where \<open>op_obj_allocate cls =
      RES.Objs.\<phi>R_allocate_res_entry (\<lambda>ref. ref \<noteq> Nil \<and> object_ref.class ref = cls)
            (initial_value_of_class cls) (\<lambda>ref. Return (\<phi>arg (V_ref.mk ref)))\<close>

paragraph \<open>Load Field\<close>

definition op_obj_load_field :: \<open>field_name \<Rightarrow> TY \<Rightarrow> (VAL,VAL) proc'\<close>
  where \<open>op_obj_load_field field TY v =
    \<phi>M_getV reference V_ref.dest v (\<lambda>ref.
    RES.Objs.\<phi>R_get_res_entry ref field (\<lambda>v.
    \<phi>M_assert (nosep.dest v \<in> Well_Type TY) \<ggreater>
    Return (\<phi>arg (nosep.dest v))))\<close>

paragraph \<open>Store Field\<close>

definition op_obj_store_field :: \<open>field_name \<Rightarrow> TY \<Rightarrow> (VAL \<times> VAL, unit) proc'\<close>
  where \<open>op_obj_store_field field TY =
    \<phi>M_caseV (\<lambda>vstore vref.
    \<phi>M_getV TY id vstore (\<lambda>store.
    \<phi>M_getV reference V_ref.dest vref (\<lambda>ref.
    RES.Objs.\<phi>R_get_res_entry ref field (\<lambda>v. \<phi>M_assert (nosep.dest v \<in> Well_Type TY))
 \<ggreater> RES.Objs.\<phi>R_set_res (map_fun_at (map_fun_at (\<lambda>_. Some (nosep store)) field) ref)
)))\<close>

paragraph \<open>Dispose\<close>

definition op_obj_dispose :: \<open>class \<Rightarrow> (VAL, unit) proc'\<close>
  where \<open>op_obj_dispose cls vref =
    \<phi>M_getV reference V_ref.dest vref (\<lambda>ref.
    RES.Objs.\<phi>R_get_res (\<lambda>m.
    \<phi>M_assert ((ref \<in> dom1 m \<or> class.fields_of cls = 1) \<and> object_ref.class ref = cls))
 \<ggreater> RES.Objs.\<phi>R_set_res (\<lambda>f. f(ref := 1))
)\<close>

section \<open>Specification of Instructions\<close>

paragraph \<open>Reference Value\<close>

lemma \<phi>M_getV_ref:
  \<open> (of_class cls ref \<Longrightarrow> \<p>\<r>\<o>\<c> F ref \<lbrace> X \<longmapsto> Y \<rbrace> \<t>\<h>\<r>\<o>\<w>\<s> E)
\<Longrightarrow> \<p>\<r>\<o>\<c> \<phi>M_getV reference V_ref.dest raw F \<lbrace> X\<heavy_comma> ref \<Ztypecolon> Val raw (Ref cls) \<longmapsto> Y \<rbrace> \<t>\<h>\<r>\<o>\<w>\<s> E\<close>
  by (cases raw; simp; rule; simp add: \<phi>expns)

paragraph \<open>Allocation\<close>

lemma op_obj_allocate:
  \<open>\<p>\<r>\<o>\<c> op_obj_allocate cls
      \<lbrace> Void \<longmapsto> \<lambda>ret. \<exists>*ref. to_share o initial_value_of_class cls \<Ztypecolon> obj: ref \<^bold>\<rightarrow> Identity\<heavy_comma> ref \<Ztypecolon> Val ret (Ref cls) \<rbrace>\<close>
  unfolding \<phi>Procedure_Hybrid_DL op_obj_allocate_def
  apply (clarsimp simp add: \<phi>expns del: subsetI)
  apply (rule RES.Objs.\<phi>R_allocate_res_entry)
  apply (clarsimp)
  using obj_map_freshness apply blast

  apply (clarsimp simp add: one_fun_def dom_initial_value_of_class)

  prefer 2 apply assumption

  apply (simp add: \<phi>expns Return_def det_lift_def del: set_mult_expn)
  subgoal premises prems for r res k res' proof -
    have t: \<open>of_class cls k\<close>
      by (metis object_ref.collapse of_class.simps(1) prems(3))
    show ?thesis
      using t FIC.OO_share.expand[where x=\<open>1(k := initial_value_of_class cls)\<close>, simplified] prems
      using FIC.OO_share.sep_disj_fiction by fastforce
  qed .

paragraph \<open>Load Field\<close>

lemma op_obj_load_field_raw_\<phi>app:
  \<open> \<p>\<r>\<e>\<m>\<i>\<s>\<e> v \<in> Well_Type TY
\<Longrightarrow> \<p>\<r>\<o>\<c> op_obj_load_field field TY raw \<lbrace>
      nosep v \<Ztypecolon> obj: ref \<^bold>\<rightarrow> field \<^bold>\<rightarrow> n \<Znrres> \<coercion> Identity \<heavy_comma> ref \<Ztypecolon> \<v>\<a>\<l>[raw] (Ref cls)
  \<longmapsto> nosep v \<Ztypecolon> obj: ref \<^bold>\<rightarrow> field \<^bold>\<rightarrow> n \<Znrres> \<coercion> Identity \<heavy_comma> \<v>\<a>\<l> v \<Ztypecolon> Identity
\<rbrace>\<close>
  unfolding op_obj_load_field_def Premise_def
  by (rule \<phi>M_getV_ref, rule, rule \<phi>SEQ, rule \<phi>M_assert, simp, rule, simp add: Identity_expn)

proc (nodef) op_obj_load_field:
  assumes A: \<open>\<phi>SemType (x \<Ztypecolon> T) TY\<close>
  input  \<open>x \<Ztypecolon> obj: ref \<^bold>\<rightarrow> field \<^bold>\<rightarrow> n \<Znrres> \<coercion> T \<heavy_comma> ref \<Ztypecolon> Val raw (Ref cls)\<close>
  output \<open>x \<Ztypecolon> obj: ref \<^bold>\<rightarrow> field \<^bold>\<rightarrow> n \<Znrres> \<coercion> T \<heavy_comma> \<v>\<a>\<l> x \<Ztypecolon> T\<close>
  \<medium_left_bracket> \<open>obj: _\<close> to Identity \<exists>v
  have [simp]: \<open>v \<in> Well_Type TY\<close> using A[unfolded \<phi>SemType_def subset_iff] \<phi> by blast
  ;; $ref op_obj_load_field_raw[where TY=TY]
  \<medium_right_bracket> by (simp add: Nosep_expns the_\<phi>lemmata) .

paragraph \<open>Store Field\<close>

lemma op_obj_store_field_raw_\<phi>app:
  \<open> \<p>\<r>\<e>\<m>\<i>\<s>\<e> v \<in> Well_Type TY
\<Longrightarrow> \<p>\<r>\<e>\<m>\<i>\<s>\<e> u \<in> Well_Type TY
\<Longrightarrow> \<p>\<r>\<o>\<c> op_obj_store_field field TY (\<phi>V_pair rawu rawref) \<lbrace>
      nosep v \<Ztypecolon> obj: ref \<^bold>\<rightarrow> field \<^bold>\<rightarrow> \<coercion> Identity \<heavy_comma> ref \<Ztypecolon> Val rawref (Ref cls)\<heavy_comma> u \<Ztypecolon> Val rawu Identity
  \<longmapsto> nosep u \<Ztypecolon> obj: ref \<^bold>\<rightarrow> field \<^bold>\<rightarrow> \<coercion> Identity
\<rbrace>\<close>
  unfolding op_obj_store_field_def Premise_def
  apply (cases rawref; cases rawu; simp, rule, rule, simp add: Identity_expn Premise_def,
          rule \<phi>M_getV_ref, rule, rule, rule \<phi>M_assert, simp, simp add: Identity_expn)
  apply (rule FIC.OO_share.\<phi>R_set_res[where P="\<lambda>m. field \<in> dom (m ref)"])
  apply (cases ref; clarsimp simp add: map_fun_at_def dom1_def)
  apply (smt (verit, del_insts) Collect_cong dom_1 dom_eq_empty_conv insert_dom option.distinct(1))
  using RES.Objs.raw_unit_assertion_implies by blast

proc (nodef) op_obj_store_field:
  assumes A: \<open>\<phi>SemType (x \<Ztypecolon> T) TY\<close>
  assumes B: \<open>\<phi>SemType (y \<Ztypecolon> U) TY\<close>
  input  \<open>x \<Ztypecolon> obj: ref \<^bold>\<rightarrow> field \<^bold>\<rightarrow> \<coercion> T \<heavy_comma> \<v>\<a>\<l> ref \<Ztypecolon> Ref cls \<heavy_comma> \<v>\<a>\<l> y \<Ztypecolon> U\<close>
  output \<open>y \<Ztypecolon> obj: ref \<^bold>\<rightarrow> field \<^bold>\<rightarrow> \<coercion> U\<close>
  \<medium_left_bracket> to Identity \<exists>u
    \<open>obj: _\<close> to Identity \<exists>v
    op_obj_store_field_raw[where TY=TY]
      affirm using A[unfolded \<phi>SemType_def subset_iff] \<phi> by blast ;;
      affirm using B[unfolded \<phi>SemType_def subset_iff] \<phi> by blast
  \<medium_right_bracket> by (simp add: Nosep_expns the_\<phi>lemmata) .

paragraph \<open>Dispose\<close>

lemma op_obj_dispose:
  \<open> \<p>\<r>\<e>\<m>\<i>\<s>\<e> ref \<noteq> Nil
\<Longrightarrow> \<p>\<r>\<e>\<m>\<i>\<s>\<e> dom fields = dom (class.fields_of cls)
\<Longrightarrow> \<p>\<r>\<o>\<c> op_obj_dispose cls rawv
    \<lbrace> to_share o fields \<Ztypecolon> obj: ref \<^bold>\<rightarrow> Identity \<heavy_comma> ref \<Ztypecolon> Val rawv (Ref cls) \<longmapsto> \<lambda>ret. Void \<rbrace>\<close>
  unfolding op_obj_dispose_def Premise_def
  apply (rule \<phi>M_getV_ref)
  apply (rule \<phi>SEQ[where B=\<open>\<lambda>_. to_share \<circ> fields \<Ztypecolon> obj: ref \<^bold>\<rightarrow> Identity\<close>])
  apply (clarsimp simp add: \<phi>expns zero_set_def \<phi>Procedure_Hybrid_DL del: subsetI)
  apply (rule RES.Objs.\<phi>R_get_res, simp, simp add: dom1_def)
  subgoal premises prems for r res proof -
    have t1: \<open>object_ref.class ref = cls\<close>
      by (metis object_ref.collapse of_class.simps(1) prems(1) prems(3))
    have t3: \<open>fields = Map.empty \<Longrightarrow> class.fields_of cls = Map.empty\<close>
      subgoal premises prem proof -
        have \<open>dom fields = {}\<close> by (simp add: prem)
        then have \<open>dom (class.fields_of cls) = {}\<close> using prems(2) by simp
        then show ?thesis by fastforce
      qed .
    have t4: \<open>r ## FIC.OO_share.mk (1(ref := to_share \<circ> fields))\<close>
      using prems(6) by blast
    have t2: \<open>RES.Objs.get res ref = 1 \<Longrightarrow> class.fields_of cls = 1\<close>
      unfolding one_fun_def one_option_def
      apply (cases \<open>fields = Map.empty\<close>)
      using t3 apply blast
      using FIC.OO_share.partial_implies[where x=\<open>1(ref := fields)\<close> and n=1, simplified,
            OF \<open>r \<in> FIC.SPACE\<close>, OF t4, OF \<open>\<s>\<t>\<a>\<t>\<e> res \<i>\<s> _\<close>]
            nonsepable_partial_map_subsumption_L2
      by (metis domIff map_le_def)
    show ?thesis by (simp add: t1 t2 prems Return_def det_lift_def)
  qed
  apply (rule FIC.OO_share.\<phi>R_dispose_res[where P=\<open>\<lambda>_. True\<close>])
  apply (clarsimp simp add: one_fun_def)
  apply (cases ref; simp)
  using RES.Objs.get_res_Valid[simplified Valid_Objs_def, simplified]
    RES.Objs.raw_unit_assertion_implies'[where f=fields]
  by (smt (z3) domIff map_le_antisym map_le_def)

end


theory Old_Tau_Chain
  imports Old_Semantics "NewPsi.Tau_Chain"
begin

context old_psi begin

abbreviation old_tau_chain :: "'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool" ("_ \<rhd> _ \<Longrightarrow>\<^sup>^\<^sub>\<tau>\<^sub>O _" [80, 80, 80] 80)
where "\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau>\<^sub>O P' \<equiv> (P, P') \<in> {(P, P'). \<Psi> \<rhd> P \<longmapsto>\<^sub>O \<tau> \<prec> P'}^*"

abbreviation old_tau_step_chain :: "'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool" ("_ \<rhd> _ \<Longrightarrow>\<^sub>\<tau>\<^sub>O _" [80, 80, 80] 80)
where "\<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau>\<^sub>O P' \<equiv> (P, P') \<in> {(P, P'). \<Psi> \<rhd> P \<longmapsto>\<^sub>O \<tau> \<prec> P'}^+"

abbreviation old_tau_context_chain :: "('a, 'b, 'c) psi \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool" ("_ \<Longrightarrow>\<^sup>^\<^sub>\<tau>\<^sub>O _" [80, 80] 80)
where "P \<Longrightarrow>\<^sup>^\<^sub>\<tau>\<^sub>O P' \<equiv> \<one> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau>\<^sub>O P'"
abbreviation old_tau_context_step_chain :: "('a, 'b, 'c) psi \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool" ("_ \<Longrightarrow>\<^sub>\<tau>\<^sub>O _" [80, 80] 80)
where "P \<Longrightarrow>\<^sub>\<tau>\<^sub>O P' \<equiv> \<one> \<rhd> P \<Longrightarrow>\<^sub>\<tau>\<^sub>O P'"

lemmas tau_chain_induct[consumes 1, case_names tau_base tau_step] = rtrancl.induct[of _ _ "{(P, P'). \<Psi> \<rhd> P \<longmapsto>None @ \<tau> \<prec> P'}", simplified] for \<Psi>
lemmas tau_step_chain_induct[consumes 1, case_names tau_base tau_step] = trancl.induct[of _ _ "{(P, P'). \<Psi> \<rhd> P \<longmapsto>None @ \<tau> \<prec> P'}", simplified] for \<Psi>

definition old_weak_transition :: "'b \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow>  ('a, 'b, 'c) psi \<Rightarrow> 'a action \<Rightarrow> ('a, 'b, 'c) psi \<Rightarrow> bool" ("_ : _ \<rhd> _ \<Longrightarrow>\<^sub>O _ \<prec> _" [80, 80, 80, 80, 80] 80)
where
  "\<Psi> : Q \<rhd> P \<Longrightarrow>\<^sub>O \<alpha> \<prec> P' \<equiv> \<exists>P''. \<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau>\<^sub>O P'' \<and> (insert_assertion (extract_frame Q) \<Psi>) \<hookrightarrow>\<^sub>F (insert_assertion (extract_frame P'') \<Psi>) \<and>
                                          \<Psi> \<rhd> P'' \<longmapsto>\<^sub>O \<alpha> \<prec> P'"

lemma old_tau_chain_new:
  shows "\<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau>\<^sub>O P' = \<Psi> \<rhd> P \<Longrightarrow>\<^sup>^\<^sub>\<tau> P'"
  by(rule Set.eqset_imp_iff)
    (metis old_semantics_tau_sound old_semantics_complete)

lemma old_tau_step_chain_new:
  shows "\<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau>\<^sub>O P' = \<Psi> \<rhd> P \<Longrightarrow>\<^sub>\<tau> P'"
  by(rule Set.eqset_imp_iff)
    (metis old_semantics_tau_sound old_semantics_complete)

lemma old_weak_transition_sound:
  assumes "\<Psi> : Q \<rhd> P \<Longrightarrow>\<^sub>O \<alpha> \<prec> P'"
  shows   "\<exists>\<pi>. \<Psi> : Q \<rhd> P \<Longrightarrow> \<pi> @ \<alpha> \<prec> P'"
  using assms
  by(force simp add: old_weak_transition_def weak_transition_def
                     old_tau_chain_new old_tau_step_chain_new
           dest: old_semantics_sound)

lemma old_weak_transition_tau_sound:
  assumes "\<Psi> : Q \<rhd> P \<Longrightarrow>\<^sub>O \<tau> \<prec> P'"
  shows   "\<Psi> : Q \<rhd> P \<Longrightarrow> None @ \<tau> \<prec> P'"
  using assms
  by(force simp add: old_weak_transition_def weak_transition_def
                     old_tau_chain_new old_tau_step_chain_new
           dest: old_semantics_tau_sound)

lemma old_weak_transition_complete:
  assumes "\<Psi> : Q \<rhd> P \<Longrightarrow> \<pi> @ \<alpha> \<prec> P'"
  shows   "\<Psi> : Q \<rhd> P \<Longrightarrow>\<^sub>O \<alpha> \<prec> P'"
  using assms
  by(force simp add: old_weak_transition_def weak_transition_def
                     old_tau_chain_new old_tau_step_chain_new
           dest: old_semantics_complete)

end

end


theory newParallel
  imports ContinuousInv BigStepParallel Complementlemma

begin

inductive out_inv_assn :: "(gstate \<Rightarrow> bool) \<Rightarrow> (gstate \<Rightarrow> real \<Rightarrow>  bool) \<Rightarrow> cname \<Rightarrow> tassn" ("Outinv\<^sub>t") where
  "r s  \<Longrightarrow> g s v \<Longrightarrow> Outinv\<^sub>t r g ch [OutBlock ch v]"
| "(d::real) > 0 \<Longrightarrow> r s  \<Longrightarrow> g s v \<Longrightarrow> Outinv\<^sub>t r g ch [WaitBlk (ereal d) (\<lambda>_. s) ({ch}, {}), OutBlock ch v]"
| "r s  \<Longrightarrow>Outinv\<^sub>t r g ch  [WaitBlk \<infinity> (\<lambda>_. s) ({ch}, {})]"

inductive in_inv_assn :: "(gstate \<Rightarrow> bool) \<Rightarrow> (gstate \<Rightarrow> real \<Rightarrow> bool) \<Rightarrow> cname  \<Rightarrow> tassn" ("Ininv\<^sub>t") where
  "r s  \<Longrightarrow> g s v\<Longrightarrow> Ininv\<^sub>t r g ch [InBlock ch v]"
| "(d::real) > 0 \<Longrightarrow> r s  \<Longrightarrow> g s v \<Longrightarrow> Ininv\<^sub>t r g ch [WaitBlk (ereal d) (\<lambda>_. s) ({}, {ch}), InBlock ch v]"
| "r s  \<Longrightarrow> Ininv\<^sub>t r g ch  [WaitBlk \<infinity> (\<lambda>_. s) ({}, {ch})]"

inductive io_inv_assn :: "(gstate \<Rightarrow>  bool) \<Rightarrow> (gstate \<Rightarrow> real \<Rightarrow> bool) \<Rightarrow> cname \<Rightarrow> tassn" ("IOinv\<^sub>t") where
  "r s  \<Longrightarrow> g s v \<Longrightarrow> IOinv\<^sub>t r g ch [IOBlock ch v]"

inductive wait_inv_assn :: "(gstate \<Rightarrow> real \<Rightarrow> bool) \<Rightarrow> (real \<Rightarrow> bool) \<Rightarrow> rdy_info \<Rightarrow> tassn" ("Waitinv\<^sub>t") where
  "dp 0 \<Longrightarrow> Waitinv\<^sub>t r dp rdy []"
| "d > 0 \<Longrightarrow> dp d \<Longrightarrow> (\<forall>t\<in>{0..d}. r (p t) t) \<Longrightarrow> Waitinv\<^sub>t r dp rdy [WaitBlk (ereal d) p rdy]"

inductive wait_out_inv_assn ::"(gstate \<Rightarrow> real \<Rightarrow> bool) \<Rightarrow> (real \<Rightarrow> bool) \<Rightarrow> (gstate \<Rightarrow> real \<Rightarrow> bool)
                                          \<Rightarrow> rdy_info \<Rightarrow> cname  \<Rightarrow> tassn" ("WaitOutinv\<^sub>t") where
  "dp 0 \<Longrightarrow> \<exists> s. r s 0 \<and> g s v \<Longrightarrow> WaitOutinv\<^sub>t r dp g rdy ch [OutBlock ch v]"
| "d > 0 \<Longrightarrow> dp d \<Longrightarrow> (\<forall>t\<in>{0..d}. r (p t) t) \<Longrightarrow> g (p d) v
                \<Longrightarrow> WaitOutinv\<^sub>t r dp g rdy ch [WaitBlk (ereal d) p rdy, OutBlock ch v]"

inductive sb2gsb :: "(state \<Rightarrow> bool) \<Rightarrow> (gstate \<Rightarrow> bool)" where
 "p s \<Longrightarrow> sb2gsb p (State s)"

inductive srb2gsrb :: "(state \<Rightarrow> real \<Rightarrow> bool) \<Rightarrow> (gstate \<Rightarrow> real \<Rightarrow> bool)" where
 "p s v \<Longrightarrow> srb2gsrb p (State s) v"

inductive pgsb2gsb :: "(gstate \<Rightarrow> bool) \<Rightarrow> (gstate \<Rightarrow> bool) \<Rightarrow> (gstate \<Rightarrow> bool)" where
 "r1 s \<Longrightarrow> r2 s' \<Longrightarrow> pgsb2gsb r1 r2 (ParState s s') "

inductive pgsrb2gsrb :: "(gstate \<Rightarrow> real \<Rightarrow> bool) \<Rightarrow> (gstate \<Rightarrow> real \<Rightarrow> bool) \<Rightarrow> (gstate \<Rightarrow> real \<Rightarrow> bool)" where
 "r1 s v \<Longrightarrow> r2 s' v \<Longrightarrow> pgsrb2gsrb r1 r2 (ParState s s') v"

inductive gsb2gsrb :: "(gstate \<Rightarrow> bool) \<Rightarrow> (gstate \<Rightarrow> real \<Rightarrow> bool)" where
 "r s \<Longrightarrow> gsb2gsrb r s t"

lemma combine_assn_emp_ininv:
  "ch \<in> chs \<Longrightarrow> combine_assn chs emp\<^sub>t (Ininv\<^sub>t r g ch @\<^sub>t P) = false\<^sub>A"
  unfolding combine_assn_def
  apply (rule ext)
  apply (auto simp add: false_assn_def emp_assn_def join_assn_def elim!: in_inv_assn.cases)
  by (auto elim: sync_elims)

lemma combine_assn_ininv_emp:
  "ch \<in> chs \<Longrightarrow> combine_assn chs (Ininv\<^sub>t r g ch @\<^sub>t P) emp\<^sub>t = false\<^sub>A"
  unfolding combine_assn_def
  apply (rule ext)
  apply (auto simp add: false_assn_def emp_assn_def join_assn_def elim!: in_inv_assn.cases)
  by (auto elim: sync_elims)

lemma combine_assn_emp_outinv:
  "ch \<in> chs \<Longrightarrow> combine_assn chs emp\<^sub>t (Outinv\<^sub>t r g ch @\<^sub>t P) = false\<^sub>A"
  unfolding combine_assn_def
  apply (rule ext)
  apply (auto simp add: false_assn_def emp_assn_def join_assn_def elim!: out_inv_assn.cases)
  by (auto elim: sync_elims)

lemma combine_assn_outinv_emp:
  "ch \<in> chs \<Longrightarrow> combine_assn chs (Outinv\<^sub>t r g ch @\<^sub>t P) emp\<^sub>t= false\<^sub>A"
  unfolding combine_assn_def
  apply (rule ext)
  apply (auto simp add: false_assn_def emp_assn_def join_assn_def elim!: out_inv_assn.cases)
  by (auto elim: sync_elims)

lemma combine_assn_ininv_outinv:
  "ch \<in> chs \<Longrightarrow>
   combine_assn chs (Ininv\<^sub>t r1 g1 ch @\<^sub>t P) (Outinv\<^sub>t r2 g2 ch @\<^sub>t Q) \<Longrightarrow>\<^sub>t
   (IOinv\<^sub>t (pgsb2gsb r1 r2) (pgsrb2gsrb g1 g2) ch @\<^sub>t combine_assn chs P Q)"
  unfolding combine_assn_def
  apply (auto simp add: entails_tassn_def join_assn_def pure_assn_def conj_assn_def io_inv_assn.simps
                        out_inv_assn.simps in_inv_assn.simps pgsb2gsb.simps pgsrb2gsrb.simps)
          apply (auto elim: sync_elims)
  subgoal for tr tr1 tr2 s1 v1 s2 v2
    apply(rule exI[where x= "[IOBlock ch v1]"])
    apply auto
     apply(rule exI[where x= "ParState s1 s2"])
    using combine_blocks_pairE apply blast
    by (meson combine_blocks_pairE)
  done

lemma combine_assn_emp_waitinv:
  "combine_assn chs emp\<^sub>t (Waitinv\<^sub>t  p dp rdy @\<^sub>t P) \<Longrightarrow>\<^sub>t combine_assn chs emp\<^sub>t P"
  unfolding combine_assn_def
  apply (auto simp add: entails_tassn_def wait_inv_assn.simps emp_assn_def
join_assn_def false_assn_def)
  by (auto elim: sync_elims)

lemma combine_assn_waitinv_emp:
  "combine_assn chs  (Waitinv\<^sub>t  p dp rdy @\<^sub>t P) emp\<^sub>t \<Longrightarrow>\<^sub>t combine_assn chs  P emp\<^sub>t"
  unfolding combine_assn_def
  apply (auto simp add: entails_tassn_def wait_inv_assn.simps emp_assn_def
join_assn_def false_assn_def)
  by (auto elim: sync_elims)

lemma combine_assn_waitinv_ininv:
  assumes "ch \<in> chs"
    and "compat_rdy rdy1 ({}, {ch})"
  shows "combine_assn chs (Waitinv\<^sub>t r1 dp rdy1 @\<^sub>t P) (Ininv\<^sub>t r2 g ch @\<^sub>t Q) \<Longrightarrow>\<^sub>t
   (Waitinv\<^sub>t (pgsrb2gsrb r1 (gsb2gsrb r2)) dp (merge_rdy rdy1 ({}, {ch})) @\<^sub>t
    combine_assn chs P (Ininv\<^sub>t r2 g ch @\<^sub>t Q))"
proof-
  have *:"(Waitinv\<^sub>t (pgsrb2gsrb r1 (gsb2gsrb r2)) dp (merge_rdy rdy1 ({}, {ch})) @\<^sub>t
    combine_assn chs P (Ininv\<^sub>t r2 g ch @\<^sub>t Q)) tr" if
        "(Waitinv\<^sub>t r1 dp rdy1 @\<^sub>t P) tr1" "(Ininv\<^sub>t r2 g ch @\<^sub>t Q) tr2"
        "combine_blocks chs tr1 tr2 tr" for tr tr1 tr2
  proof-
    from that(1)[unfolded join_assn_def]
    obtain tr11 tr12 where a: "Waitinv\<^sub>t r1 dp rdy1 tr11" "P tr12" "tr1 = tr11 @ tr12"
      by auto
    from that(2)[unfolded join_assn_def]
    obtain tr21 tr22 where b: "Ininv\<^sub>t r2 g ch tr21" "Q tr22" "tr2 = tr21 @ tr22"
      by auto
    have d:"(Waitinv\<^sub>t (pgsrb2gsrb r1 (gsb2gsrb r2)) dp (merge_rdy rdy1 ({}, {ch})) @\<^sub>t
     combine_assn chs P (Ininv\<^sub>t r2 g ch @\<^sub>t Q)) tr" if
        "0 < d2" "0<d" "dp d"
        "combine_blocks chs (WaitBlk (ereal d) p rdy1 # tr12)
          (WaitBlk (ereal d2) (\<lambda>_. s) ({}, {ch}) # InBlock ch v # tr22) tr"
        "\<forall>t\<in>{0..d}. r1 (p t) t"
        "r2 s "  "g s v "
      for d p s v d2
    proof -
      have "d < d2 \<or> d = d2 \<or> d > d2" by auto
      then show ?thesis
      proof (elim disjE)
        assume d1: "d < d2"
        have d1': "ereal d < ereal d2"
          using d1 by auto
        show ?thesis
          using that(4)
          apply (elim combine_blocks_waitE3)
             apply (rule that(2)) apply (rule d1') using assms(2) apply simp
          subgoal for blks'
            apply (subst join_assn_def)
            apply (rule exI[where x="[WaitBlk d (\<lambda>t. ParState (p t) s) (merge_rdy rdy1 ({}, {ch}))]"])
            apply (rule exI[where x=blks'])
            apply (rule conjI)
            subgoal
              apply(auto simp add:wait_inv_assn.simps pgsrb2gsrb.simps gsb2gsrb.simps)
              apply(rule exI[where x="d"])
              apply(rule exI[where x="(\<lambda>t. ParState (p t) s)"])
              using that by auto
            apply (rule conjI)
             prefer 2 subgoal using d1 by auto
            unfolding combine_assn_def
            apply (rule exI[where x=tr12])
            apply (rule exI[where x="WaitBlk (d2 - d) (\<lambda>_. s) ({}, {ch}) # InBlock ch v # tr22"])
            apply (rule conjI)
            subgoal by (rule a(2))
            apply (rule conjI)
             prefer 2 subgoal by auto
            apply (subst join_assn_def)
            apply (rule exI[where x="[WaitBlk (d2 - d) (\<lambda>_. s) ({}, {ch}), InBlock ch v]"])
            apply (rule exI[where x=tr22])
            using b(2) d1 that by (auto intro: in_inv_assn.intros)
          done
      next
        assume d2: "d = d2"
        show ?thesis
          using that(4) unfolding d2[symmetric]
          apply (elim combine_blocks_waitE2)
          using assms(2) apply simp
          subgoal for blks'
            apply (subst join_assn_def)
            apply (rule exI[where x="[WaitBlk d (\<lambda>t. ParState (p t) s) (merge_rdy rdy1 ({}, {ch}))]"])
            apply (rule exI[where x=blks'])
            apply (rule conjI)
            subgoal using that apply (auto simp add: wait_inv_assn.simps pgsrb2gsrb.simps gsb2gsrb.simps)
              by blast
            apply (rule conjI)
             prefer 2 subgoal by auto
            unfolding combine_assn_def
            apply (rule exI[where x=tr12])
            apply (rule exI[where x="InBlock ch v # tr22"])
            apply (rule conjI)
            subgoal using a(2) by auto
            apply (rule conjI)
            subgoal apply (subst join_assn_def)
              apply (rule exI[where x="[InBlock ch v]"])
              apply (rule exI[where x=tr22])
              by (auto intro: in_inv_assn.intros b(2) that)
            by auto
          done
      next
        assume d3: "d > d2"
        have d3': "ereal d > ereal d2"
          using d3  by auto
        show ?thesis
          using that(4)
          apply (elim combine_blocks_waitE4)
          apply (rule that(1)) apply (rule d3')
           using assms(2) apply simp
          apply (elim combine_blocks_pairE2')
          using assms by auto
      qed
        qed
      have e: "(Waitinv\<^sub>t (pgsrb2gsrb r1 (gsb2gsrb r2)) dp (merge_rdy rdy1 ({}, {ch})) @\<^sub>t
     combine_assn chs P (Ininv\<^sub>t r2 g ch @\<^sub>t Q)) tr" if
        "combine_blocks chs (WaitBlk (ereal d) p rdy1 # tr12)
          (WaitBlk \<infinity> (\<lambda>_. s) ({}, {ch}) # tr22) tr" "0 < d " "dp d"
          "\<forall>t\<in>{0..d}. r1 (p t) t" "r2 s" for d p s
      proof -
      have e1: "\<infinity> - ereal d = \<infinity>"
        by auto
      show ?thesis
        using that
        apply (elim combine_blocks_waitE3)
           apply auto using assms(2) apply simp
        subgoal for blks'
          apply (subst join_assn_def)
          apply (rule exI[where x="[WaitBlk d (\<lambda>t. ParState (p t) s) (merge_rdy rdy1 ({}, {ch}))]"])
          apply (rule exI[where x=blks'])
          apply (rule conjI)
            subgoal apply(simp add: wait_inv_assn.simps pgsrb2gsrb.simps gsb2gsrb.simps) by blast
            apply (rule conjI)
             prefer 2 apply simp
            unfolding combine_assn_def
            apply (rule exI[where x=tr12])
            apply (rule exI[where x="WaitBlk \<infinity> (\<lambda>_. s) ({}, {ch}) # tr22"])
            apply (rule conjI)
            subgoal by (rule a(2))
            apply (rule conjI)
             prefer 2 apply auto
            apply (subst join_assn_def)
            apply (rule exI[where x="[WaitBlk \<infinity> (\<lambda>_. s) ({}, {ch})]"])
            apply (rule exI[where x=tr22])
            using b(2) apply (auto intro: in_inv_assn.intros)
          done
        done
    qed
    show ?thesis
      using a(1) apply (cases rule: wait_inv_assn.cases)
      using b(1) apply (cases rule: in_inv_assn.cases)
      subgoal for s v
        apply(auto simp add: combine_assn_def join_assn_def)
        apply(rule exI[where x= "[]"])
        apply (auto simp add: wait_inv_assn.simps)
        apply(rule exI[where x= "tr12"])
        apply (auto simp add: a)
        apply(rule exI[where x= "tr2"])
        apply auto
         apply(rule exI[where x= "tr21"])
         apply auto
        using b apply auto
        using that a b by auto
 subgoal for d s v
        apply(auto simp add: combine_assn_def join_assn_def)
        apply(rule exI[where x= "[]"])
        apply (auto simp add: wait_inv_assn.simps)
        apply(rule exI[where x= "tr12"])
        apply (auto simp add: a)
        apply(rule exI[where x= "tr2"])
        apply auto
         apply(rule exI[where x= "tr21"])
         apply auto
        using b apply auto
        using that a b by auto
      subgoal for d
        apply(auto simp add: combine_assn_def join_assn_def)
        apply(rule exI[where x= "[]"])
        apply (auto simp add: wait_inv_assn.simps)
        apply(rule exI[where x= "tr12"])
        apply (auto simp add: a)
        apply(rule exI[where x= "tr2"])
        apply auto
         apply(rule exI[where x= "tr21"])
         apply auto
        using b apply auto
        using that a b by auto
      using b(1) apply (cases rule: in_inv_assn.cases)
      subgoal for s v d p
        apply(auto simp add: combine_assn_def join_assn_def)
        by (metis Cons_eq_appendI a(3) assms(1) b(3)  combine_blocks_pairE2' that(3))
      subgoal for d p d2 s v
        apply(rule d[of d2 d p s v])
        using that a b by auto
      subgoal for d p s
        apply(rule e[of d p s])
        using that a b by auto
      done
  qed
show ?thesis
    apply (subst combine_assn_def)
    apply (auto simp add: entails_tassn_def)
  using * by auto
qed

lemma combine_assn_waitoutinv_emp:
  assumes "ch \<in> chs"
  shows "combine_assn chs (WaitOutinv\<^sub>t r dp g rdy ch @\<^sub>t P) emp\<^sub>t \<Longrightarrow>\<^sub>t false\<^sub>A"
  unfolding combine_assn_def
  apply (auto simp add: entails_tassn_def join_assn_def emp_assn_def false_assn_def wait_out_inv_assn.simps)
  using assms by (auto elim: sync_elims)

lemma combine_assn_waitoutinv_ininv:
  assumes "ch \<in> chs"
    and "ch \<in> fst rdy"
  shows "combine_assn chs (WaitOutinv\<^sub>t rr dp g1 rdy ch @\<^sub>t P) (Ininv\<^sub>t r g2 ch @\<^sub>t Q) \<Longrightarrow>\<^sub>t
         (IOinv\<^sub>t (pgsb2gsb (\<lambda> s. rr s 0) r) (pgsrb2gsrb g1 g2) ch @\<^sub>t combine_assn chs P Q)"
proof-
  have *:"(IOinv\<^sub>t (pgsb2gsb (\<lambda> s. rr s 0) r) (pgsrb2gsrb g1 g2) ch @\<^sub>t combine_assn chs P Q) tr"
    if "(WaitOutinv\<^sub>t rr dp g1 rdy ch @\<^sub>t P) tr1" "(Ininv\<^sub>t r g2 ch @\<^sub>t Q) tr2" "combine_blocks chs tr1 tr2 tr" for tr tr1 tr2
  proof -
    from that(1)[unfolded join_assn_def]
    obtain tr11 tr12 where a: "WaitOutinv\<^sub>t rr dp g1 rdy ch tr11" "P tr12" "tr1 = tr11 @ tr12"
      by auto
    from that(2)[unfolded join_assn_def]
    obtain tr21 tr22 where b: "Ininv\<^sub>t r g2 ch tr21" "Q tr22" "tr2 = tr21 @ tr22"
      by auto
    show ?thesis
      using a(1) apply (cases rule: wait_out_inv_assn.cases)
      subgoal for v
        using b(1) apply (cases rule: in_inv_assn.cases)
        subgoal for s' v'
          using that(3) unfolding a(3) b(3) apply auto
          apply (elim combine_blocks_pairE) using assms(1) apply auto
          apply (auto simp add: conj_assn_def pure_assn_def join_assn_def)
          apply (rule exI[where x="[IOBlock ch v']"])
          apply (auto intro: io_assn.intros)
          unfolding combine_assn_def using a(2) b(2) apply auto
          subgoal for s tr'
            using io_inv_assn.intros[of "(pgsb2gsb (\<lambda>s. rr s 0) r)" "ParState s s'" "(pgsrb2gsrb g1 g2)" v ch]
            by(auto simp add:pgsb2gsb.simps pgsrb2gsrb.simps)
          done
        subgoal for d s' v'
          using that(3) unfolding a(3) b(3) apply auto
          apply (elim combine_blocks_pairE2) using assms by auto
        subgoal for s'
          using that(3) unfolding a(3) b(3) apply auto
          apply (elim combine_blocks_pairE2) by (rule assms)
        done
      using b(1) apply (cases rule: in_inv_assn.cases)
      using that(3) unfolding a(3) b(3) apply auto
      subgoal apply (elim combine_blocks_pairE2') by (rule assms)
      subgoal for d' apply (elim combine_blocks_waitE1)
        using assms(2) apply (cases rdy) by auto
      subgoal apply (elim combine_blocks_waitE1)
        using assms(2) apply (cases rdy) by auto
      done
  qed
show ?thesis
    apply (subst combine_assn_def)
    apply (auto simp add: entails_tassn_def)
    using * by auto
qed

end


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

header{*The n_mutualExFsm Protocol Case Study*}

theory n_mutualExFsm_lemma_inv__4_on_rules imports n_mutualExFsm_lemma_on_inv__4
begin
section{*All lemmas on causal relation between inv__4*}
lemma lemma_inv__4_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv0. p__Inv0\<le>N\<and>f=inv__4  p__Inv0)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i. i\<le>N\<and>r=n_fsm  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_fsm  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_fsmVsinv__4) done
    }

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

end