section \<open>Error Monad\<close>
theory Error_Monad
imports
  "~~/src/HOL/Library/Monad_Syntax"
  "$AFP/Automatic_Refinement/Lib/Refine_Lib"
begin

  text \<open>We define an error monad, with a special case for nontermination,
    and set up the monad syntax and partial function package\<close>

  subsection \<open>Basic type definition\<close>
  datatype ('a,'b) pre_error = pre_return 'a | pre_EAssert 'b

  datatype ('a,'b) error = ETerm "('a,'b) pre_error" | ENonterm

  abbreviation "return x \<equiv> ETerm (pre_return x)"
  abbreviation "EAssert x \<equiv> ETerm (pre_EAssert x)"

  lemma error_cases: obtains
    x where "v=return x" | e where "v=EAssert e" | "v=ENonterm"
    apply (cases v; simp) apply (rename_tac x; case_tac x; simp)
    done

  lemmas [cases type] = error_cases[case_names return EAssert ENonterm]

  context begin
    qualified fun bind where
      "bind (return x) f = f x"
    | "bind (EAssert e) _ = EAssert e"
    | "bind (ENonterm) _ = ENonterm"

  end

  adhoc_overloading bind Error_Monad.bind

  subsection \<open>Monad Laws and Basic Lemmas\<close>

  lemma monad_laws[simp]:
    "return x \<bind> f = f x"
    "m \<bind> return = m"
    "(m \<bind> f) \<bind> g = m \<bind> (\<lambda>x. f x \<bind> g)"
    apply simp
    apply (cases m; simp)+
    done

  context begin
    qualified lemma bind_split:
      "P (m \<bind> f) = ((\<forall>e. m = EAssert e \<longrightarrow> P (EAssert e)) \<and> (m=ENonterm \<longrightarrow> P (ENonterm)) \<and> (\<forall>v. m = return v \<longrightarrow> P (f v)))"
      apply (cases m) by auto

    qualified lemma bind_split_asm: "P (m \<bind> f)
      = (\<not> ((\<exists>e. m = (EAssert e) \<and> \<not> P (EAssert e)) \<or> (m=ENonterm \<and> \<not>P ENonterm) \<or> (\<exists>x. m = return x \<and> \<not> P (f x))))"
      apply (cases m) by auto

    qualified lemmas bind_splits = bind_split bind_split_asm
  end

  subsection \<open>Partial Function Setup\<close>
  abbreviation "error_ord \<equiv> flat_ord ENonterm"
  abbreviation "mono_error \<equiv> monotone (fun_ord error_ord) error_ord"

  interpretation error:
    partial_function_definitions "flat_ord ENonterm" "flat_lub ENonterm"
    rewrites "flat_lub ENonterm {} \<equiv> ENonterm"
  by (rule flat_interpretation)(simp add: flat_lub_def)

  thm option.leq_trans

  lemma bind_mono[partial_function_mono]:
  fixes B :: "('a \<Rightarrow> ('b, 'err) error) \<Rightarrow> ('d, 'err) error"
  assumes mf: "mono_error B" and mg: "\<And>y. mono_error (\<lambda>f. C y f)"
  shows "mono_error (\<lambda>f. Error_Monad.bind (B f) (\<lambda>y. C y f))"
  proof (rule monotoneI)
    fix f g :: "'a \<Rightarrow> ('b,'err) error" assume fg: "fun_ord error_ord f g"
    with mf
    have "error_ord (B f) (B g)" by (rule monotoneD[of _ _ _ f g])
    then have "error_ord (Error_Monad.bind (B f) (\<lambda>y. C y f)) (Error_Monad.bind (B g) (\<lambda>y. C y f))"
      unfolding flat_ord_def by auto
    also from mg
    have "\<And>y'. error_ord (C y' f) (C y' g)"
      by (rule monotoneD) (rule fg)
    then have "error_ord (Error_Monad.bind (B g) (\<lambda>y'. C y' f)) (Error_Monad.bind (B g) (\<lambda>y'. C y' g))"
      unfolding flat_ord_def by (cases "B g") auto
    finally (error.leq_trans)
    show "error_ord (Error_Monad.bind (B f) (\<lambda>y. C y f)) (Error_Monad.bind (B g) (\<lambda>y'. C y' g))" .
  qed

  lemma error_admissible: "error.admissible (%(f::'a \<Rightarrow> ('b,'err) error).
    (\<forall>x y. f x = ETerm y \<longrightarrow> P x y))"
  proof (rule ccpo.admissibleI)
    fix A :: "('a \<Rightarrow> ('b,'err) error) set"
    assume ch: "Complete_Partial_Order.chain error.le_fun A"
      and IH: "\<forall>f\<in>A. \<forall>x y. f x = ETerm y \<longrightarrow> P x y"
    from ch have ch': "\<And>x. Complete_Partial_Order.chain error_ord {y. \<exists>f\<in>A. y = f x}" by (rule chain_fun)
    show "\<forall>x y. error.lub_fun A x = ETerm y \<longrightarrow> P x y"
    proof (intro allI impI)
      fix x y assume "error.lub_fun A x = ETerm y"
      from flat_lub_in_chain[OF ch' this[unfolded fun_lub_def]]
      have "ETerm y \<in> {y. \<exists>f\<in>A. y = f x}" by simp
      then have "\<exists>f\<in>A. f x = ETerm y" by auto
      with IH show "P x y" by auto
    qed
  qed

  lemma fixp_induct_error:
    fixes F :: "'c \<Rightarrow> 'c" and
      U :: "'c \<Rightarrow> 'b \<Rightarrow> ('a,'err) error" and
      C :: "('b \<Rightarrow> ('a,'err) error) \<Rightarrow> 'c" and
      P :: "'b \<Rightarrow> ('a,'err) pre_error \<Rightarrow> bool"
    assumes mono: "\<And>x. mono_error (\<lambda>f. U (F (C f)) x)"
    assumes eq: "f \<equiv> C (ccpo.fixp (fun_lub (flat_lub ENonterm)) (fun_ord error_ord) (\<lambda>f. U (F (C f))))"
    assumes inverse2: "\<And>f. U (C f) = f"
    assumes step: "\<And>f x y. (\<And>x y. U f x = ETerm y \<Longrightarrow> P x y) \<Longrightarrow> U (F f) x = ETerm y \<Longrightarrow> P x y"
    assumes defined: "U f x = ETerm y"
    shows "P x y"
    using step defined error.fixp_induct_uc[of U F C, OF mono eq inverse2 error_admissible]
    unfolding fun_lub_def flat_lub_def by(auto 9 2)

  declaration {* Partial_Function.init "error" @{term error.fixp_fun}
    @{term error.mono_body} @{thm error.fixp_rule_uc} @{thm error.fixp_induct_uc}
    (SOME @{thm fixp_induct_error}) *}

  subsection \<open>Derived Definitions\<close>

  definition "assert \<Phi> e \<equiv> if \<Phi> then return () else EAssert e"
  lemma assert_simps[simp]:
    "assert True e = return ()"
    "assert False e = EAssert e"
    "assert \<Phi> e = return () \<longleftrightarrow> \<Phi>"
    unfolding assert_def by auto

  lemma assert_term[simp]: "assert \<Phi> e \<noteq> ENonterm"
    by (auto simp: assert_def)

  fun try_catch where
    "try_catch (return m) _ = return m"
  | "try_catch (EAssert e) h = h e"
  | "try_catch ENonterm _ = ENonterm"

  fun total_correct :: "('a,'e) error \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool" where
    "total_correct (return v) \<Phi> = \<Phi> v" | "total_correct _ _ = False"

  fun terminating :: "('a,'e) error \<Rightarrow> bool" where
    "terminating ENonterm = False" | "terminating _ = True"

  fun partial_correct :: "('a,'e) error \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool" where
    "partial_correct (return v) \<Phi> = \<Phi> v"
  | "partial_correct (ENonterm) _ = True"
  | "partial_correct (EAssert _) _ = False"

  fun is_nonterm :: "('a,'e) error \<Rightarrow> bool" where
    "is_nonterm (ENonterm) = True"
  | "is_nonterm _ = False"

  fun is_res :: "('a,'e) error \<Rightarrow> 'a \<Rightarrow> bool" where
    "is_res (return v) x \<longleftrightarrow> v=x"
  | "is_res _ _ \<longleftrightarrow> False"

  fun is_error :: "('a,'e) error \<Rightarrow> 'e \<Rightarrow> bool" where
    "is_error (EAssert x) e \<longleftrightarrow> x=e"
  | "is_error _ _ \<longleftrightarrow> False"

  lemma pw_nt_iff: "m=ENonterm \<longleftrightarrow> is_nonterm m" by (cases m) auto
  lemma pw_eq_iff: "m=m'
    \<longleftrightarrow> (is_nonterm m = is_nonterm m') \<and> (\<forall>e. is_error m e \<longleftrightarrow> is_error m' e) \<and> (\<forall>x. is_res m x \<longleftrightarrow> is_res m' x)"
    by (cases m; cases m'; auto)
  lemma pw_err_iff: "m=EAssert e \<longleftrightarrow> is_error m e" by (cases m) auto

  lemma
    "total_correct m \<Phi> = (\<exists>x. is_res m x \<and> \<Phi> x)"
    "partial_correct m \<Phi> = total_correct m \<Phi> \<or> is_nonterm m"
    "terminating m \<longleftrightarrow> \<not>is_nonterm m"
    apply (cases m; simp)
    apply (cases "(m,\<Phi>)" rule: partial_correct.cases; simp)
    apply (cases m rule: terminating.cases; simp)
    done

  lemma pw_bind[simp]:
    "is_res (m\<bind>f) x \<longleftrightarrow> (\<exists>y. is_res m y \<and> is_res (f y) x)"
    "is_nonterm (m\<bind>f) \<longleftrightarrow> is_nonterm m \<or> (\<exists>y. is_res m y \<and> is_nonterm (f y))"
    "is_error (m\<bind>f) e \<longleftrightarrow> is_error m e \<or> (\<exists>y. is_res m y \<and> is_error (f y) e)"
    by (cases m; simp; fail)+

  lemma pw_assert[simp]:
    "is_res (assert \<Phi> msg) x \<longleftrightarrow> \<Phi>"
    "is_nonterm (assert \<Phi> msg) \<longleftrightarrow> False"
    "is_error (assert \<Phi> msg) e \<longleftrightarrow> \<not>\<Phi> \<and> msg=e"
    by (cases \<Phi>; simp; fail)+

  lemma pw_try_catch[simp]:
    "is_res (try_catch m h) x \<longleftrightarrow> is_res m x \<or> (\<exists>e. is_error m e \<and> is_res (h e) x)"
    "is_nonterm (try_catch m h) \<longleftrightarrow> is_nonterm m \<or> (\<exists>e. is_error m e \<and> is_nonterm (h e))"
    "is_error (try_catch m h) e \<longleftrightarrow> (\<exists>e'. is_error m e' \<and> (is_error (h e') e))"
    by (cases m; auto; fail)+

  subsection \<open>Specifications\<close>

  fun e_spec :: "('a \<Rightarrow> bool) \<Rightarrow> ('e \<Rightarrow> bool) \<Rightarrow> bool \<Rightarrow> ('a,'e) error \<Rightarrow> bool" where
    "e_spec P E T (return x) \<longleftrightarrow> P x"
  | "e_spec P E T (EAssert e) \<longleftrightarrow> E e"
  | "e_spec P E T ENonterm \<longleftrightarrow> T"

  lemma pw_espec_iff: "e_spec P E T m \<longleftrightarrow>
      (\<forall>x. is_res m x \<longrightarrow> P x)
    \<and> (\<forall>e. is_error m e \<longrightarrow> E e)
    \<and> (is_nonterm m \<longrightarrow> T)"
    by (cases m) auto

  lemma espec_add_full:
      -- \<open>Strengthen specification by adding full knowledge about program\<close>
    "e_spec P E T m \<Longrightarrow>
      e_spec
        (\<lambda>r. P r \<and> m=return r)
        (\<lambda>e. E e \<and> m=EAssert e)
        (m=ENonterm) m"
        apply (cases m) apply auto
        done

  lemma espec_add_ret: "e_spec P E T m \<Longrightarrow> e_spec (\<lambda>r. P r \<and> m=return r) E T m"
    apply (cases m) apply auto
    done

  (*abbreviation "et_spec' P E \<equiv> e_spec P E False" -- \<open>Total correctness, with error\<close>
  abbreviation "ep_spec' P E \<equiv> e_spec P E True" -- \<open>Partial correctness, with error\<close>

  abbreviation "et_spec P \<equiv> et_spec' P (\<lambda>_. False)"
  abbreviation "ep_spec P \<equiv> ep_spec' P (\<lambda>_. False)"
  *)

  subsection \<open>VCG\<close>

  named_theorems e_vcg \<open>VCG rules for error monad\<close>

  lemma e_cons: "\<lbrakk>e_spec P E T m; \<And>x. P x \<Longrightarrow> P' x; \<And>e. E e \<Longrightarrow> E' e; T \<Longrightarrow> T' \<rbrakk>
    \<Longrightarrow> e_spec P' E' T' m"
    by (auto simp: pw_espec_iff)

  lemma e_vcg_basic[e_vcg]:
    "P x \<Longrightarrow> e_spec P E T (return x)"
    "E e \<Longrightarrow> e_spec P E T (EAssert e)"
    "T \<Longrightarrow> e_spec P E T (ENonterm)"
    by auto

  lemma (in -) e_Let_vcg[e_vcg]: "e_spec P E T (f v) \<Longrightarrow> e_spec P E T (let x=v in f x)" by simp

  lemma e_bind_vcg[e_vcg]:
    assumes "e_spec (\<lambda>x. e_spec P E T (f x)) E T m"
    shows "e_spec P E T (do { x \<leftarrow> m; f x })"
    using assms
    by (auto simp: pw_espec_iff)

  lemma e_assert_vcg[e_vcg]:
    "\<lbrakk> \<Phi> \<Longrightarrow> P (); \<not>\<Phi> \<Longrightarrow> E e \<rbrakk> \<Longrightarrow> e_spec P E T (assert \<Phi> e)"
    by (auto simp: pw_espec_iff)

  lemma e_try_catch[e_vcg]:
    assumes "e_spec P E' T m"
    assumes "\<And>e. E' e \<Longrightarrow> e_spec P E T (h e)"
    shows "e_spec P E T (try_catch m h)"
    using assms
    by (auto simp: pw_espec_iff)

  lemma split_rule_unfolds:
    "Trueprop (a\<longrightarrow>b) \<equiv> (a\<Longrightarrow>b)"
    "(a \<and> b \<Longrightarrow> PROP Q) \<equiv> (\<lbrakk>a;b\<rbrakk>\<Longrightarrow>PROP Q)"
    "Trueprop (\<forall>x. p x) \<equiv> (\<And>x. p x)"
    apply presburger
    apply (rule conj_imp_eq_imp_imp)
    by presburger

  (* TODO: Automate generation of split rules *)
  lemmas prod_split_e_vcg[e_vcg] = prod.split[where P="e_spec P E T" for P E T, THEN iffD2, unfolded split_rule_unfolds]
  lemmas option_split_e_vcg[e_vcg] = option.split[where P="e_spec P E T" for P E T, THEN iffD2, unfolded split_rule_unfolds]

  lemmas (in -) e_if_vcg[e_vcg] =
    split_if[where P="e_spec P E T" for P E T, THEN iffD2, unfolded split_rule_unfolds]

  lemma is_espec_rl: "e_spec P E T m \<Longrightarrow> e_spec P E T m" .

  ML \<open>
    structure e_vcg = struct

      val vcg_modifiers = [
        Args.$$$ "vcg" -- Scan.option Args.add -- Args.colon
          >> K (Method.modifier (Named_Theorems.add @{named_theorems e_vcg}) @{here}),
        Args.$$$ "vcg" -- Scan.option Args.del -- Args.colon
          >> K (Method.modifier (Named_Theorems.del @{named_theorems e_vcg}) @{here})
      ];

      val e_vcg_modifiers =
        clasimp_modifiers @ vcg_modifiers;

      fun e_vcg try_solve ctxt = let

        val ps_ctxt = Splitter.del_split @{thm split_if} ctxt

        val vcg_thms = Named_Theorems.get ctxt @{named_theorems e_vcg}

        fun TRY_SOLVE tac = SOLVED' tac ORELSE' (DETERM o tac)

        val vcg_rule_tac = resolve_tac ctxt @{thms is_espec_rl}
          THEN' (
            rprems_tac ctxt ORELSE' resolve_tac ctxt vcg_thms
          )

        val vcg_step_tac =
          vcg_rule_tac
          ORELSE'
          (resolve_tac ctxt @{thms e_cons} THEN' vcg_rule_tac)

        val solve_other_tac =
          TRY o (SOLVED' (SELECT_GOAL (auto_tac ctxt)))

        fun tac i = (
          Method.assm_tac ctxt
          ORELSE' (clarsimp_tac ps_ctxt THEN_ALL_NEW TRY_SOLVE ( vcg_step_tac THEN_ALL_NEW_FWD tac ))
          ORELSE' solve_other_tac
        ) i

        val tac' = REPEAT_ALL_NEW_FWD (FIRST' [Method.assm_tac ctxt,clarsimp_tac ps_ctxt THEN_ALL_NEW_FWD vcg_step_tac])

      in
        if try_solve then tac else tac'
      end

      fun gen_e_vcg_method try_solve =
        Method.sections e_vcg_modifiers >> (fn _ => fn ctxt =>
          SIMPLE_METHOD' (CHANGED o e_vcg try_solve ctxt))

    end
  \<close>

  method_setup e_vcg = \<open>e_vcg.gen_e_vcg_method true\<close> \<open>VCG for the error monad (with auto-solver)\<close>
  method_setup e_vcg' = \<open>e_vcg.gen_e_vcg_method false\<close> \<open>VCG for the error monad (no solvers)\<close>

  subsection \<open>Standard Combinators\<close>

  primrec emap :: "('a \<Rightarrow> ('b,'e)error) \<Rightarrow> 'a list \<Rightarrow> ('b list,'e) error" where
    "emap _ [] = return []"
  | "emap f (x#xs) = do {
      y \<leftarrow> f x;
      ys \<leftarrow> emap f xs;
      return (y#ys)
    }"

  lemma emap_cong[fundef_cong]: "\<lbrakk> xs = ys; \<And>x. x\<in>set ys \<Longrightarrow> f x = g x \<rbrakk> \<Longrightarrow> emap f xs = emap g ys"
    apply (induction ys arbitrary: xs)
    apply (auto split: Error_Monad.bind_split)
    done

  lemma emap_nontermD: "is_nonterm (emap f l) \<Longrightarrow> (\<exists>x\<in>set l. is_nonterm (f x))"
    by (induction l) auto
  lemma emap_nontermD': "emap f l = ENonterm \<Longrightarrow> (\<exists>x\<in>set l. f x = ENonterm)"
    by (induction l) (auto split: Error_Monad.bind_splits)

  primrec efold :: "('a \<Rightarrow> 's \<Rightarrow> ('s,'e) error) \<Rightarrow> 'a list \<Rightarrow> 's \<Rightarrow> ('s,'e) error" where
    "efold f [] s = return s"
  | "efold f (x#xs) s = do {
      s \<leftarrow> f x s;
      efold f xs s
    }"

  lemma efold_mono[partial_function_mono]:
    fixes f :: "('c \<Rightarrow> ('d, 'e) error) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('b, 'e) error"
    assumes [partial_function_mono]: "\<And>x \<sigma>. mono_error (\<lambda>fa. f fa x \<sigma>)"
    shows "mono_error (\<lambda>x. efold (f x) l \<sigma>)"
    apply (induction l arbitrary: \<sigma>)
    apply simp
    apply (tactic \<open>Partial_Function.mono_tac @{context} 1\<close>)
    apply simp
    apply (rule bind_mono)
    apply (tactic \<open>Partial_Function.mono_tac @{context} 1\<close>)
    .

  lemma efold_cong[fundef_cong]: "\<lbrakk>a=b; xs=ys; \<And>x. x\<in>set ys \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> efold f xs a = efold g ys b"
    by (induction xs arbitrary: ys a b) (auto split: Error_Monad.bind_splits)

  lemma efold_nontermD: "is_nonterm (efold f l s) \<Longrightarrow> \<exists>x s. is_nonterm (f x s)"
    apply (induction l arbitrary: s) by auto

  lemma efold_nontermD': "efold f l s = ENonterm
    \<Longrightarrow> \<exists>x\<in>set l. \<exists>s. f x s = ENonterm"
    by (induction l arbitrary: s) (auto split: Error_Monad.bind_splits)

  lemma efold_return_unit_simp[simp]:
    "efold f l s = return () \<longleftrightarrow> (\<forall>x\<in>set l. f x () = return ())"
    by (induction l) (auto split: Error_Monad.bind_splits)

  lemma efold_unit_setI[e_vcg]:
    assumes "\<And>x. x\<in>set l \<Longrightarrow> e_spec (\<lambda>_. True) E T (f x ())"
    shows "e_spec (\<lambda>_. True) E T (efold f l ())"
      using assms
    apply (induction l)
    apply (auto simp: pw_espec_iff)
    done

  definition elookup :: "('k \<Rightarrow> 'e) \<Rightarrow> ('k \<rightharpoonup> 'v) \<Rightarrow> 'k \<Rightarrow> ('v,'e) error" where
    "elookup E m k \<equiv> case m k of None \<Rightarrow> EAssert (E k) | Some v \<Rightarrow> return v"

  lemma ellokup_eq_return_simp[simp]: "elookup E m k = return v \<longleftrightarrow> m k = Some v"
    by (auto simp: elookup_def split: option.split)

  lemma elookup_succ_iff[simp]: "m k = Some v \<Longrightarrow> elookup E m k = return v"   by simp

  lemma elookup_term[simp]: "elookup e m k \<noteq> ENonterm"
    by (auto simp: elookup_def split: option.splits)

  definition map_error :: "('e \<Rightarrow> 'f) \<Rightarrow> ('a,'e) error \<Rightarrow> ('a,'f) error" where
    "map_error f m \<equiv> case m of
      return x \<Rightarrow> return x
    | EAssert e \<Rightarrow> EAssert (f e)
    | ENonterm \<Rightarrow> ENonterm"

  lemma map_error_spec[e_vcg]:
    assumes "e_spec P (\<lambda>e. E (f e)) T m"
    shows "e_spec P E T (map_error f m)"
    using assms
    apply (cases m)
    apply (auto simp: map_error_def)
    done

  abbreviation (input) e_then (infixr "#>" 54) where "e_then f g \<equiv> \<lambda>x. Error_Monad.bind (f x) g"

  subsection \<open>Link to Option Monad\<close>
  fun e2o :: "('a,'e) error \<Rightarrow> 'a option" where
    "e2o (return x) = Some x"
  | "e2o _ = None"

  definition o2e :: "'e \<Rightarrow> ('a option) \<Rightarrow> ('a,'e) error" where
    "o2e e m \<equiv> case m of Some v \<Rightarrow> return v | None \<Rightarrow> EAssert e"

  lemma o2e_term[simp]: "o2e e m \<noteq> ENonterm"
    by (auto simp: o2e_def split: option.splits)

  subsection \<open>Regression Test\<close>
  context begin

  private partial_function (error) foo :: "nat \<Rightarrow> (nat,string) error" where
    "foo i = (case i of 0 \<Rightarrow> return 1 | (Suc n) \<Rightarrow> do {
      m \<leftarrow> foo n;
      return (Suc m)
    })"

  end

end


theory ContainedClassSetField
  imports
    Main
    "Ecore-GROOVE-Mapping.Type_Model_Graph_Mapping"
    "Ecore-GROOVE-Mapping.Identifier_List"
begin

section "Definition of a type model which introduces a field typed by a set of contained objects."

definition tmod_contained_class_set_field :: "'t Id \<Rightarrow> 't \<Rightarrow> 't Id \<Rightarrow> multiplicity \<Rightarrow> 't type_model" where
  "tmod_contained_class_set_field classtype name containedtype mul = \<lparr>
    Class = {classtype, containedtype},
    Enum = {},
    UserDataType = {},
    Field = {(classtype, name)},
    FieldSig = (\<lambda>x. if x = (classtype, name) then (setof \<exclamdown>containedtype, mul) else undefined),
    EnumValue = {},
    Inh = {},
    Prop = {containment (classtype, name)},
    Constant = {},
    ConstType = (\<lambda>x. undefined)
  \<rparr>"

lemma tmod_contained_class_set_field_correct:
  assumes valid_ns: "\<not>id_in_ns containedtype (Identifier classtype) \<and> \<not>id_in_ns classtype (Identifier containedtype)"
  assumes valid_mul: "multiplicity mul"
  shows "type_model (tmod_contained_class_set_field classtype name containedtype mul)"
proof (intro type_model.intro)
  fix f
  assume "f \<in> Field (tmod_contained_class_set_field classtype name containedtype mul)"
  then have "f = (classtype, name)"
    unfolding tmod_contained_class_set_field_def
    by simp
  then have "FieldSig (tmod_contained_class_set_field classtype name containedtype mul) f = (setof \<exclamdown>containedtype, mul)"
    unfolding tmod_contained_class_set_field_def
    by simp
  then show "fst (FieldSig (tmod_contained_class_set_field classtype name containedtype mul) f) \<in> Type (tmod_contained_class_set_field classtype name containedtype mul) \<and>
    multiplicity (snd (FieldSig (tmod_contained_class_set_field classtype name containedtype mul) f))"
  proof (intro conjI)
    assume "FieldSig (tmod_contained_class_set_field classtype name containedtype mul) f = (setof \<exclamdown>containedtype, mul)"
    then have contained_type_def: "fst (FieldSig (tmod_contained_class_set_field classtype name containedtype mul) f) = setof \<exclamdown>containedtype"
      by simp
    have "\<exclamdown>containedtype \<in> NonContainerType (tmod_contained_class_set_field classtype name containedtype mul)"
      unfolding NonContainerType_def ClassType_def
      by (simp add: ProperClassType.rule_proper_classes tmod_contained_class_set_field_def)
    then show "fst (FieldSig (tmod_contained_class_set_field classtype name containedtype mul) f) \<in> Type (tmod_contained_class_set_field classtype name containedtype mul)"
      unfolding Type_def
      using contained_type_def
      by (simp add: ContainerType.rule_setof_type tmod_contained_class_set_field_def)
  next
    assume "FieldSig (tmod_contained_class_set_field classtype name containedtype mul) f = (setof \<exclamdown>containedtype, mul)"
    then have snd_def: "snd (FieldSig (tmod_contained_class_set_field classtype name containedtype mul) f) = mul"
      by simp
    then show "multiplicity (snd (FieldSig (tmod_contained_class_set_field classtype name containedtype mul) f))"
      using valid_mul
      by simp
  qed
next
  fix p
  assume "p \<in> Prop (tmod_contained_class_set_field classtype name containedtype mul)"
  then have p_def: "p = containment (classtype, name)"
    unfolding tmod_contained_class_set_field_def
    by simp
  have "containment (classtype, name) \<in> Property (tmod_contained_class_set_field classtype name containedtype mul)"
  proof (intro Property.containment_property)
    have "(classtype, name) \<in> Attr (tmod_contained_class_set_field classtype name containedtype mul) \<Longrightarrow> False"
    proof-
      assume "(classtype, name) \<in> Attr (tmod_contained_class_set_field classtype name containedtype mul)"
      then have "Type_Model.type (tmod_contained_class_set_field classtype name containedtype mul) (classtype, name) \<in> AttrType (tmod_contained_class_set_field classtype name containedtype mul)"
        unfolding Attr_def
        by simp
      then have "setof \<exclamdown>containedtype \<in> AttrType (tmod_contained_class_set_field classtype name containedtype mul)"
        unfolding Type_Model.type_def tmod_contained_class_set_field_def
        by simp
      then show "False"
      proof (cases)
        case rule_setof_attributes
        then show ?thesis
          by (cases) (simp_all add: DataType_def)
      qed (simp_all add: DataType_def)
    qed
    then show "(classtype, name) \<in> Rel (tmod_contained_class_set_field classtype name containedtype mul)"
      unfolding Rel_def tmod_contained_class_set_field_def
      by fastforce
  qed
  then show "p \<in> Property (tmod_contained_class_set_field classtype name containedtype mul)"
    using p_def
    by simp
next
  fix x y
  assume "x \<in> Class (tmod_contained_class_set_field classtype name containedtype mul) \<union>
    Enum (tmod_contained_class_set_field classtype name containedtype mul) \<union>
    UserDataType (tmod_contained_class_set_field classtype name containedtype mul)"
  then have x_def: "x = classtype \<or> x = containedtype"
    unfolding tmod_contained_class_set_field_def
    by simp
  assume "y \<in> Class (tmod_contained_class_set_field classtype name containedtype mul) \<union>
    Enum (tmod_contained_class_set_field classtype name containedtype mul) \<union>
    UserDataType (tmod_contained_class_set_field classtype name containedtype mul)"
  then have y_def: "y = classtype \<or> y = containedtype"
    unfolding tmod_contained_class_set_field_def
    by simp
  show "\<not>id_in_ns x (Identifier y)"
    using x_def y_def valid_ns
    by fastforce
next
  have "asym {} \<and> irrefl {}"
    by (simp add: asym.intros irrefl_def)
  then show "asym (Inh (tmod_contained_class_set_field classtype name containedtype mul)) \<and> irrefl ((Inh (tmod_contained_class_set_field classtype name containedtype mul))\<^sup>+)"
    unfolding tmod_contained_class_set_field_def
    by simp
next
  fix f
  assume assump: "f \<in> Field (tmod_contained_class_set_field classtype name containedtype mul) \<and>
    Type_Model.type (tmod_contained_class_set_field classtype name containedtype mul) f \<in> DataType \<union>
      EnumType (tmod_contained_class_set_field classtype name containedtype mul) \<union>
      UserDataTypeType (tmod_contained_class_set_field classtype name containedtype mul) \<union>
      ProperClassType (tmod_contained_class_set_field classtype name containedtype mul)"
  then have "f = (classtype, name)"
    unfolding tmod_contained_class_set_field_def
    by simp
  then have "Type_Model.type (tmod_contained_class_set_field classtype name containedtype mul) f = setof \<exclamdown>containedtype"
    unfolding Type_Model.type_def tmod_contained_class_set_field_def
    by simp
  then show "lower (tmod_contained_class_set_field classtype name containedtype mul) f = \<^bold>1"
    using assump
    by simp
next
  fix f
  assume assump: "f \<in> Field (tmod_contained_class_set_field classtype name containedtype mul) \<and>
    Type_Model.type (tmod_contained_class_set_field classtype name containedtype mul) f \<in> NullableClassType (tmod_contained_class_set_field classtype name containedtype mul)"
  then have "f = (classtype, name)"
    unfolding tmod_contained_class_set_field_def
    by simp
  then have "Type_Model.type (tmod_contained_class_set_field classtype name containedtype mul) f = setof \<exclamdown>containedtype"
    unfolding Type_Model.type_def tmod_contained_class_set_field_def
    by simp
  then show "lower (tmod_contained_class_set_field classtype name containedtype mul) f = \<^bold>0"
    using assump
    by simp
next
  fix f
  assume assump: "f \<in> Field (tmod_contained_class_set_field classtype name containedtype mul) \<and>
    Type_Model.type (tmod_contained_class_set_field classtype name containedtype mul) f \<in> NonContainerType (tmod_contained_class_set_field classtype name containedtype mul)"
  then have "f = (classtype, name)"
    unfolding tmod_contained_class_set_field_def
    by simp
  then have "Type_Model.type (tmod_contained_class_set_field classtype name containedtype mul) f = setof \<exclamdown>containedtype"
    unfolding Type_Model.type_def tmod_contained_class_set_field_def
    by simp
  then show "upper (tmod_contained_class_set_field classtype name containedtype mul) f = \<^bold>1"
    using assump
    by simp
qed (simp_all add: tmod_contained_class_set_field_def)

lemma tmod_contained_class_set_field_combine_correct:
  assumes "type_model Tmod"
  assumes existing_classes: "{classtype, containedtype} \<subseteq> Class Tmod"
  assumes new_field: "(classtype, name) \<notin> Field Tmod"
  assumes valid_ns: "\<not>id_in_ns containedtype (Identifier classtype) \<and> \<not>id_in_ns classtype (Identifier containedtype)"
  assumes valid_mul: "multiplicity mul"
  shows "type_model (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul))"
proof (intro tmod_combine_merge_correct)
  show "type_model (tmod_contained_class_set_field classtype name containedtype mul)"
    using valid_ns valid_mul
    by (fact tmod_contained_class_set_field_correct)
next
  fix c
  assume "c \<in> Class (tmod_contained_class_set_field classtype name containedtype mul)"
  then have "c \<in> Class Tmod"
    unfolding tmod_contained_class_set_field_def
    using existing_classes
    by fastforce
  then show "c \<notin> Enum Tmod \<and> c \<notin> UserDataType Tmod"
    using assms(1) type_model.property_class_disjoint
    by blast
next
  fix e
  assume "e \<in> Enum Tmod"
  then have "e \<noteq> classtype \<and> e \<noteq> containedtype"
    using assms(1) existing_classes type_model.property_enum_disjoint
    by blast
  then show "e \<notin> Class (tmod_contained_class_set_field classtype name containedtype mul) \<and> e \<notin> UserDataType (tmod_contained_class_set_field classtype name containedtype mul)"
    unfolding tmod_contained_class_set_field_def
    by simp
next
  fix x y
  assume x_def: "x \<in> Class Tmod \<union> Enum Tmod \<union> UserDataType Tmod"
  assume "y \<in> Class (tmod_contained_class_set_field classtype name containedtype mul) \<union> Enum (tmod_contained_class_set_field classtype name containedtype mul) \<union> UserDataType (tmod_contained_class_set_field classtype name containedtype mul)"
  then have y_def: "y \<in> Class Tmod \<union> Enum Tmod \<union> UserDataType Tmod"
    unfolding tmod_contained_class_set_field_def
    using existing_classes
    by fastforce
  show "\<not>id_in_ns x (Identifier y)"
    using x_def y_def assms(1) type_model.property_namespace_restriction
    by blast
  show "\<not>id_in_ns y (Identifier x)"
    using x_def y_def assms(1) type_model.property_namespace_restriction
    by blast
next
  have "irrefl ((Inh Tmod)\<^sup>+)"
    using assms(1) type_model.property_inh_wellformed_trancl_irrefl
    by blast
  then show "irrefl ((Inh Tmod \<union> Inh (tmod_contained_class_set_field classtype name containedtype mul))\<^sup>+)"
    unfolding tmod_contained_class_set_field_def
    by simp
next
  have inh_wellformed_classes: "\<And>c. c \<in> Inh (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul)) \<Longrightarrow>
    fst c \<in> Class (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul)) \<and> snd c \<in> Class (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul))"
  proof
    fix c
    assume "c \<in> Inh (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul))"
    then have c_def: "c \<in> Inh Tmod"
      unfolding tmod_combine_def tmod_contained_class_set_field_def
      by simp
    have "fst c \<in> Class Tmod"
      using c_def assms(1) type_model.structure_inh_wellformed_fst_class
      by blast
    then show "fst c \<in> Class (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul))"
      unfolding tmod_combine_def
      by simp
    have "snd c \<in> Class Tmod"
      using c_def assms(1) type_model.structure_inh_wellformed_snd_class
      by blast
    then show "snd c \<in> Class (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul))"
      unfolding tmod_combine_def
      by simp
  qed
  fix c1 c2 A B
  assume "identity c1 A \<in> tmod_combine_prop Tmod (tmod_contained_class_set_field classtype name containedtype mul)"
  then have "identity c1 A \<in> Prop Tmod"
  proof (cases)
    case identity_property_tmod1
    then show ?thesis
      by blast
  next
    case identity_property_tmod2
    then show ?thesis
      unfolding tmod_contained_class_set_field_def
      by simp
  next
    case identity_property_both
    then show ?thesis
      unfolding tmod_contained_class_set_field_def
      by simp
  qed
  assume "identity c2 B \<in> tmod_combine_prop Tmod (tmod_contained_class_set_field classtype name containedtype mul)"
  then have "identity c2 B \<in> Prop Tmod"
  proof (cases)
    case identity_property_tmod1
    then show ?thesis
      by blast
  next
    case identity_property_tmod2
    then show ?thesis
      unfolding tmod_contained_class_set_field_def
      by simp
  next
    case identity_property_both
    then show ?thesis
      unfolding tmod_contained_class_set_field_def
      by simp
  qed
  assume c1_c2_neq: "c1 \<noteq> c2"
  assume not_extend_tmod: "\<not>\<exclamdown>c1 \<sqsubseteq>[Tmod] \<exclamdown>c2"
  assume "\<exclamdown>c1 \<sqsubseteq>[tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul)] \<exclamdown>c2"
  then have "(\<exclamdown>c1, \<exclamdown>c2) \<in> subtype_rel_altdef (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul))"
    unfolding subtype_def
    using inh_wellformed_classes subtype_rel_alt
    by blast
  then have "(\<exclamdown>c1, \<exclamdown>c2) \<in> subtype_tuple ` Type (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul)) \<union>
    subtype_conv nullable nullable ` (Inh (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul)))\<^sup>+ \<union>
    subtype_conv proper proper ` (Inh (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul)))\<^sup>+ \<union>
    subtype_conv proper nullable ` subtype_tuple ` Class (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul)) \<union>
    subtype_conv proper nullable ` (Inh (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul)))\<^sup>+"
    unfolding subtype_rel_altdef_def
    by simp
  then have "(\<exclamdown>c1, \<exclamdown>c2) \<in> subtype_rel_altdef Tmod"
  proof (elim UnE)
    assume "(\<exclamdown>c1, \<exclamdown>c2) \<in> subtype_tuple ` Type (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul))"
    then have "c1 = c2"
      unfolding subtype_tuple_def
      by blast
    then show ?thesis
      using c1_c2_neq
      by blast
  next
    assume "(\<exclamdown>c1, \<exclamdown>c2) \<in> subtype_conv nullable nullable ` (Inh (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul)))\<^sup>+"
    then show ?thesis
      unfolding subtype_conv_def
      by blast
  next
    assume "(\<exclamdown>c1, \<exclamdown>c2) \<in> subtype_conv proper proper ` (Inh (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul)))\<^sup>+"
    then have "(\<exclamdown>c1, \<exclamdown>c2) \<in> subtype_conv proper proper ` (Inh Tmod)\<^sup>+"
      unfolding tmod_combine_def tmod_contained_class_set_field_def
      by simp
    then show ?thesis
      unfolding subtype_rel_altdef_def
      by blast
  next
    assume "(\<exclamdown>c1, \<exclamdown>c2) \<in> subtype_conv proper nullable ` subtype_tuple ` Class (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul))"
    then show ?thesis
      unfolding subtype_conv_def
      by blast
  next
    assume "(\<exclamdown>c1, \<exclamdown>c2) \<in> subtype_conv proper nullable ` (Inh (tmod_combine Tmod (tmod_contained_class_set_field classtype name containedtype mul)))\<^sup>+"
    then show ?thesis
      unfolding subtype_conv_def
      by blast
  qed
  then have "\<exclamdown>c1 \<sqsubseteq>[Tmod] \<exclamdown>c2"
    unfolding subtype_def
    by (simp add: assms(1) subtype_rel_alt type_model.structure_inh_wellformed_classes)
  then show "A \<subseteq> B"
    using not_extend_tmod
    by blast
qed (simp_all add: assms tmod_contained_class_set_field_def)

section "Encoding of a class-typed field as edge type in GROOVE"

definition tg_contained_class_set_field_as_edge_type :: "'t Id \<Rightarrow> 't \<Rightarrow> 't Id \<Rightarrow> multiplicity \<Rightarrow> ('t list) type_graph" where
  "tg_contained_class_set_field_as_edge_type classtype name containedtype mul = \<lparr>
    NT = {type (id_to_list classtype), type (id_to_list containedtype)},
    ET = {(type (id_to_list classtype), edge [name], type (id_to_list containedtype))},
    inh = {(type (id_to_list classtype), type (id_to_list classtype)), (type (id_to_list containedtype), type (id_to_list containedtype))},
    abs = {},
    mult = (\<lambda>x. if x = (type (id_to_list classtype), edge [name], type (id_to_list containedtype)) then (\<^bold>0..\<^bold>1, mul) else undefined),
    contains = {(type (id_to_list classtype), edge [name], type (id_to_list containedtype))}
  \<rparr>"

lemma tg_contained_class_set_field_as_edge_type_correct:
  assumes valid_mul: "multiplicity mul"
  shows "type_graph (tg_contained_class_set_field_as_edge_type classtype name containedtype mul)"
proof (intro type_graph.intro)
  fix n
  assume "n \<in> NT (tg_contained_class_set_field_as_edge_type classtype name containedtype mul)"
  then have "n = type (id_to_list classtype) \<or> n = type (id_to_list containedtype)"
    unfolding tg_contained_class_set_field_as_edge_type_def
    by simp
  then show "n \<in> Lab\<^sub>t \<union> Lab\<^sub>p"
    using Lab\<^sub>t.rule_type_labels
    by fastforce
next
  fix s l t
  assume "(s, l, t) \<in> ET (tg_contained_class_set_field_as_edge_type classtype name containedtype mul)"
  then have "(s, l, t) = (type (id_to_list classtype), edge [name], type (id_to_list containedtype))"
    unfolding tg_contained_class_set_field_as_edge_type_def
    by simp
  then have "s \<in> {type (id_to_list classtype), type (id_to_list containedtype)} \<and> l \<in> Lab\<^sub>e \<union> Lab\<^sub>f \<and> t \<in> {type (id_to_list classtype), type (id_to_list containedtype)}"
  proof (intro conjI)
    assume "(s, l, t) = (type (id_to_list classtype), edge [name], type (id_to_list containedtype))"
    then show "l \<in> Lab\<^sub>e \<union> Lab\<^sub>f"
      using Lab\<^sub>e.rule_edge_labels
      by fastforce
  qed (simp_all)
  then show "s \<in> NT (tg_contained_class_set_field_as_edge_type classtype name containedtype mul) \<and> l \<in> Lab\<^sub>e \<union> Lab\<^sub>f \<and> t \<in> NT (tg_contained_class_set_field_as_edge_type classtype name containedtype mul)"
    unfolding tg_contained_class_set_field_as_edge_type_def
    by simp
next
  show "Relation.Field (inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul)) = NT (tg_contained_class_set_field_as_edge_type classtype name containedtype mul)"
    unfolding Relation.Field_def tg_contained_class_set_field_as_edge_type_def
    by simp
next
  fix e
  assume "e \<in> ET (tg_contained_class_set_field_as_edge_type classtype name containedtype mul)"
  then have "mult (tg_contained_class_set_field_as_edge_type classtype name containedtype mul) e = (\<^bold>0..\<^bold>1, mul)"
    unfolding tg_contained_class_set_field_as_edge_type_def
    by simp
  then show "multiplicity_pair (mult (tg_contained_class_set_field_as_edge_type classtype name containedtype mul) e)"
  proof (intro multiplicity_pair.intro)
    assume mult_e_def: "mult (tg_contained_class_set_field_as_edge_type classtype name containedtype mul) e = (\<^bold>0..\<^bold>1, mul)"
    show "multiplicity (m_in (mult (tg_contained_class_set_field_as_edge_type classtype name containedtype mul) e))"
      using mult_e_def
      by (intro multiplicity.intro) (simp_all)
    show "multiplicity (m_out (mult (tg_contained_class_set_field_as_edge_type classtype name containedtype mul) e))"
      using valid_mul mult_e_def
      by simp
  qed
next
  show "Partial_order (inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))"
    unfolding tg_contained_class_set_field_as_edge_type_def partial_order_on_def preorder_on_def refl_on_def antisym_def trans_def
    by simp
qed (simp_all add: tg_contained_class_set_field_as_edge_type_def)

lemma tg_contained_class_set_field_as_edge_type_combine_correct:
  assumes "type_graph TG"
  assumes existing_node_types: "{type (id_to_list classtype), type (id_to_list containedtype)} \<subseteq> NT TG"
  assumes new_edge_type: "\<And>s l t. (s, type (id_to_list classtype)) \<in> inh TG \<or> (type (id_to_list classtype), s) \<in> inh TG \<Longrightarrow> l = edge [name] \<Longrightarrow> (s, l, t) \<notin> ET TG"
  assumes valid_mul: "multiplicity mul"
  shows "type_graph (tg_combine TG (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))"
proof (intro tg_combine_merge_correct)
  show "type_graph (tg_contained_class_set_field_as_edge_type classtype name containedtype mul)"
    using valid_mul
    by (fact tg_contained_class_set_field_as_edge_type_correct)
next
  show "ET TG \<inter> ET (tg_contained_class_set_field_as_edge_type classtype name containedtype mul) = {}"
    unfolding tg_contained_class_set_field_as_edge_type_def
    using assms(1) existing_node_types new_edge_type type_graph.validity_inh_node
    by fastforce
next
  fix l s1 t1 s2 t2
  assume e1_def: "(s1, l, t1) \<in> ET TG"
  assume e2_def: "(s2, l, t2) \<in> ET TG"
  assume "(s1, s2) \<in> (inh TG \<union> inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))\<^sup>+ - inh TG \<or> (s2, s1) \<in> (inh TG \<union> inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))\<^sup>+ - inh TG"
  then have "(s1, s2) \<in> (inh TG)\<^sup>+ - inh TG \<or> (s2, s1) \<in> (inh TG)\<^sup>+ - inh TG"
    using Un_absorb2 assms(1) type_graph.validity_inh_node existing_node_types insert_subset sup.orderI sup_bot.right_neutral tg_contained_class_set_field_as_edge_type_def type_graph.simps(3)
    by metis
  then have src_inh: "(s1, s2) \<in> inh TG - inh TG \<or> (s2, s1) \<in> inh TG - inh TG"
    by (simp add: assms(1) type_graph.validity_inh_trans)
  assume "(t1, t2) \<in> (inh TG \<union> inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))\<^sup>+ \<or> (t2, t1) \<in> (inh TG \<union> inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))\<^sup>+"
  show "s1 = s2 \<and> t1 = t2"
    using src_inh
    by blast
next
  fix l s1 t1 s2 t2
  assume e1_def: "(s1, l, t1) \<in> ET TG"
  assume e2_def: "(s2, l, t2) \<in> ET TG"
  assume "(s1, s2) \<in> (inh TG \<union> inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))\<^sup>+ \<or> (s2, s1) \<in> (inh TG \<union> inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))\<^sup>+"
  assume "(t1, t2) \<in> (inh TG \<union> inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))\<^sup>+ - inh TG \<or> (t2, t1) \<in> (inh TG \<union> inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))\<^sup>+ - inh TG"
  then have "(t1, t2) \<in> (inh TG)\<^sup>+ - inh TG \<or> (t2, t1) \<in> (inh TG)\<^sup>+ - inh TG"
    using Un_absorb2 assms(1) type_graph.validity_inh_node existing_node_types insert_subset sup.orderI sup_bot.right_neutral tg_contained_class_set_field_as_edge_type_def type_graph.simps(3)
    by metis
  then have tgt_inh: "(t1, t2) \<in> inh TG - inh TG \<or> (t2, t1) \<in> inh TG - inh TG"
    by (simp add: assms(1) type_graph.validity_inh_trans)
  show "s1 = s2 \<and> t1 = t2"
    using tgt_inh
    by blast
next
  fix l s1 t1 s2 t2
  assume e1_def: "(s1, l, t1) \<in> ET TG"
  assume "(s2, l, t2) \<in> ET (tg_contained_class_set_field_as_edge_type classtype name containedtype mul)"
  then have e2_def: "(s2, l, t2) = (type (id_to_list classtype), edge [name], type (id_to_list containedtype))"
    unfolding tg_contained_class_set_field_as_edge_type_def
    by simp
  then have l_def: "l = edge [name]"
    by blast
  assume "(s1, s2) \<in> (inh TG \<union> inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))\<^sup>+ \<or> (s2, s1) \<in> (inh TG \<union> inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))\<^sup>+"
  then have "(s1, s2) \<in> (inh TG)\<^sup>+ \<or> (s2, s1) \<in> (inh TG)\<^sup>+"
    using Un_absorb2 assms(1) type_graph.validity_inh_node existing_node_types insert_subset sup.orderI sup_bot.right_neutral tg_contained_class_set_field_as_edge_type_def type_graph.simps(3)
    by metis
  then have src_inh: "(s1, s2) \<in> inh TG \<or> (s2, s1) \<in> inh TG"
    by (simp add: assms(1) type_graph.validity_inh_trans)
  then show "s1 = s2 \<and> t1 = t2"
    using e1_def e2_def new_edge_type
    by simp
next
  have "antisym ((inh TG)\<^sup>+)"
    by (simp add: assms(1) type_graph.validity_inh_antisym type_graph.validity_inh_trans)
  then show "antisym ((inh TG \<union> inh (tg_contained_class_set_field_as_edge_type classtype name containedtype mul))\<^sup>+)"
    using Un_absorb2 assms(1) type_graph.validity_inh_node existing_node_types insert_subset sup.orderI sup_bot.right_neutral tg_contained_class_set_field_as_edge_type_def type_graph.simps(3)
    by metis
qed (simp_all add: tg_contained_class_set_field_as_edge_type_def assms)

subsection "Transformation functions"

definition tmod_contained_class_set_field_to_tg_contained_class_set_field_as_edge_type :: "'t Id \<Rightarrow> multiplicity \<Rightarrow> 't type_model \<Rightarrow> ('t list) type_graph" where
  "tmod_contained_class_set_field_to_tg_contained_class_set_field_as_edge_type containedtype mul Tmod = \<lparr>
    NT = type ` id_to_list ` Class Tmod,
    ET = (\<lambda>x. (type (id_to_list (fst x)), edge [(snd x)], type (id_to_list containedtype))) ` Field Tmod,
    inh = (\<lambda>x. (x, x)) ` type ` id_to_list ` Class Tmod,
    abs = {},
    mult = (\<lambda>x. if x \<in> (\<lambda>x. (type (id_to_list (fst x)), edge [(snd x)], type (id_to_list containedtype))) ` Field Tmod then (\<^bold>0..\<^bold>1, mul) else undefined),
    contains = (\<lambda>x. (type (id_to_list (fst x)), edge [(snd x)], type (id_to_list containedtype))) ` Field Tmod
  \<rparr>"

lemma tmod_contained_class_set_field_to_tg_contained_class_set_field_as_edge_type_proj:
  shows "tmod_contained_class_set_field_to_tg_contained_class_set_field_as_edge_type containedtype mul (tmod_contained_class_set_field classtype name containedtype mul) =
    tg_contained_class_set_field_as_edge_type classtype name containedtype mul"
  unfolding tmod_contained_class_set_field_to_tg_contained_class_set_field_as_edge_type_def tmod_contained_class_set_field_def tg_contained_class_set_field_as_edge_type_def
  by simp

lemma tmod_contained_class_set_field_to_tg_contained_class_set_field_as_edge_type_func:
  shows "tg_combine_mapping_function (tmod_contained_class_set_field_to_tg_contained_class_set_field_as_edge_type containedtype mul)
    (tmod_contained_class_set_field classtype name containedtype mul) (tg_contained_class_set_field_as_edge_type classtype name containedtype mul)"
  by (intro tg_combine_mapping_function.intro)
    (simp_all add: tmod_contained_class_set_field_to_tg_contained_class_set_field_as_edge_type_def tmod_contained_class_set_field_def tg_contained_class_set_field_as_edge_type_def tmod_combine_def)

definition tg_contained_class_set_field_as_edge_type_to_tmod_contained_class_set_field :: "'t Id \<Rightarrow> multiplicity \<Rightarrow> ('t list) type_graph \<Rightarrow> 't type_model" where
  "tg_contained_class_set_field_as_edge_type_to_tmod_contained_class_set_field containedtype mul TG = \<lparr>
    Class = list_to_id ` unlabel ` NT TG,
    Enum = {},
    UserDataType = {},
    Field = (\<lambda>x. (list_to_id (unlabel (src x)), last (unlabel (lab x)))) ` ET TG,
    FieldSig = (\<lambda>x. if x \<in> (\<lambda>x. (list_to_id (unlabel (src x)), last (unlabel (lab x)))) ` ET TG then (setof \<exclamdown>containedtype, mul) else undefined),
    EnumValue = {},
    Inh = {},
    Prop = containment ` (\<lambda>x. (list_to_id (unlabel (src x)), last (unlabel (lab x)))) ` ET TG,
    Constant = {},
    ConstType = (\<lambda>x. undefined)
  \<rparr>"

lemma tg_contained_class_set_field_as_edge_type_to_tmod_contained_class_set_field_proj:
  shows "tg_contained_class_set_field_as_edge_type_to_tmod_contained_class_set_field containedtype mul (tg_contained_class_set_field_as_edge_type classtype name containedtype mul) =
    tmod_contained_class_set_field classtype name containedtype mul"
  unfolding tg_contained_class_set_field_as_edge_type_to_tmod_contained_class_set_field_def tmod_contained_class_set_field_def tg_contained_class_set_field_as_edge_type_def
  by (simp add: id_to_list_inverse)

lemma tg_contained_class_set_field_as_edge_type_to_tmod_contained_class_set_field_func:
  shows "tmod_combine_mapping_function (tg_contained_class_set_field_as_edge_type_to_tmod_contained_class_set_field containedtype mul)
    (tg_contained_class_set_field_as_edge_type classtype name containedtype mul) (tmod_contained_class_set_field classtype name containedtype mul)"
  by (intro tmod_combine_mapping_function.intro)
    (simp_all add: tg_contained_class_set_field_as_edge_type_to_tmod_contained_class_set_field_def tmod_contained_class_set_field_def tg_contained_class_set_field_as_edge_type_def tg_combine_def id_to_list_inverse)

end


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

(*header{*The n_german Protocol Case Study*}*)

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end


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

header{*The n_german Protocol Case Study*}

theory n_german_lemma_on_inv__50 imports n_german_base
begin
section{*All lemmas on causal relation between inv__50 and some rule r*}
lemma n_RecvReqSVsinv__50:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)" and
a2: "(\<exists> p__Inv1 p__Inv2. p__Inv1\<le>N\<and>p__Inv2\<le>N\<and>p__Inv1~=p__Inv2\<and>f=inv__50  p__Inv1 p__Inv2)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvReqS N i" apply fastforce done
from a2 obtain p__Inv1 p__Inv2 where a2:"p__Inv1\<le>N\<and>p__Inv2\<le>N\<and>p__Inv1~=p__Inv2\<and>f=inv__50  p__Inv1 p__Inv2" apply fastforce done
have "(i=p__Inv2)\<or>(i=p__Inv1)\<or>(i~=p__Inv1\<and>i~=p__Inv2)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv2)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (andForm (eqn (IVar (Para (Ident ''ShrSet'') p__Inv2)) (Const true)) (eqn (IVar (Ident ''ExGntd'')) (Const true))) (eqn (IVar (Para (Ident ''ShrSet'') p__Inv1)) (Const true))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv1)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (andForm (eqn (IVar (Para (Ident ''ShrSet'') p__Inv2)) (Const true)) (eqn (IVar (Ident ''ExGntd'')) (Const true))) (eqn (IVar (Para (Ident ''ShrSet'') p__Inv1)) (Const true))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv1\<and>i~=p__Inv2)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (andForm (eqn (IVar (Para (Ident ''ShrSet'') p__Inv2)) (Const true)) (eqn (IVar (Ident ''ExGntd'')) (Const true))) (eqn (IVar (Para (Ident ''ShrSet'') p__Inv1)) (Const true))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

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

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

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

lemma n_RecvInvAckVsinv__50:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)" and
a2: "(\<exists> p__Inv1 p__Inv2. p__Inv1\<le>N\<and>p__Inv2\<le>N\<and>p__Inv1~=p__Inv2\<and>f=inv__50  p__Inv1 p__Inv2)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvInvAck  i" apply fastforce done
from a2 obtain p__Inv1 p__Inv2 where a2:"p__Inv1\<le>N\<and>p__Inv2\<le>N\<and>p__Inv1~=p__Inv2\<and>f=inv__50  p__Inv1 p__Inv2" apply fastforce done
have "(i=p__Inv2)\<or>(i=p__Inv1)\<or>(i~=p__Inv1\<and>i~=p__Inv2)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv2)"
  have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i=p__Inv1)"
  have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i~=p__Inv1\<and>i~=p__Inv2)"
  have "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))\<or>((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Ident ''ExGntd'')) (Const true)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (neg (eqn (IVar (Ident ''ExGntd'')) (Const true))) s))"
    have "?P2 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

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

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

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

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

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

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

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

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

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

end


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

theory n_german_lemma_inv__45_on_rules imports n_german_lemma_on_inv__45
begin
section{*All lemmas on causal relation between inv__45*}
lemma lemma_inv__45_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__45  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqEI  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqES  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReq N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvE  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)\<or>
    (\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> j. j\<le>N\<and>r=n_SendReqS  j)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendReqSVsinv__45) done
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

end