(*  Title:      HOL/Bali/TypeRel.thy
    Author:     David von Oheimb
*)
subsection {* The relations between Java types *}

theory TypeRel imports Decl begin

text {*
simplifications:
\begin{itemize}
\item subinterface, subclass and widening relation includes identity
\end{itemize}
improvements over Java Specification 1.0:
\begin{itemize}
\item narrowing reference conversion also in cases where the return types of a
      pair of methods common to both types are in widening (rather identity)
      relation
\item one could add similar constraints also for other cases
\end{itemize}
design issues:
\begin{itemize}
\item the type relations do not require @{text is_type} for their arguments
\item the subint1 and subcls1 relations imply @{text is_iface}/@{text is_class}
      for their first arguments, which is required for their finiteness
\end{itemize}
*}

(*subint1, in Decl.thy*)                     (* direct subinterface       *)
(*subint , by translation*)                  (* subinterface (+ identity) *)
(*subcls1, in Decl.thy*)                     (* direct subclass           *)
(*subcls , by translation*)                  (*        subclass           *)
(*subclseq, by translation*)                 (* subclass + identity       *)

definition
  implmt1 :: "prog \<Rightarrow> (qtname \<times> qtname) set" --{* direct implementation *}
  --{* direct implementation, cf. 8.1.3 *}
  where "implmt1 G = {(C,I). C\<noteq>Object \<and> (\<exists>c\<in>class G C: I\<in>set (superIfs c))}"

abbreviation
  subint1_syntax :: "prog => [qtname, qtname] => bool" ("_|-_<:I1_" [71,71,71] 70)
  where "G|-I <:I1 J == (I,J) \<in> subint1 G"

abbreviation
  subint_syntax :: "prog => [qtname, qtname] => bool" ("_|-_<=:I _"[71,71,71] 70)
  where "G|-I <=:I J == (I,J) \<in>(subint1 G)^*" --{* cf. 9.1.3 *}

abbreviation
  implmt1_syntax :: "prog => [qtname, qtname] => bool" ("_|-_~>1_"  [71,71,71] 70)
  where "G|-C ~>1 I == (C,I) \<in> implmt1 G"

notation (xsymbols)
  subint1_syntax  ("_\<turnstile>_\<prec>I1_"  [71,71,71] 70) and
  subint_syntax  ("_\<turnstile>_\<preceq>I _"  [71,71,71] 70) and
  implmt1_syntax   ("_\<turnstile>_\<leadsto>1_"  [71,71,71] 70)

subsubsection "subclass and subinterface relations"

  (* direct subinterface in Decl.thy, cf. 9.1.3 *)
  (* direct subclass     in Decl.thy, cf. 8.1.3 *)

lemmas subcls_direct = subcls1I [THEN r_into_rtrancl]

lemma subcls_direct1:
 "\<lbrakk>class G C = Some c; C \<noteq> Object;D=super c\<rbrakk> \<Longrightarrow> G\<turnstile>C\<preceq>\<^sub>C D"
apply (auto dest: subcls_direct)
done

lemma subcls1I1:
 "\<lbrakk>class G C = Some c; C \<noteq> Object;D=super c\<rbrakk> \<Longrightarrow> G\<turnstile>C\<prec>\<^sub>C1 D"
apply (auto dest: subcls1I)
done

lemma subcls_direct2:
 "\<lbrakk>class G C = Some c; C \<noteq> Object;D=super c\<rbrakk> \<Longrightarrow> G\<turnstile>C\<prec>\<^sub>C D"
apply (auto dest: subcls1I1)
done

lemma subclseq_trans: "\<lbrakk>G\<turnstile>A \<preceq>\<^sub>C B; G\<turnstile>B \<preceq>\<^sub>C C\<rbrakk> \<Longrightarrow> G\<turnstile>A \<preceq>\<^sub>C C"
by (blast intro: rtrancl_trans)

lemma subcls_trans: "\<lbrakk>G\<turnstile>A \<prec>\<^sub>C B; G\<turnstile>B \<prec>\<^sub>C C\<rbrakk> \<Longrightarrow> G\<turnstile>A \<prec>\<^sub>C C"
by (blast intro: trancl_trans)

lemma SXcpt_subcls_Throwable_lemma:
"\<lbrakk>class G (SXcpt xn) = Some xc;
  super xc = (if xn = Throwable then Object else  SXcpt Throwable)\<rbrakk>
\<Longrightarrow> G\<turnstile>SXcpt xn\<preceq>\<^sub>C SXcpt Throwable"
apply (case_tac "xn = Throwable")
apply  simp_all
apply (drule subcls_direct)
apply (auto dest: sym)
done

lemma subcls_ObjectI: "\<lbrakk>is_class G C; ws_prog G\<rbrakk> \<Longrightarrow> G\<turnstile>C\<preceq>\<^sub>C Object"
apply (erule ws_subcls1_induct)
apply clarsimp
apply (case_tac "C = Object")
apply  (fast intro: r_into_rtrancl [THEN rtrancl_trans])+
done

lemma subclseq_ObjectD [dest!]: "G\<turnstile>Object\<preceq>\<^sub>C C \<Longrightarrow> C = Object"
apply (erule rtrancl_induct)
apply  (auto dest: subcls1D)
done

lemma subcls_ObjectD [dest!]: "G\<turnstile>Object\<prec>\<^sub>C C \<Longrightarrow> False"
apply (erule trancl_induct)
apply  (auto dest: subcls1D)
done

lemma subcls_ObjectI1 [intro!]:
 "\<lbrakk>C \<noteq> Object;is_class G C;ws_prog G\<rbrakk> \<Longrightarrow> G\<turnstile>C \<prec>\<^sub>C Object"
apply (drule (1) subcls_ObjectI)
apply (auto intro: rtrancl_into_trancl3)
done

lemma subcls_is_class: "(C,D) \<in> (subcls1 G)^+ \<Longrightarrow> is_class G C"
apply (erule trancl_trans_induct)
apply (auto dest!: subcls1D)
done

lemma subcls_is_class2 [rule_format (no_asm)]:
 "G\<turnstile>C\<preceq>\<^sub>C D \<Longrightarrow> is_class G D \<longrightarrow> is_class G C"
apply (erule rtrancl_induct)
apply (drule_tac [2] subcls1D)
apply  auto
done

lemma single_inheritance:
"\<lbrakk>G\<turnstile>A \<prec>\<^sub>C1 B; G\<turnstile>A \<prec>\<^sub>C1 C\<rbrakk> \<Longrightarrow> B = C"
by (auto simp add: subcls1_def)

lemma subcls_compareable:
"\<lbrakk>G\<turnstile>A \<preceq>\<^sub>C X; G\<turnstile>A \<preceq>\<^sub>C Y
 \<rbrakk> \<Longrightarrow> G\<turnstile>X \<preceq>\<^sub>C Y \<or> G\<turnstile>Y \<preceq>\<^sub>C X"
by (rule triangle_lemma)  (auto intro: single_inheritance)

lemma subcls1_irrefl: "\<lbrakk>G\<turnstile>C \<prec>\<^sub>C1 D; ws_prog G \<rbrakk>
 \<Longrightarrow> C \<noteq> D"
proof
  assume ws: "ws_prog G" and
    subcls1: "G\<turnstile>C \<prec>\<^sub>C1 D" and
     eq_C_D: "C=D"
  from subcls1 obtain c
    where
      neq_C_Object: "C\<noteq>Object" and
              clsC: "class G C = Some c" and
           super_c: "super c = D"
    by (auto simp add: subcls1_def)
  with super_c subcls1 eq_C_D
  have subcls_super_c_C: "G\<turnstile>super c \<prec>\<^sub>C C"
    by auto
  from ws clsC neq_C_Object
  have "\<not> G\<turnstile>super c \<prec>\<^sub>C C"
    by (auto dest: ws_prog_cdeclD)
  from this subcls_super_c_C
  show "False"
    by (rule notE)
qed

lemma no_subcls_Object: "G\<turnstile>C \<prec>\<^sub>C D \<Longrightarrow> C \<noteq> Object"
by (erule converse_trancl_induct) (auto dest: subcls1D)

lemma subcls_acyclic: "\<lbrakk>G\<turnstile>C \<prec>\<^sub>C D; ws_prog G\<rbrakk> \<Longrightarrow> \<not> G\<turnstile>D \<prec>\<^sub>C C"
proof -
  assume         ws: "ws_prog G"
  assume subcls_C_D: "G\<turnstile>C \<prec>\<^sub>C D"
  then show ?thesis
  proof (induct rule: converse_trancl_induct)
    fix C
    assume subcls1_C_D: "G\<turnstile>C \<prec>\<^sub>C1 D"
    then obtain c  where
        "C\<noteq>Object" and
        "class G C = Some c" and
        "super c = D"
      by (auto simp add: subcls1_def)
    with ws
    show "\<not> G\<turnstile>D \<prec>\<^sub>C C"
      by (auto dest: ws_prog_cdeclD)
  next
    fix C Z
    assume subcls1_C_Z: "G\<turnstile>C \<prec>\<^sub>C1 Z" and
            subcls_Z_D: "G\<turnstile>Z \<prec>\<^sub>C D" and
           nsubcls_D_Z: "\<not> G\<turnstile>D \<prec>\<^sub>C Z"
    show "\<not> G\<turnstile>D \<prec>\<^sub>C C"
    proof
      assume subcls_D_C: "G\<turnstile>D \<prec>\<^sub>C C"
      show "False"
      proof -
        from subcls_D_C subcls1_C_Z
        have "G\<turnstile>D \<prec>\<^sub>C Z"
          by (auto dest: r_into_trancl trancl_trans)
        with nsubcls_D_Z
        show ?thesis
          by (rule notE)
      qed
    qed
  qed
qed

lemma subclseq_cases:
  assumes "G\<turnstile>C \<preceq>\<^sub>C D"
  obtains (Eq) "C = D" | (Subcls) "G\<turnstile>C \<prec>\<^sub>C D"
using assms by (blast intro: rtrancl_cases)

lemma subclseq_acyclic:
 "\<lbrakk>G\<turnstile>C \<preceq>\<^sub>C D; G\<turnstile>D \<preceq>\<^sub>C C; ws_prog G\<rbrakk> \<Longrightarrow> C=D"
by (auto elim: subclseq_cases dest: subcls_acyclic)

lemma subcls_irrefl: "\<lbrakk>G\<turnstile>C \<prec>\<^sub>C D; ws_prog G\<rbrakk>
 \<Longrightarrow> C \<noteq> D"
proof -
  assume     ws: "ws_prog G"
  assume subcls: "G\<turnstile>C \<prec>\<^sub>C D"
  then show ?thesis
  proof (induct rule: converse_trancl_induct)
    fix C
    assume "G\<turnstile>C \<prec>\<^sub>C1 D"
    with ws
    show "C\<noteq>D"
      by (blast dest: subcls1_irrefl)
  next
    fix C Z
    assume subcls1_C_Z: "G\<turnstile>C \<prec>\<^sub>C1 Z" and
            subcls_Z_D: "G\<turnstile>Z \<prec>\<^sub>C D" and
               neq_Z_D: "Z \<noteq> D"
    show "C\<noteq>D"
    proof
      assume eq_C_D: "C=D"
      show "False"
      proof -
        from subcls1_C_Z eq_C_D
        have "G\<turnstile>D \<prec>\<^sub>C Z"
          by (auto)
        also
        from subcls_Z_D ws
        have "\<not> G\<turnstile>D \<prec>\<^sub>C Z"
          by (rule subcls_acyclic)
        ultimately
        show ?thesis
          by - (rule notE)
      qed
    qed
  qed
qed

lemma invert_subclseq:
"\<lbrakk>G\<turnstile>C \<preceq>\<^sub>C D; ws_prog G\<rbrakk>
 \<Longrightarrow> \<not> G\<turnstile>D \<prec>\<^sub>C C"
proof -
  assume       ws: "ws_prog G" and
     subclseq_C_D: "G\<turnstile>C \<preceq>\<^sub>C D"
  show ?thesis
  proof (cases "D=C")
    case True
    with ws
    show ?thesis
      by (auto dest: subcls_irrefl)
  next
    case False
    with subclseq_C_D
    have "G\<turnstile>C \<prec>\<^sub>C D"
      by (blast intro: rtrancl_into_trancl3)
    with ws
    show ?thesis
      by (blast dest: subcls_acyclic)
  qed
qed

lemma invert_subcls:
"\<lbrakk>G\<turnstile>C \<prec>\<^sub>C D; ws_prog G\<rbrakk>
 \<Longrightarrow> \<not> G\<turnstile>D \<preceq>\<^sub>C C"
proof -
  assume        ws: "ws_prog G" and
        subcls_C_D: "G\<turnstile>C \<prec>\<^sub>C D"
  then
  have nsubcls_D_C: "\<not> G\<turnstile>D \<prec>\<^sub>C C"
    by (blast dest: subcls_acyclic)
  show ?thesis
  proof
    assume "G\<turnstile>D \<preceq>\<^sub>C C"
    then show "False"
    proof (cases rule: subclseq_cases)
      case Eq
      with ws subcls_C_D
      show ?thesis
        by (auto dest: subcls_irrefl)
    next
      case Subcls
      with nsubcls_D_C
      show ?thesis
        by blast
    qed
  qed
qed

lemma subcls_superD:
 "\<lbrakk>G\<turnstile>C \<prec>\<^sub>C D; class G C = Some c\<rbrakk> \<Longrightarrow> G\<turnstile>(super c) \<preceq>\<^sub>C D"
proof -
  assume       clsC: "class G C = Some c"
  assume subcls_C_C: "G\<turnstile>C \<prec>\<^sub>C D"
  then obtain S where
                  "G\<turnstile>C \<prec>\<^sub>C1 S" and
    subclseq_S_D: "G\<turnstile>S \<preceq>\<^sub>C D"
    by (blast dest: tranclD)
  with clsC
  have "S=super c"
    by (auto dest: subcls1D)
  with subclseq_S_D show ?thesis by simp
qed

lemma subclseq_superD:
 "\<lbrakk>G\<turnstile>C \<preceq>\<^sub>C D; C\<noteq>D;class G C = Some c\<rbrakk> \<Longrightarrow> G\<turnstile>(super c) \<preceq>\<^sub>C D"
proof -
  assume neq_C_D: "C\<noteq>D"
  assume    clsC: "class G C = Some c"
  assume subclseq_C_D: "G\<turnstile>C \<preceq>\<^sub>C D"
  then show ?thesis
  proof (cases rule: subclseq_cases)
    case Eq with neq_C_D show ?thesis by contradiction
  next
    case Subcls
    with clsC show ?thesis by (blast dest: subcls_superD)
  qed
qed

subsubsection "implementation relation"

lemma implmt1D: "G\<turnstile>C\<leadsto>1I \<Longrightarrow> C\<noteq>Object \<and> (\<exists>c\<in>class G C: I\<in>set (superIfs c))"
apply (unfold implmt1_def)
apply auto
done

inductive --{* implementation, cf. 8.1.4 *}
  implmt :: "prog \<Rightarrow> qtname \<Rightarrow> qtname \<Rightarrow> bool" ("_\<turnstile>_\<leadsto>_" [71,71,71] 70)
  for G :: prog
where
  direct: "G\<turnstile>C\<leadsto>1J \<Longrightarrow> G\<turnstile>C\<leadsto>J"
| subint: "G\<turnstile>C\<leadsto>1I \<Longrightarrow> G\<turnstile>I\<preceq>I J \<Longrightarrow> G\<turnstile>C\<leadsto>J"
| subcls1: "G\<turnstile>C\<prec>\<^sub>C1D \<Longrightarrow> G\<turnstile>D\<leadsto>J \<Longrightarrow> G\<turnstile>C\<leadsto>J"

lemma implmtD: "G\<turnstile>C\<leadsto>J \<Longrightarrow> (\<exists>I. G\<turnstile>C\<leadsto>1I \<and> G\<turnstile>I\<preceq>I J) \<or> (\<exists>D. G\<turnstile>C\<prec>\<^sub>C1D \<and> G\<turnstile>D\<leadsto>J)"
apply (erule implmt.induct)
apply fast+
done

lemma implmt_ObjectE [elim!]: "G\<turnstile>Object\<leadsto>I \<Longrightarrow> R"
by (auto dest!: implmtD implmt1D subcls1D)

lemma subcls_implmt [rule_format (no_asm)]: "G\<turnstile>A\<preceq>\<^sub>C B \<Longrightarrow> G\<turnstile>B\<leadsto>K \<longrightarrow> G\<turnstile>A\<leadsto>K"
apply (erule rtrancl_induct)
apply  (auto intro: implmt.subcls1)
done

lemma implmt_subint2: "\<lbrakk> G\<turnstile>A\<leadsto>J; G\<turnstile>J\<preceq>I K\<rbrakk> \<Longrightarrow> G\<turnstile>A\<leadsto>K"
apply (erule rev_mp, erule implmt.induct)
apply (auto dest: implmt.subint rtrancl_trans implmt.subcls1)
done

lemma implmt_is_class: "G\<turnstile>C\<leadsto>I \<Longrightarrow> is_class G C"
apply (erule implmt.induct)
apply (auto dest: implmt1D subcls1D)
done

subsubsection "widening relation"

inductive
 --{*widening, viz. method invocation conversion, cf. 5.3
                            i.e. kind of syntactic subtyping *}
  widen :: "prog \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("_\<turnstile>_\<preceq>_" [71,71,71] 70)
  for G :: prog
where
  refl:    "G\<turnstile>T\<preceq>T" --{*identity conversion, cf. 5.1.1 *}
| subint:  "G\<turnstile>I\<preceq>I J  \<Longrightarrow> G\<turnstile>Iface I\<preceq> Iface J" --{*wid.ref.conv.,cf. 5.1.4 *}
| int_obj: "G\<turnstile>Iface I\<preceq> Class Object"
| subcls:  "G\<turnstile>C\<preceq>\<^sub>C D  \<Longrightarrow> G\<turnstile>Class C\<preceq> Class D"
| implmt:  "G\<turnstile>C\<leadsto>I   \<Longrightarrow> G\<turnstile>Class C\<preceq> Iface I"
| null:    "G\<turnstile>NT\<preceq> RefT R"
| arr_obj: "G\<turnstile>T.[]\<preceq> Class Object"
| array:   "G\<turnstile>RefT S\<preceq>RefT T \<Longrightarrow> G\<turnstile>RefT S.[]\<preceq> RefT T.[]"

declare widen.refl [intro!]
declare widen.intros [simp]

(* too strong in general:
lemma widen_PrimT: "G\<turnstile>PrimT x\<preceq>T \<Longrightarrow> T = PrimT x"
*)
lemma widen_PrimT: "G\<turnstile>PrimT x\<preceq>T \<Longrightarrow> (\<exists>y. T = PrimT y)"
apply (ind_cases "G\<turnstile>PrimT x\<preceq>T")
by auto

(* too strong in general:
lemma widen_PrimT2: "G\<turnstile>S\<preceq>PrimT x \<Longrightarrow> S = PrimT x"
*)
lemma widen_PrimT2: "G\<turnstile>S\<preceq>PrimT x \<Longrightarrow> \<exists>y. S = PrimT y"
apply (ind_cases "G\<turnstile>S\<preceq>PrimT x")
by auto

text {*
   These widening lemmata hold in Bali but are to strong for ordinary
   Java. They  would not work for real Java Integral Types, like short,
   long, int. These lemmata are just for documentation and are not used.
 *}

lemma widen_PrimT_strong: "G\<turnstile>PrimT x\<preceq>T \<Longrightarrow> T = PrimT x"
by (ind_cases "G\<turnstile>PrimT x\<preceq>T") simp_all

lemma widen_PrimT2_strong: "G\<turnstile>S\<preceq>PrimT x \<Longrightarrow> S = PrimT x"
by (ind_cases "G\<turnstile>S\<preceq>PrimT x") simp_all

text {* Specialized versions for booleans also would work for real Java *}

lemma widen_Boolean: "G\<turnstile>PrimT Boolean\<preceq>T \<Longrightarrow> T = PrimT Boolean"
by (ind_cases "G\<turnstile>PrimT Boolean\<preceq>T") simp_all

lemma widen_Boolean2: "G\<turnstile>S\<preceq>PrimT Boolean \<Longrightarrow> S = PrimT Boolean"
by (ind_cases "G\<turnstile>S\<preceq>PrimT Boolean") simp_all

lemma widen_RefT: "G\<turnstile>RefT R\<preceq>T \<Longrightarrow> \<exists>t. T=RefT t"
apply (ind_cases "G\<turnstile>RefT R\<preceq>T")
by auto

lemma widen_RefT2: "G\<turnstile>S\<preceq>RefT R \<Longrightarrow> \<exists>t. S=RefT t"
apply (ind_cases "G\<turnstile>S\<preceq>RefT R")
by auto

lemma widen_Iface: "G\<turnstile>Iface I\<preceq>T \<Longrightarrow> T=Class Object \<or> (\<exists>J. T=Iface J)"
apply (ind_cases "G\<turnstile>Iface I\<preceq>T")
by auto

lemma widen_Iface2: "G\<turnstile>S\<preceq> Iface J \<Longrightarrow> S = NT \<or> (\<exists>I. S = Iface I) \<or> (\<exists>D. S = Class D)"
apply (ind_cases "G\<turnstile>S\<preceq> Iface J")
by auto

lemma widen_Iface_Iface: "G\<turnstile>Iface I\<preceq> Iface J \<Longrightarrow> G\<turnstile>I\<preceq>I J"
apply (ind_cases "G\<turnstile>Iface I\<preceq> Iface J")
by auto

lemma widen_Iface_Iface_eq [simp]: "G\<turnstile>Iface I\<preceq> Iface J = G\<turnstile>I\<preceq>I J"
apply (rule iffI)
apply  (erule widen_Iface_Iface)
apply (erule widen.subint)
done

lemma widen_Class: "G\<turnstile>Class C\<preceq>T \<Longrightarrow>  (\<exists>D. T=Class D) \<or> (\<exists>I. T=Iface I)"
apply (ind_cases "G\<turnstile>Class C\<preceq>T")
by auto

lemma widen_Class2: "G\<turnstile>S\<preceq> Class C \<Longrightarrow> C = Object \<or> S = NT \<or> (\<exists>D. S = Class D)"
apply (ind_cases "G\<turnstile>S\<preceq> Class C")
by auto

lemma widen_Class_Class: "G\<turnstile>Class C\<preceq> Class cm \<Longrightarrow> G\<turnstile>C\<preceq>\<^sub>C cm"
apply (ind_cases "G\<turnstile>Class C\<preceq> Class cm")
by auto

lemma widen_Class_Class_eq [simp]: "G\<turnstile>Class C\<preceq> Class cm = G\<turnstile>C\<preceq>\<^sub>C cm"
apply (rule iffI)
apply  (erule widen_Class_Class)
apply (erule widen.subcls)
done

lemma widen_Class_Iface: "G\<turnstile>Class C\<preceq> Iface I \<Longrightarrow> G\<turnstile>C\<leadsto>I"
apply (ind_cases "G\<turnstile>Class C\<preceq> Iface I")
by auto

lemma widen_Class_Iface_eq [simp]: "G\<turnstile>Class C\<preceq> Iface I = G\<turnstile>C\<leadsto>I"
apply (rule iffI)
apply  (erule widen_Class_Iface)
apply (erule widen.implmt)
done

lemma widen_Array: "G\<turnstile>S.[]\<preceq>T \<Longrightarrow> T=Class Object \<or> (\<exists>T'. T=T'.[] \<and> G\<turnstile>S\<preceq>T')"
apply (ind_cases "G\<turnstile>S.[]\<preceq>T")
by auto

lemma widen_Array2: "G\<turnstile>S\<preceq>T.[] \<Longrightarrow> S = NT \<or> (\<exists>S'. S=S'.[] \<and> G\<turnstile>S'\<preceq>T)"
apply (ind_cases "G\<turnstile>S\<preceq>T.[]")
by auto

lemma widen_ArrayPrimT: "G\<turnstile>PrimT t.[]\<preceq>T \<Longrightarrow> T=Class Object \<or> T=PrimT t.[]"
apply (ind_cases "G\<turnstile>PrimT t.[]\<preceq>T")
by auto

lemma widen_ArrayRefT:
  "G\<turnstile>RefT t.[]\<preceq>T \<Longrightarrow> T=Class Object \<or> (\<exists>s. T=RefT s.[] \<and> G\<turnstile>RefT t\<preceq>RefT s)"
apply (ind_cases "G\<turnstile>RefT t.[]\<preceq>T")
by auto

lemma widen_ArrayRefT_ArrayRefT_eq [simp]:
  "G\<turnstile>RefT T.[]\<preceq>RefT T'.[] = G\<turnstile>RefT T\<preceq>RefT T'"
apply (rule iffI)
apply (drule widen_ArrayRefT)
apply simp
apply (erule widen.array)
done

lemma widen_Array_Array: "G\<turnstile>T.[]\<preceq>T'.[] \<Longrightarrow> G\<turnstile>T\<preceq>T'"
apply (drule widen_Array)
apply auto
done

lemma widen_Array_Class: "G\<turnstile>S.[] \<preceq> Class C \<Longrightarrow> C=Object"
by (auto dest: widen_Array)

lemma widen_NT2: "G\<turnstile>S\<preceq>NT \<Longrightarrow> S = NT"
apply (ind_cases "G\<turnstile>S\<preceq>NT")
by auto

lemma widen_Object:
  assumes "isrtype G T" and "ws_prog G"
  shows "G\<turnstile>RefT T \<preceq> Class Object"
proof (cases T)
  case (ClassT C) with assms have "G\<turnstile>C\<preceq>\<^sub>C Object" by (auto intro: subcls_ObjectI)
  with ClassT show ?thesis by auto
qed simp_all

lemma widen_trans_lemma [rule_format (no_asm)]:
  "\<lbrakk>G\<turnstile>S\<preceq>U; \<forall>C. is_class G C \<longrightarrow> G\<turnstile>C\<preceq>\<^sub>C Object\<rbrakk> \<Longrightarrow> \<forall>T. G\<turnstile>U\<preceq>T \<longrightarrow> G\<turnstile>S\<preceq>T"
apply (erule widen.induct)
apply        safe
prefer      5 apply (drule widen_RefT) apply clarsimp
apply      (frule_tac [1] widen_Iface)
apply      (frule_tac [2] widen_Class)
apply      (frule_tac [3] widen_Class)
apply      (frule_tac [4] widen_Iface)
apply      (frule_tac [5] widen_Class)
apply      (frule_tac [6] widen_Array)
apply      safe
apply            (rule widen.int_obj)
prefer          6 apply (drule implmt_is_class) apply simp
apply (tactic "ALLGOALS (etac thin_rl)")
prefer         6 apply simp
apply          (rule_tac [9] widen.arr_obj)
apply         (rotate_tac [9] -1)
apply         (frule_tac [9] widen_RefT)
apply         (auto elim!: rtrancl_trans subcls_implmt implmt_subint2)
done

lemma ws_widen_trans: "\<lbrakk>G\<turnstile>S\<preceq>U; G\<turnstile>U\<preceq>T; ws_prog G\<rbrakk> \<Longrightarrow> G\<turnstile>S\<preceq>T"
by (auto intro: widen_trans_lemma subcls_ObjectI)

lemma widen_antisym_lemma [rule_format (no_asm)]: "\<lbrakk>G\<turnstile>S\<preceq>T;
 \<forall>I J. G\<turnstile>I\<preceq>I J \<and> G\<turnstile>J\<preceq>I I \<longrightarrow> I = J;
 \<forall>C D. G\<turnstile>C\<preceq>\<^sub>C D \<and> G\<turnstile>D\<preceq>\<^sub>C C \<longrightarrow> C = D;
 \<forall>I  . G\<turnstile>Object\<leadsto>I        \<longrightarrow> False\<rbrakk> \<Longrightarrow> G\<turnstile>T\<preceq>S \<longrightarrow> S = T"
apply (erule widen.induct)
apply (auto dest: widen_Iface widen_NT2 widen_Class)
done

lemmas subint_antisym =
       subint1_acyclic [THEN acyclic_impl_antisym_rtrancl]
lemmas subcls_antisym =
       subcls1_acyclic [THEN acyclic_impl_antisym_rtrancl]

lemma widen_antisym: "\<lbrakk>G\<turnstile>S\<preceq>T; G\<turnstile>T\<preceq>S; ws_prog G\<rbrakk> \<Longrightarrow> S=T"
by (fast elim: widen_antisym_lemma subint_antisym [THEN antisymD]
                                   subcls_antisym [THEN antisymD])

lemma widen_ObjectD [dest!]: "G\<turnstile>Class Object\<preceq>T \<Longrightarrow> T=Class Object"
apply (frule widen_Class)
apply (fast dest: widen_Class_Class widen_Class_Iface)
done

definition
  widens :: "prog \<Rightarrow> [ty list, ty list] \<Rightarrow> bool" ("_\<turnstile>_[\<preceq>]_" [71,71,71] 70)
  where "G\<turnstile>Ts[\<preceq>]Ts' = list_all2 (\<lambda>T T'. G\<turnstile>T\<preceq>T') Ts Ts'"

lemma widens_Nil [simp]: "G\<turnstile>[][\<preceq>][]"
apply (unfold widens_def)
apply auto
done

lemma widens_Cons [simp]: "G\<turnstile>(S#Ss)[\<preceq>](T#Ts) = (G\<turnstile>S\<preceq>T \<and> G\<turnstile>Ss[\<preceq>]Ts)"
apply (unfold widens_def)
apply auto
done

subsubsection "narrowing relation"

(* all properties of narrowing and casting conversions we actually need *)
(* these can easily be proven from the definitions below *)
(*
rules
  cast_RefT2   "G\<turnstile>S\<preceq>? RefT R   \<Longrightarrow> \<exists>t. S=RefT t"
  cast_PrimT2  "G\<turnstile>S\<preceq>? PrimT pt \<Longrightarrow> \<exists>t. S=PrimT t \<and> G\<turnstile>PrimT t\<preceq>PrimT pt"
*)

(* more detailed than necessary for type-safety, see above rules. *)
inductive --{* narrowing reference conversion, cf. 5.1.5 *}
  narrow :: "prog \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("_\<turnstile>_\<succ>_" [71,71,71] 70)
  for G :: prog
where
  subcls:  "G\<turnstile>C\<preceq>\<^sub>C D \<Longrightarrow> G\<turnstile>     Class D\<succ>Class C"
| implmt:  "\<not>G\<turnstile>C\<leadsto>I \<Longrightarrow> G\<turnstile>     Class C\<succ>Iface I"
| obj_arr: "G\<turnstile>Class Object\<succ>T.[]"
| int_cls: "G\<turnstile>     Iface I\<succ>Class C"
| subint:  "imethds G I hidings imethds G J entails
           (\<lambda>(md, mh   ) (md',mh'). G\<turnstile>mrt mh\<preceq>mrt mh') \<Longrightarrow>
           \<not>G\<turnstile>I\<preceq>I J         \<Longrightarrow> G\<turnstile>     Iface I\<succ>Iface J"
| array:   "G\<turnstile>RefT S\<succ>RefT T \<Longrightarrow> G\<turnstile>   RefT S.[]\<succ>RefT T.[]"

(*unused*)
lemma narrow_RefT: "G\<turnstile>RefT R\<succ>T \<Longrightarrow> \<exists>t. T=RefT t"
apply (ind_cases "G\<turnstile>RefT R\<succ>T")
by auto

lemma narrow_RefT2: "G\<turnstile>S\<succ>RefT R \<Longrightarrow> \<exists>t. S=RefT t"
apply (ind_cases "G\<turnstile>S\<succ>RefT R")
by auto

(*unused*)
lemma narrow_PrimT: "G\<turnstile>PrimT pt\<succ>T \<Longrightarrow> \<exists>t. T=PrimT t"
by (ind_cases "G\<turnstile>PrimT pt\<succ>T")

lemma narrow_PrimT2: "G\<turnstile>S\<succ>PrimT pt \<Longrightarrow>
                                  \<exists>t. S=PrimT t \<and> G\<turnstile>PrimT t\<preceq>PrimT pt"
by (ind_cases "G\<turnstile>S\<succ>PrimT pt")

text {*
   These narrowing lemmata hold in Bali but are to strong for ordinary
   Java. They  would not work for real Java Integral Types, like short,
   long, int. These lemmata are just for documentation and are not used.
 *}
lemma narrow_PrimT_strong: "G\<turnstile>PrimT pt\<succ>T \<Longrightarrow> T=PrimT pt"
by (ind_cases "G\<turnstile>PrimT pt\<succ>T")

lemma narrow_PrimT2_strong: "G\<turnstile>S\<succ>PrimT pt \<Longrightarrow> S=PrimT pt"
by (ind_cases "G\<turnstile>S\<succ>PrimT pt")

text {* Specialized versions for booleans also would work for real Java *}

lemma narrow_Boolean: "G\<turnstile>PrimT Boolean\<succ>T \<Longrightarrow> T=PrimT Boolean"
by (ind_cases "G\<turnstile>PrimT Boolean\<succ>T")

lemma narrow_Boolean2: "G\<turnstile>S\<succ>PrimT Boolean \<Longrightarrow> S=PrimT Boolean"
by (ind_cases "G\<turnstile>S\<succ>PrimT Boolean")

subsubsection "casting relation"

inductive --{* casting conversion, cf. 5.5 *}
  cast :: "prog \<Rightarrow> ty \<Rightarrow> ty \<Rightarrow> bool" ("_\<turnstile>_\<preceq>? _" [71,71,71] 70)
  for G :: prog
where
  widen:   "G\<turnstile>S\<preceq>T \<Longrightarrow> G\<turnstile>S\<preceq>? T"
| narrow:  "G\<turnstile>S\<succ>T \<Longrightarrow> G\<turnstile>S\<preceq>? T"

(*unused*)
lemma cast_RefT: "G\<turnstile>RefT R\<preceq>? T \<Longrightarrow> \<exists>t. T=RefT t"
apply (ind_cases "G\<turnstile>RefT R\<preceq>? T")
by (auto dest: widen_RefT narrow_RefT)

lemma cast_RefT2: "G\<turnstile>S\<preceq>? RefT R \<Longrightarrow> \<exists>t. S=RefT t"
apply (ind_cases "G\<turnstile>S\<preceq>? RefT R")
by (auto dest: widen_RefT2 narrow_RefT2)

(*unused*)
lemma cast_PrimT: "G\<turnstile>PrimT pt\<preceq>? T \<Longrightarrow> \<exists>t. T=PrimT t"
apply (ind_cases "G\<turnstile>PrimT pt\<preceq>? T")
by (auto dest: widen_PrimT narrow_PrimT)

lemma cast_PrimT2: "G\<turnstile>S\<preceq>? PrimT pt \<Longrightarrow> \<exists>t. S=PrimT t \<and> G\<turnstile>PrimT t\<preceq>PrimT pt"
apply (ind_cases "G\<turnstile>S\<preceq>? PrimT pt")
by (auto dest: widen_PrimT2 narrow_PrimT2)

lemma cast_Boolean:
  assumes bool_cast: "G\<turnstile>PrimT Boolean\<preceq>? T"
  shows "T=PrimT Boolean"
using bool_cast
proof (cases)
  case widen
  hence "G\<turnstile>PrimT Boolean\<preceq> T"
    by simp
  thus ?thesis by  (rule widen_Boolean)
next
  case narrow
  hence "G\<turnstile>PrimT Boolean\<succ>T"
    by simp
  thus ?thesis by (rule narrow_Boolean)
qed

lemma cast_Boolean2:
  assumes bool_cast: "G\<turnstile>S\<preceq>? PrimT Boolean"
  shows "S = PrimT Boolean"
using bool_cast
proof (cases)
  case widen
  hence "G\<turnstile>S\<preceq> PrimT Boolean"
    by simp
  thus ?thesis by  (rule widen_Boolean2)
next
  case narrow
  hence "G\<turnstile>S\<succ>PrimT Boolean"
    by simp
  thus ?thesis by (rule narrow_Boolean2)
qed

end


(*  Title:      HOL/Auth/n_german_lemma_inv__5_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__5_on_rules imports n_german_lemma_on_inv__5
begin
section{*All lemmas on causal relation between inv__5*}
lemma lemma_inv__5_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv1 p__Inv2. p__Inv1\<le>N\<and>p__Inv2\<le>N\<and>p__Inv1~=p__Inv2\<and>f=inv__5  p__Inv1 p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_StoreVsinv__5) done
    }

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

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

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

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

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

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

    moreover {
      assume d1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_SendInv__part__1Vsinv__5) 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__5) 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__5) 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__5) 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__5) 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__5) 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__5) done
    }

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

end


(*  Title:      HOL/Auth/n_german_lemma_inv__9_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__9_on_rules imports n_german_lemma_on_inv__9
begin
section{*All lemmas on causal relation between inv__9*}
lemma lemma_inv__9_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__9  p__Inv3 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__9) 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__9) 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__9) 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__9) 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__9) 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__9) 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__9) 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__9) 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__9) 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__9) 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__9) 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__9) 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__9) done
    }

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

end


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

header{*The n_germanSimp Protocol Case Study*}

theory n_germanSimp_lemma_on_inv__10 imports n_germanSimp_base
begin
section{*All lemmas on causal relation between inv__10 and some rule r*}
lemma n_StoreVsinv__10:
assumes a1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__10  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i d where a1:"i\<le>N\<and>d\<le>N\<and>r=n_Store  i d" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__10  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const GntS)) (eqn (IVar (Field (Para (Ident ''Cache'') p__Inv4) ''State'')) (Const E))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Field (Para (Ident ''Cache'') i) ''State'')) (Const E)) (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const GntS))))" 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__10:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__10  p__Inv4)"
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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__10  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  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__Inv4)"
  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__10:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__10  p__Inv4)"
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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__10  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  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__Inv4)"
  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_SendInvAckVsinv__10:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__10  p__Inv4)"
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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__10  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  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__Inv4)"
  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__10:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__10  p__Inv4)"
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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__10  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Ident ''ExGntd'')) (Const false)) (neg (eqn (IVar (Ident ''MemData'')) (IVar (Ident ''AuxData''))))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv4)"
  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_SendGntEVsinv__10:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__10  p__Inv4)"
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__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__10  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  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__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntSVsinv__10:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__10  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntS  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__10  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  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__Inv4)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_RecvGntEVsinv__10:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)" and
a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__10  p__Inv4)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntE  i" apply fastforce done
from a2 obtain p__Inv4 where a2:"p__Inv4\<le>N\<and>f=inv__10  p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv4)"
  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__Inv4)"
  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__10:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__10  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqE__part__0Vsinv__10:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__0 N i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__10  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_RecvReqE__part__1Vsinv__10:
  assumes a1: "\<exists> i. i\<le>N\<and>r=n_RecvReqE__part__1 N i" and
  a2: "(\<exists> p__Inv4. p__Inv4\<le>N\<and>f=inv__10  p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

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

end


(* Authors: Florian Haftmann, Johannes Hölzl, Tobias Nipkow *)

theory Code_Real_Approx_By_Float
imports Complex_Main Code_Target_Int
begin

text{* \textbf{WARNING} This theory implements mathematical reals by machine
reals (floats). This is inconsistent. See the proof of False at the end of
the theory, where an equality on mathematical reals is (incorrectly)
disproved by mapping it to machine reals.

The value command cannot display real results yet.

The only legitimate use of this theory is as a tool for code generation
purposes. *}

code_printing
  type_constructor real \<rightharpoonup>
    (SML) "real"
    and (OCaml) "float"

code_printing
  constant Ratreal \<rightharpoonup>
    (SML) "error/ \"Bad constant: Ratreal\""

code_printing
  constant "0 :: real" \<rightharpoonup>
    (SML) "0.0"
    and (OCaml) "0.0"
declare zero_real_code[code_unfold del]

code_printing
  constant "1 :: real" \<rightharpoonup>
    (SML) "1.0"
    and (OCaml) "1.0"
declare one_real_code[code_unfold del]

code_printing
  constant "HOL.equal :: real \<Rightarrow> real \<Rightarrow> bool" \<rightharpoonup>
    (SML) "Real.== ((_), (_))"
    and (OCaml) "Pervasives.(=)"

code_printing
  constant "Orderings.less_eq :: real \<Rightarrow> real \<Rightarrow> bool" \<rightharpoonup>
    (SML) "Real.<= ((_), (_))"
    and (OCaml) "Pervasives.(<=)"

code_printing
  constant "Orderings.less :: real \<Rightarrow> real \<Rightarrow> bool" \<rightharpoonup>
    (SML) "Real.< ((_), (_))"
    and (OCaml) "Pervasives.(<)"

code_printing
  constant "op + :: real \<Rightarrow> real \<Rightarrow> real" \<rightharpoonup>
    (SML) "Real.+ ((_), (_))"
    and (OCaml) "Pervasives.( +. )"

code_printing
  constant "op * :: real \<Rightarrow> real \<Rightarrow> real" \<rightharpoonup>
    (SML) "Real.* ((_), (_))"
    and (OCaml) "Pervasives.( *. )"

code_printing
  constant "op - :: real \<Rightarrow> real \<Rightarrow> real" \<rightharpoonup>
    (SML) "Real.- ((_), (_))"
    and (OCaml) "Pervasives.( -. )"

code_printing
  constant "uminus :: real \<Rightarrow> real" \<rightharpoonup>
    (SML) "Real.~"
    and (OCaml) "Pervasives.( ~-. )"

code_printing
  constant "op / :: real \<Rightarrow> real \<Rightarrow> real" \<rightharpoonup>
    (SML) "Real.'/ ((_), (_))"
    and (OCaml) "Pervasives.( '/. )"

code_printing
  constant "HOL.equal :: real \<Rightarrow> real \<Rightarrow> bool" \<rightharpoonup>
    (SML) "Real.== ((_:real), (_))"

code_printing
  constant "sqrt :: real \<Rightarrow> real" \<rightharpoonup>
    (SML) "Math.sqrt"
    and (OCaml) "Pervasives.sqrt"
declare sqrt_def[code del]

definition real_exp :: "real \<Rightarrow> real" where "real_exp = exp"

lemma exp_eq_real_exp[code_unfold]: "exp = real_exp"
  unfolding real_exp_def ..

code_printing
  constant real_exp \<rightharpoonup>
    (SML) "Math.exp"
    and (OCaml) "Pervasives.exp"
declare real_exp_def[code del]
declare exp_def[code del]

hide_const (open) real_exp

code_printing
  constant ln \<rightharpoonup>
    (SML) "Math.ln"
    and (OCaml) "Pervasives.ln"
declare ln_def[code del]

code_printing
  constant cos \<rightharpoonup>
    (SML) "Math.cos"
    and (OCaml) "Pervasives.cos"
declare cos_def[code del]

code_printing
  constant sin \<rightharpoonup>
    (SML) "Math.sin"
    and (OCaml) "Pervasives.sin"
declare sin_def[code del]

code_printing
  constant pi \<rightharpoonup>
    (SML) "Math.pi"
    and (OCaml) "Pervasives.pi"
declare pi_def[code del]

code_printing
  constant arctan \<rightharpoonup>
    (SML) "Math.atan"
    and (OCaml) "Pervasives.atan"
declare arctan_def[code del]

code_printing
  constant arccos \<rightharpoonup>
    (SML) "Math.scos"
    and (OCaml) "Pervasives.acos"
declare arccos_def[code del]

code_printing
  constant arcsin \<rightharpoonup>
    (SML) "Math.asin"
    and (OCaml) "Pervasives.asin"
declare arcsin_def[code del]

definition real_of_integer :: "integer \<Rightarrow> real" where
  "real_of_integer = of_int \<circ> int_of_integer"

code_printing
  constant real_of_integer \<rightharpoonup>
    (SML) "Real.fromInt"
    and (OCaml) "Pervasives.float (Big'_int.int'_of'_big'_int (_))"

definition real_of_int :: "int \<Rightarrow> real" where
  [code_abbrev]: "real_of_int = of_int"

lemma [code_unfold del]:
  "0 \<equiv> (of_rat 0 :: real)"
  by simp

lemma [code_unfold del]:
  "1 \<equiv> (of_rat 1 :: real)"
  by simp

lemma [code_unfold del]:
  "numeral k \<equiv> (of_rat (numeral k) :: real)"
  by simp

lemma [code_unfold del]:
  "- numeral k \<equiv> (of_rat (- numeral k) :: real)"
  by simp

hide_const (open) real_of_int

code_printing
  constant Ratreal \<rightharpoonup> (SML)

definition Realfract :: "int => int => real"
where
  "Realfract p q = of_int p / of_int q"

code_datatype Realfract

code_printing
  constant Realfract \<rightharpoonup> (SML) "Real.fromInt _/ '// Real.fromInt _"

lemma [code]:
  "Ratreal r = split Realfract (quotient_of r)"
  by (cases r) (simp add: Realfract_def quotient_of_Fract of_rat_rat)

lemma [code, code del]:
  "(HOL.equal :: real=>real=>bool) = (HOL.equal :: real => real => bool) "
  ..

lemma [code, code del]:
  "(plus :: real => real => real) = plus"
  ..

lemma [code, code del]:
  "(uminus :: real => real) = uminus"
  ..

lemma [code, code del]:
  "(minus :: real => real => real) = minus"
  ..

lemma [code, code del]:
  "(times :: real => real => real) = times"
  ..

lemma [code, code del]:
  "(divide :: real => real => real) = divide"
  ..

lemma [code]:
  fixes r :: real
  shows "inverse r = 1 / r"
  by (fact inverse_eq_divide)

notepad
begin
  have "cos (pi/2) = 0" by (rule cos_pi_half)
  moreover have "cos (pi/2) \<noteq> 0" by eval
  ultimately have "False" by blast
end

end


theory RCU_old
imports Main PSem
begin
(*do a search on CHECK*)

datatype PC = I1 | I2 | I3 | I4 | I5 | I6 | I7 | I8 | I9 | I10 | I11 | I12 | I13 | I14 | I15
            | R1 | R2 | R3 | R4 | R5 | R6 | R7
            | S1 | S2 | S3 | S4 | S5 | S6 | S7 | S8 | S9

(**)
consts rcu_0 ::address (*first location of rcu array*)
consts F::nat
consts T_max::nat (*max_thread ID*)
consts C :: nat     (*just referred to by its location in A(1) = (C,pointer) where C = nat*)
definition "set_T \<equiv> {n . n\<ge>1 \<and> n<T_max}"
definition "rcu_addrs \<equiv> {n . n\<ge>rcu_0 \<and> n < rcu_0+T_max-1}"
definition "something  \<equiv> F \<notin> rcu_addrs"

(*Recorded variables partial function*)
record mstate =
  pc :: "T \<Rightarrow> PC"
  r :: "T \<Rightarrow> nat \<Rightarrow> nat"        (*local copy of rcu*)
  v :: "T \<Rightarrow> V"
  n :: "T \<Rightarrow> id option"
  n_val :: "T \<Rightarrow> nat option"
  s :: "T \<Rightarrow> id option"
  s_val :: "T \<Rightarrow> nat option"
  C_val :: "T \<Rightarrow> nat option"
  (*old :: "T \<Rightarrow> id"          object to which s is pointing, as seen by thread T*)
  (*new :: "T \<Rightarrow> id option"          object to which n is pointing, per thread T*)
  det :: "T \<Rightarrow> L list"   (*detached list*)
  for_ctr :: "T \<Rightarrow> nat"        (* aux *)
  res :: "T \<Rightarrow> nat"           (*return v*)
  reg :: "T \<Rightarrow> nat"            (*0 or 1 - local copy of rcu\<^sub>i where i is thread index - is i in rcu or not? *)
  nondet_val :: "T \<Rightarrow> bool"    (* result of function nondet() *)
  CAS_succ :: "T \<Rightarrow> bool"      (*CAS succ, aux*)

(*for pointers we will have A(0) = (x58,pointer) which is equivalent to   A(order) = (address,pointer)
  for variables  --//---    A(1) = (x78,variable) --//--    --//--        A(order) = (address,variable)*)

(* start state must take out rcu_addrs  from free_addrs *)

(*---------------- basic functional definitons ----------------------*)

(*int v*)
definition v_allocation :: "mstate \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> bool" ("_ int\<^sub>v[_] _" [200,200])           \<comment>\<open>int v, note v is a local variable\<close>
  where                                                                                \<comment>\<open>  and doesn't need allocation\<close>
  "v_allocation ms t ms' \<equiv>  ms' =ms \<lparr>v := (v ms) (t := 0),
                                    pc := (pc ms) (t := I4)\<rparr>"
(*int *n*)
definition int_star_n :: "mstate \<Rightarrow> posem \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> bool" ("_ _ int *n\<^sub>_ _ _" [200,200,200,200,200])           \<comment>\<open>int *n\<close>
  where
  "int_star_n ms ps t ms' ps' \<equiv> \<exists> loc prov . (allocate_object ps loc prov ps'
                                                \<and> ms' = ms \<lparr>n := (n ms) (t := Some (prov)),
                                                           pc := (pc ms) (t := I4) \<rparr>)"
(*int *s*)
definition int_star_s :: "mstate \<Rightarrow> posem \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> bool" ("_ _ int *s\<^sub>_ _ _" [200,200,200,200,200])           \<comment>\<open>int *s\<close>
  where
  "int_star_s ms ps t ms' ps' \<equiv> \<exists> loc prov . (allocate_object ps loc prov ps'
                                                \<and> ms' = ms \<lparr>s := (s ms) (t := Some (prov)),
                                                           pc := (pc ms) (t := I4) \<rparr>)"

lemma test1:
  assumes "ms ps int *n\<^sub>t ms' ps'"
  assumes "n ms' t = Some 2"
  shows "2 \<notin> dom(A ps)"
  using assms apply (simp add:int_star_n_def allocate_object_def)
  apply clarify
  by(simp add:isfree_addr_def)

lemma test2:
  assumes "ms ps int *n\<^sub>t ms' ps'"
  assumes "n ms' t = Some 2"
  shows "A ps' 2 \<noteq> None"
  using assms apply (simp add:int_star_n_def allocate_object_def)
  apply clarify
  by(simp add:isfree_addr_def)

lemma test3:
  assumes "ms ps int *n\<^sub>t ms' ps'"
  assumes "n ms' t = Some 2"
  shows "(\<exists>x. A ps' 2 =Some x \<and> fst(x) \<notin>alloc_addrs ps)"
  using assms apply (simp add:int_star_n_def allocate_object_def)
  apply clarify
  by(simp add:isfree_addr_def)

(*******   n = new int   split**********CHECK*)
definition new_int :: "mstate \<Rightarrow> posem \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> bool" ( "_ _ new int\<^sub>_ _ _" [200,200,200,200,200])
  where
  "new_int ms ps t ms' ps' \<equiv> \<exists> loc prov . (allocate_object ps loc prov ps'
                                                \<and> ms' = ms \<lparr>n_val := (n_val ms) (t := Some (loc)),
                                                           pc := (pc ms) (t := I4) \<rparr>)"
definition point_n_to_newint :: "mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> bool" ( "_ _ _ n\<^sub>_ = &newint _ _ _ " [200,200,200,200,200,200,200])
  where   \<comment>\<open> global point n to newint\<close>
  "point_n_to_newint ms ps \<sigma> t ms' ps' \<sigma>' \<equiv> (\<exists>x y.  A ps y = Some x
                                                        \<and> n ms t = Some (fst(x))
                                                        \<and> n_val ms t = Some y
                                      \<and> \<sigma> [fst(x) := y]\<^sub>t \<sigma>'
                                      \<and>  ms' = ms \<lparr> pc := (pc ms) (t := I4)\<rparr>)"

(*******   s = C   split**********)
definition get_C_val :: "mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> bool" ( "_ _ _ _ loadsfrom &C   _ _ _" [200,200,200,200,200,200,200])
  where
  "get_C_val ms ps \<sigma> t ms' ps' \<sigma>' \<equiv> (\<exists>x y z.  (fst(y) = C) \<and> A ps x = Some y
                                      \<and> \<sigma> [z \<leftarrow> fst(y)]\<^sub>t \<sigma>'
                                      \<and> ms' = ms \<lparr> C_val := (C_val ms) (t := Some z),
                                                      pc := (pc ms) (t := I4)\<rparr>)"
definition change_what_s_points_to :: "mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> bool" ( "_ _ _ writeto &s\<^sub>_  _ _ _" [200,200,200,200,200,200,200])
  where
  "change_what_s_points_to ms ps \<sigma> t ms' ps' \<sigma>' \<equiv> (\<exists>x y z.  (s ms t = Some x)
                                                          \<and> A ps x = Some y
                                                          \<and> C_val ms t = Some z
                                      \<and> \<sigma> [fst(y) := z]\<^sub>t \<sigma>'
                                      \<and> ms' = ms \<lparr>pc := (pc ms) (t := I4)\<rparr>)"

(*******   v=*s   split**********)
definition get_s_val :: "mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> bool" ( "_ _ _ loadfrom &s\<^sub>_  _ _ _" [200,200,200,200,200,200,200])
  where
  "get_s_val ms ps \<sigma> t ms' ps' \<sigma>' \<equiv> (\<exists>x y z.  (s ms t = Some x) \<and> A ps x = Some y
                                      \<and> \<sigma> [z \<leftarrow> fst(y)]\<^sub>t \<sigma>'
                                      \<and> ms' = ms \<lparr> s_val := (s_val ms) (t := Some z),
                                                      pc := (pc ms) (t := I4)\<rparr>)"
definition update_v :: "mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> T \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> bool" ( "_ _ _ v\<^sub>_:=*s\<^sub>_ _ _ _ " [200,200,200,200,200,200,200,200])
  where   \<comment>\<open> global read of *s\<close>
  "update_v ms ps \<sigma> t t' ms' ps' \<sigma>' \<equiv> t = t' \<and> (\<exists>x y z.  A ps y = Some x
                                                        \<and> s_val ms t = Some (fst(x))
                                      \<and> \<sigma> [z \<leftarrow> fst(x)]\<^sub>t \<sigma>'
                                      \<and>  ms' = ms \<lparr> v := (v ms) (t := z),
                                                    pc := (pc ms) (t := I4)\<rparr>)"

(*******   *n = v+1   split**********)
definition get_n_val :: "mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> bool" ( "_ _ _ loadfrom &n\<^sub>_  _ _ _" [200,200,200,200,200,200,200])
  where
  "get_n_val ms ps \<sigma> t ms' ps' \<sigma>' \<equiv> (\<exists>x y z.  (n ms t = Some x) \<and> A ps x = Some y
                                      \<and> \<sigma> [z \<leftarrow> fst(y)]\<^sub>t \<sigma>'
                                      \<and> ms' = ms \<lparr> n_val := (n_val ms) (t := Some z),
                                                      pc := (pc ms) (t := I4)\<rparr>)"
definition writeto_star_n :: "mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> bool" ( "_ _ _ writeto *n\<^sub>_ newv _ _ _" [200,200,200,200,200,200,200])
  where
  "writeto_star_n ms ps \<sigma> t ms' ps' \<sigma>' \<equiv> (\<exists>x y.  A ps x = Some y
                                                           \<and> n_val ms t = Some (fst(y))
                                      \<and> \<sigma> [fst(y) := (v ms t + 1)]\<^sub>t \<sigma>'
                                      \<and>  ms' = ms \<lparr>pc := (pc ms) (t := I4)\<rparr>)"

(********* free(pop(detached))    idea******************)
definition pop_address :: "mstate \<Rightarrow> posem \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> bool" ("_ _ free(pop[detached(_)]) _ _" [200,200,200,200,200])    \<comment>\<open>pop(detached[tid-1])\<close>
  where
  "pop_address ms ps t ms' ps' \<equiv> (\<exists>i. (A ps i = Some (hd((det ms) t), variable) \<and>
                                       kill ps i ps')) \<and>
                        ms' = ms\<lparr> det := (det ms) (t:= tl ((det ms) t)),
                                  pc := (pc ms) (t := S2) \<rparr> "

                         (* wr_cap := (wr_cap ms) (hd((det ms) t):=None) \<comment>\<open> let go off wr_cap\<close>\<rparr>"    *)

(*******   r[i] = rcu[i]   split**********)
definition load_rcu_to_r :: "mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> T \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> bool" ( "_ _ _ r\<^sub>_[_] = rcu[_] _ _ _" [200,200,200,200,200,200,200,200,200])
  where
  "load_rcu_to_r ms ps \<sigma> t ctr1 ctr2 ms' ps' \<sigma>' \<equiv> ctr1 = ctr2 \<and>
                                    (\<exists>x y.  (A ps y = Some (rcu_0, pointer))
                                      \<and> \<sigma> [x \<leftarrow>(rcu_0 + ctr1)]\<^sub>t \<sigma>'
                                      \<and> ms' = ms \<lparr> r := (r ms) (t := ((r ms) t) (ctr1 :=x)),
                                                      pc := (pc ms) (t := I4) \<rparr>)"

definition enter_rcu :: "mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> bool" ( "_ _ _ rcuenter(_) _ _ _" [200,200,200,200,200,200,200])
  where
  "enter_rcu ms ps \<sigma> t ms' ps' \<sigma>' \<equiv>  (\<exists>x.  (A ps x = Some (rcu_0, pointer))
                                      \<and> (\<sigma> [ (rcu_0+t) := 1 ]\<^sub>t \<sigma>')
                                      \<and> (ms' = ms \<lparr> pc := (pc ms) (t := I4) \<rparr>))"

definition exit_rcu :: "mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> posem \<Rightarrow> surrey_state \<Rightarrow> bool" ( "_ _ _ rcuexit(_) _ _ _" [200,200,200,200,200,200,200])
  where
  "exit_rcu ms ps \<sigma> t ms' ps' \<sigma>' \<equiv>  (\<exists>x.  (A ps x = Some (rcu_0, pointer))
                                      \<and> (\<sigma> [ (rcu_0+t) := 0 ]\<^sub>t \<sigma>')
                                      \<and> (ms' = ms \<lparr> pc := (pc ms) (t := I4) \<rparr>))"

definition setup_r :: "mstate \<Rightarrow> T \<Rightarrow>  mstate \<Rightarrow> bool" ("_ r[N]\<^sub>_ := _" [200])    \<comment>\<open>r[N] = {0}\<close>
  where
  "setup_r  ms t ms' \<equiv> ms' = ms\<lparr>r := \<lambda> x n. if x = t then 0 else r ms x n\<rparr>"

(*\<forall>i. (i\<in> free_addrs) \<longleftrightarrow> rd_cap ms i = {} *)
(*cannot take set wr_cap l ms :=t if wr_cap l ms=t*)
(*must have rd_cap on l (t\<in>rd_cap l ms) to perform wr_cap l ms := t*)
(*capabilities stuff
definition relinquish_rd_cap :: "T \<Rightarrow> mstate \<Rightarrow> mstate" ("give\<^sub>u\<^sub>p _" [200])
  where
  "relinquish_rd_cap t ms \<equiv> ms \<lparr> rd_cap := \<lambda> x. if  t\<in>rd_cap ms x  then rd_cap ms x - {t} else rd_cap ms x \<rparr>"

definition take_rd_cap :: "L \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> mstate" ("take\<^sub>_ _" [200,200])
  where
  "take_rd_cap l t ms \<equiv> ms \<lparr> rd_cap := (rd_cap ms) (l := ((rd_cap ms l) \<union> {t})) \<rparr>"
*)(*decide where to put this^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^*)

definition insert_address :: " T \<Rightarrow> nat \<Rightarrow> mstate \<Rightarrow> mstate" ("insert[detached(_),_]" [200,200])    \<comment>\<open>insert(_, s)\<close>
  where
  "insert_address loc t ms  \<equiv> ms\<lparr> det := (det ms) (t:= (((det ms) t) @ [loc])) \<rparr>"

definition nondet :: " T \<Rightarrow> bool \<Rightarrow> mstate \<Rightarrow> mstate" ("nondet[_,_]" [200])    \<comment>\<open>nondet()\<close>
  where
  "nondet t b ms \<equiv> (ms \<lparr> nondet_val := (nondet_val ms) (t:= b)\<rparr>) "

definition update_pc :: "T \<Rightarrow> PC \<Rightarrow> mstate \<Rightarrow>  mstate" ( "pc[_]:=_" [200,200])
  where
  "update_pc t pc_val ms \<equiv>  ms \<lparr> pc := (pc ms) (t:=pc_val) \<rparr> "

abbreviation inc_ctr :: "T \<Rightarrow> mstate \<Rightarrow> mstate" ( "ctr[_]++" [200])
  where
  "inc_ctr t ms \<equiv>  ms \<lparr> for_ctr := (for_ctr ms) (t:=(for_ctr ms t)+1) \<rparr> "

abbreviation update_ctr :: "T \<Rightarrow> nat \<Rightarrow> mstate \<Rightarrow> mstate" ( "ctr[_]:=_" [200,200])
  where
  "update_ctr t ctr_val ms \<equiv> ms \<lparr> for_ctr := (for_ctr ms) (t:=ctr_val) \<rparr> "

abbreviation rcu_temp_copy :: "mstate \<Rightarrow> surrey_state \<Rightarrow> nat \<Rightarrow> T \<Rightarrow> mstate \<Rightarrow> surrey_state \<Rightarrow> bool" ( "_ _ load(_)\<^sub>_ _ _" [200,200,200,200,200,200])
  where
  "rcu_temp_copy ms \<sigma> ctr_val t ms' \<sigma>'\<equiv> \<exists> v. ((\<sigma> [ v \<leftarrow> (rcu_0 + ctr_val)]\<^sub>t \<sigma>')     \<comment>\<open>read rcu[i]\<close>
                                        \<and> (ms' = ms\<lparr>reg := (reg ms) (t := v),
                                                    pc := (pc ms) (t := S8)\<rparr>)) "

definition cas_step_rcu :: "mstate \<Rightarrow> surrey_state \<Rightarrow>T \<Rightarrow> L \<Rightarrow> V \<Rightarrow> V \<Rightarrow> mstate \<Rightarrow>  surrey_state \<Rightarrow> bool"
 where
    "cas_step_rcu ms \<sigma> t l cv nv ms' \<sigma>'\<equiv>           \<comment>\<open>CAS(&C,s,n)\<close>
       \<exists> w ts'. w \<in> visible_writes \<sigma> t l \<and>
               w \<notin> covered \<sigma> \<and>
               valid_fresh_ts \<sigma> w ts' \<and>
       \<sigma>' = fst(CAS t w cv nv \<sigma> ts')
       \<and> (ms' = ms\<lparr>CAS_succ := (CAS_succ ms) (t := snd(CAS t w cv nv \<sigma> ts')),
                         pc := (pc ms) (t := I12),
                         wr_cap := (wr_cap ms) (cv := Some t)\<rparr>)"           \<comment>\<open>acquire wr_cap on location\<close>

(*==========================   Thread behaviour   =================================*)

section \<open>Reclaim Method\<close>
definition reclaim :: "PC \<Rightarrow> T \<Rightarrow> L \<Rightarrow>  mstate \<Rightarrow> surrey_state \<Rightarrow> mstate \<Rightarrow> surrey_state \<Rightarrow> bool " where
"reclaim pcr t loc ms \<sigma> ms' \<sigma>' \<equiv>
case pcr of
   R1 \<Rightarrow> (ms' = ((insert[detached(t),loc]) \<circ> (pc[t]:=R2)) ms) \<and> \<sigma> =\<sigma>'
|  R2 \<Rightarrow> (\<exists>b. (b\<in>{True,False} \<and> ms' = (nondet[t,b] \<circ> pc[t]:=R2) ms)) \<and> \<sigma> =\<sigma>'
|  R3 \<Rightarrow> if (nondet_val ms t) = True
            then ms' = (pc[t]:=S1)  ms    \<and> \<sigma> =\<sigma>'
               \<comment>\<open> sync() \<close>
            else ms' = (pc[t]:=I14) ms    \<and> \<sigma> =\<sigma>'    \<comment>\<open> return to inc() \<close>
|  R4 \<Rightarrow> if (det ms t \<noteq> [])
            then ms' = (pc[t]:=R5)  ms    \<and> \<sigma> =\<sigma>'
            else ms' = (pc[t]:=I14) ms    \<and> \<sigma> =\<sigma>'    \<comment>\<open> return to inc() \<close>
|  R5 \<Rightarrow> (ms'= ((pop[detached(t)]) \<circ> (pc[t]:=R4)) ms)  \<and> \<sigma> =\<sigma>'"

section \<open>Sync Method\<close>
definition synch :: "PC \<Rightarrow> T \<Rightarrow>  mstate \<Rightarrow> surrey_state \<Rightarrow> mstate \<Rightarrow> surrey_state \<Rightarrow> bool " where
"synch pcr t ms \<sigma> ms' \<sigma>' \<equiv>
case pcr of
   S1 \<Rightarrow> ms' = ((r[N]\<^sub>t := 0) \<circ> ctr[t]:=0 \<circ> pc[t]:=S2) ms'    \<and> \<sigma> =\<sigma>'
|  S2 \<Rightarrow> if (for_ctr ms t < T_max)
            then ms' = (pc[t]:=S3) ms    \<and> \<sigma> =\<sigma>'
            else ms' = (pc[t]:=S4) ms    \<and> \<sigma> =\<sigma>'
|  S3 \<Rightarrow> (ms \<sigma> r[t,(for_ctr ms t)]:=rcuequiv ms' \<sigma>')
|  S4 \<Rightarrow> ms' = (ctr[t]:=0 \<circ> pc[t]:=S5) ms    \<and> \<sigma> =\<sigma>'
|  S5 \<Rightarrow> if (for_ctr ms t < T_max)
            then ms' = (pc[t]:=S6) ms    \<and> \<sigma> =\<sigma>'
            else ms' = (pc[t]:=R4) ms    \<and> \<sigma> =\<sigma>'        \<comment>\<open> return to Reclaim (R4)\<close>
|  S6 \<Rightarrow> if r ms t (for_ctr ms t) = 0
            then ms' = (pc[t]:=S7) ms    \<and> \<sigma> =\<sigma>'
            else ms' = (pc[t]:=S8) ms    \<and> \<sigma> =\<sigma>'
|  S7 \<Rightarrow> ms \<sigma> load(for_ctr ms t)\<^sub>t ms' \<sigma>'         \<comment>\<open> load \<langle>rcu[i]\<rangle> into reg, increment pc\<close>
|  S8 \<Rightarrow> if reg ms t = 1                         \<comment>\<open> test while \<langle>rcu[i]\<rangle>\<close>
            then True
            else ms' = (ctr[t]++ \<circ> pc[t]:=S5) ms    \<and> \<sigma> =\<sigma>'"

section \<open>Increment Method\<close>
definition increment :: "PC \<Rightarrow> T \<Rightarrow>  mstate \<Rightarrow> surrey_state \<Rightarrow> mstate \<Rightarrow> surrey_state \<Rightarrow> bool " where
"increment pcr t ms \<sigma> ms' \<sigma>' \<equiv>
case pcr of
   I1  \<Rightarrow> (ms int\<^sub>v[t] ms') \<and> \<sigma> = \<sigma>'       \<comment>\<open> int v, v=0\<close>
|  I2  \<Rightarrow> (ms int\<^sub>n[t] ms') \<and> \<sigma> = \<sigma>'       \<comment>\<open> int n\<close>
|  I3  \<Rightarrow> (ms int\<^sub>s[t] ms') \<and> \<sigma> = \<sigma>'       \<comment>\<open> int s\<close>
|  I4  \<Rightarrow> (ms \<sigma> newint[*n, t] ms' \<sigma>')     \<comment>\<open> *n=new int\<close>
|  I5  \<Rightarrow> (\<sigma> enter[t] \<sigma>) \<and> (ms' = (pc[t]:=I6) ms)                \<comment>\<open> rcu_enter()\<close>
|  I6  \<Rightarrow> (\<sigma> exit[t] \<sigma>)  \<and> (ms' = ((pc[t]:=I7) \<circ> (give\<^sub>u\<^sub>p t)) ms)  \<comment>\<open> rcu_exit()     relinquish all read capabilities\<close>
|  I7  \<Rightarrow> (\<sigma> enter[t] \<sigma>) \<and> (ms' = (pc[t]:=I8) ms)                \<comment>\<open> rcu_enter()\<close>
|  I8  \<Rightarrow> ms \<sigma> load[(s ms t),C,t] ms' \<sigma>'                                \<comment>\<open> s=C \<close>
|  I9  \<Rightarrow> (ms' = ((pc[t]:=I10)\<circ> (v[t]:=(s ms t))) ms)     \<and> \<sigma> = \<sigma>'      \<comment>\<open> v=*s ******    redundant step, if we assume Allocation map to not have weak behaviour\<close>
|  I10 \<Rightarrow> (ms' = ((pc[t]:=I11)\<circ> (*n[t]:=(v ms t + 1))) ms) \<and> \<sigma> = \<sigma>'      \<comment>\<open> *n=v+1 ****** \<close>
|  I11 \<Rightarrow> cas_step_rcu ms \<sigma> t C (s ms t) (n ms t) ms' \<sigma>'          \<comment>\<open> CAS(&C,s,n) \<close>
|  I12 \<Rightarrow> if CAS_succ ms t
            then (ms' = (pc[t]:=I13) ms)
            else (ms' = (pc[t]:=I6) ms)
|  I13 \<Rightarrow> (\<sigma> exit[t] \<sigma>) \<and> (ms' = ((pc[t]:=R1) \<circ> (give\<^sub>u\<^sub>p t)) ms)    \<comment>\<open> rcu_exit()     relinquish all read capabilities\<close>
        \<comment>\<open>reclaim(s)\<close>
|  I14 \<Rightarrow> (ms' = (pc[t]:=I15) ms) \<and> \<sigma> = \<sigma>'   \<comment>\<open> return(v) \<close>"

definition "init ms  \<equiv>  (\<forall>t. (t<T_max)\<longrightarrow> pc ms t = I1
                                        \<and> v ms t = 0
                                        \<and> n ms t = 0
                                        \<and> s ms t = 0
                                        \<and> det ms t = []
                                        \<and> for_ctr ms t = 0
                                        \<and> res ms t = False
                                        \<and> reg ms t = 0

                                        \<and> nondet_val ms t = False
                                        \<and> CAS_succ ms t = False
                                        \<and> rd_cap ms t = {}
                                        \<and> wr_cap ms t = None)
\<comment>\<open> free_addrs ms t = ?)\<close>
                     \<and> (\<forall>t i. (t<T_max \<and> i<T_max)\<longrightarrow> r ms t i = 0)"

(*load stores value to a location in weak memory
s=C \<longrightarrow> s.next = C.next
v=*s \<longrightarrow> v = s.next.val
n_star <--_t fst(A(n ms t))
n_star =_t v+1
n*=v+1 \<longrightarrow> n.next.val = v+1

memory model:   ____________C____s____n________old__new_____________n2________________
             ...|___||___||x52||x54||x56||___||x78||x80||___||___||x90||___||___||___|
                |___||___||x78||x78||x80||___||_0_||_x_||___||___||___||___||___||___| ...
                ____________C____s____n1_______old__new_____________n2________________
             ...|___||___||_C_||_s_||_n1||___||x78||x80||___||___||x90||___||___||___|
                |___||___||x80||___||x80||___||Nul||_1_||___||___||___||___||___||___| ...

[(s ms t) :=  C]
[v <-_t (s ms t)]
[fst(A(n ms t)) :=_t v+1]

    ____                          ______
    |__|  <-- Location            |0x52|
C=  |__|  <-- C.next    (C.val)   |0x78|    <-- old.loc
    ____                          ______
    |__|  <-- Location            |0x54|
s=  |__|  <-- s.next    (s.val)   |0x80|
    ____                          ______
    |__|  <-- Location = s.next   |0x80|
v=  |__|  <-- v.val               |__2_|
    ____                          ______
    |__|  <-- Location            |0x56|
n=  |__|  <-- n.next    (n.val)   |0x80|

rd_cap(i) \<noteq> {} \<longrightarrow> A(i) --\\<longrightarrow> none
wr_cap(i) \<noteq> {} \<longrightarrow> A(i) --\\<longrightarrow> none
wr_cap(i) \<noteq> {} \<longrightarrow> cannot acquire rd_cap(i)

A(0) = (x52,pointer)
A(1) = (x78, variable)

A(0) = (x52,pointer)
A(1) = (x78,variable)

*A(0) = 0
M(x78,variable) = 0
M(x52,pointer) = x78

[load_C ms t <--_t C]     <---- returns C
*A(0) = {x | \<exists>i. i=x \<and> fst(A(i)) = load_C}

***or equivalently***

\<exists>j. A(j) = (load_C, variable)
[load_old ms t <--_t load_C]    <---- returns old

*)

lemma "reclaim R2 t l ms \<sigma> ms' \<sigma>'
  \<Longrightarrow>  (nondet_val ms' t) \<in>{True,False}"
  by simp


(*
This file is generated by Cogent

*)

theory ExampleSanityCheck
imports "CogentCRefinement.Deep_Embedding_Auto"
"CogentCRefinement.Cogent_Corres"
"CogentCRefinement.Tidy"
"CogentCRefinement.Heap_Relation_Generation"
"CogentCRefinement.Type_Relation_Generation"
"CogentCRefinement.Dargent_Custom_Get_Set"
"serialise/build_main/Main_dargentfull_ACInstall"
"serialise/build_main/Main_dargentfull_TypeProof"
begin

(* C type and value relations *)

instantiation unit_t_C :: cogent_C_val
begin
  definition type_rel_unit_t_C_def: "\<And> r. type_rel r (_ :: unit_t_C itself) \<equiv> r = RUnit"
  definition val_rel_unit_t_C_def: "\<And> uv. val_rel uv (_ :: unit_t_C) \<equiv> uv = UUnit"
  instance ..
end

instantiation bool_t_C :: cogent_C_val
begin
definition type_rel_bool_t_C_def: "\<And> typ. type_rel typ (_ :: bool_t_C itself) \<equiv> (typ = RPrim Bool)"
definition val_rel_bool_t_C_def:
   "\<And> uv x. val_rel uv (x :: bool_t_C) \<equiv> (boolean_C x = 0 \<or> boolean_C x = 1) \<and>
     uv = UPrim (LBool (boolean_C x \<noteq> 0))"
instance ..
end
context update_sem_init begin
lemmas corres_if = corres_if_base[where bool_val' = boolean_C,
                     OF _ _ val_rel_bool_t_C_def[THEN meta_eq_to_obj_eq, THEN iffD1]]
end

lemmas val_rel_simps[ValRelSimp] =
  val_rel_word
  val_rel_ptr_def
  val_rel_unit_def
  val_rel_unit_t_C_def
  val_rel_bool_t_C_def
  val_rel_fun_tag

lemmas type_rel_simps[TypeRelSimp] =
  type_rel_word
  type_rel_ptr_def
  type_rel_unit_def
  type_rel_unit_t_C_def
  type_rel_bool_t_C_def

(* C heap type class *)
class cogent_C_heap = cogent_C_val +
  fixes is_valid    :: "lifted_globals \<Rightarrow> 'a ptr \<Rightarrow> bool"
  fixes heap        :: "lifted_globals \<Rightarrow> 'a ptr \<Rightarrow> 'a"
(* generate direct definitions of custom getter/setters (for custom layouts) by
   inspecting their monadic definitions *)
setup \<open> generate_isa_getset_records_for_file "main_dargentfull.c" @{locale main_dargentfull} \<close>
local_setup \<open> local_setup_val_rel_type_rel_put_them_in_buckets "main_dargentfull.c" \<close>
local_setup \<open> local_setup_instantiate_cogent_C_heaps_store_them_in_buckets "main_dargentfull.c" \<close>
locale Main_dargentfull = "main_dargentfull" + update_sem_init
begin

term deref_d5_get_b
thm val_rel_t1_C_def
thm val_rel_t2_C_def
thm deref_d7_get_a_def
find_consts name:data_C

definition find_position :: "nat \<Rightarrow> nat \<Rightarrow> nat \<times> nat"
  where "find_position si offset  = (offset div si, offset mod si)"

lemma " find_position 32 1 = (0, 1)"
  by (simp add:find_position_def)
term index

fun raw_get_bit :: "(('a::len0) word)['n::finite] \<Rightarrow> nat \<Rightarrow> 'a word"
  where "raw_get_bit arr pos =
                (let (byte, off) = find_position LENGTH('a) pos in
                 arr.[byte] && 2^off )"

fun get_bit :: "(('a::len0) word)['n::finite] \<Rightarrow> nat \<Rightarrow> bool"
  where "get_bit arr pos =
                (let (byte, off) = find_position LENGTH('a) pos in
                 arr.[byte] && 2^off = 0)"

definition "lay_a1 = LayBitRange (8, 16)"
thm layout_taken_bit_list
thm refl[of "layout_taken_bit_list (lay_a1)", simplified lay_a1_def, simplified
     layout_taken_bit_list.simps bitrange_taken_bit_list.simps]
value "layout_taken_bit_list (lay_a1)"
lemma "(5 :: nat) = x"
apply (simp add:numeral.simps)
term deref_d7_get_a
find_consts ptr_layout
lemma "
  (\<forall> x\<in> set(layout_taken_bit_list lay_a1).
  raw_get_bit (t1_C.data_C s) x = raw_get_bit (t1_C.data_C t) x)
\<Longrightarrow>
  deref_d3_get_a s = deref_d3_get_a t"
  apply(simp add:lay_a1_def find_position_def)
  apply(erule conjE)+
  apply(tactic \<open>custom_get_set_different_field_tac @{context} 1\<close>)
  done
term deref_d9_set_a
term data_C
lemma "layout_taken_bit_list (LayBitRange(32,0)) = x"
  apply(simp add:upt.simps)
  find_theorems upt
  value "[0..<32]"
  find_theorems less name:cases
  thm nat_less_cases'
  thm lessE
  value "32 :: nat"
lemma "
x < 32
 \<Longrightarrow>
 x\<notin> set(layout_taken_bit_list lay_a1)
\<Longrightarrow>
raw_get_bit (t1_C.data_C (deref_d9_set_a s b)) x =
raw_get_bit (t1_C.data_C s) x "
  apply(simp only:numeral.simps)
 apply(simp add:lay_a1_def find_position_def)
 apply(elim less_zeroE  less_SucE)
  apply(tactic \<open>custom_get_set_different_field_tac @{context} 1\<close>)+
  done

(* The get/set lemmas that must be proven *)
ML \<open>val lems = mk_getset_lems "main_dargentfull.c" @{context} \<close>
ML \<open>lems  |> map (string_of_getset_lem @{context})|> map tracing\<close>

(* This proves the get/set lemmas (currently by cheating!) *)
local_setup \<open>local_setup_getset_lemmas "main_dargentfull.c" \<close>

term data_C

(* Relation between program heaps *)
definition
  heap_rel_ptr ::
  "(funtyp, abstyp, ptrtyp) store \<Rightarrow> lifted_globals \<Rightarrow>
   ('a :: cogent_C_heap) ptr \<Rightarrow> bool"
where
  "\<And> \<sigma> h p.
    heap_rel_ptr \<sigma> h p \<equiv>
   (\<forall> uv.
     \<sigma> (ptr_val p) = Some uv \<longrightarrow>
     type_rel (uval_repr uv) TYPE('a) \<longrightarrow>
     is_valid h p \<and> val_rel uv (heap h p))"

lemma heap_rel_ptr_meta:
  "heap_rel_ptr = heap_rel_meta is_valid heap"
  by (simp add: heap_rel_ptr_def[abs_def] heap_rel_meta_def[abs_def])

local_setup \<open> local_setup_heap_rel "main_dargentfull.c" \<close>

definition state_rel :: "((funtyp, abstyp, ptrtyp) store \<times> lifted_globals) set"
where
  "state_rel  = {(\<sigma>, h). heap_rel \<sigma> h}"

(* Generating the specialised take and put lemmas *)

local_setup \<open> local_setup_take_put_member_case_esac_specialised_lemmas "main_dargentfull.c" \<close>
local_setup \<open> fold tidy_C_fun_def' Cogent_functions \<close>

end (* of locale *)

end


(*  Title:      HOL/Auth/n_german_lemma_on_inv__37.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__37 imports n_german_base
begin
section{*All lemmas on causal relation between inv__37 and some rule r*}
lemma n_RecvReqSVsinv__37:
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__37  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__37  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__37:
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__37  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__37  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_SendInv__part__0Vsinv__37:
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__37  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__Inv2 where a2:"p__Inv2\<le>N\<and>f=inv__37  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_SendInv__part__1Vsinv__37:
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__37  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__Inv2 where a2:"p__Inv2\<le>N\<and>f=inv__37  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_SendInvAckVsinv__37:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)" and
a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__37  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__37  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__37:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)" and
a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__37  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__37  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 "((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 "?P1 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__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__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_SendGntSVsinv__37:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)" and
a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__37  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__37  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_SendGntEVsinv__37:
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__37  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__37  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_RecvGntSVsinv__37:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)" and
a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__37  p__Inv2)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntS  i" apply fastforce done
from a2 obtain p__Inv2 where a2:"p__Inv2\<le>N\<and>f=inv__37  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 GntS)) (eqn (IVar (Ident ''ExGntd'')) (Const true))))" 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_RecvGntEVsinv__37:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)" and
a2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__37  p__Inv2)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_RecvGntE  i" apply fastforce done
from a2 obtain p__Inv2 where a2:"p__Inv2\<le>N\<and>f=inv__37  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_SendReqE__part__1Vsinv__37:
  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__37  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_StoreVsinv__37:
  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__37  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

lemma n_SendReqE__part__0Vsinv__37:
  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__37  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

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

end