section \<open>Evaluation of Expressions\<close>
theory Eval
imports
  "../Syntax/Program" Arith Memory
begin

  text \<open>We start with defining a local configuration, that is the
    configuration as seen within a function context.

    It consists of valuations for the global variables, and for the local
    variables and parameters.

    A valuation maps variables to their addresses in memory
  \<close>

  type_synonym valuation = "vname \<rightharpoonup> addr"

  text \<open>The result of an evaluation can either be an
    lvalue, represented by an address, or a plain value (right value)
  \<close>

  datatype res = L addr | R val
  hide_const (open) L R

  context
    fixes EV :: valuation -- \<open>Effective valuation, combined globals,locals,params\<close>
    fixes \<mu> :: memory -- \<open>Memory content. Note that expressions do not modify memory
      in our simple fragment. This saves us from reasoning about sequence points and the order
      in which effects become visible.\<close>
  begin

    primrec to_rval :: "res \<hookrightarrow> val"
      -- \<open>Convert operand to plain value, and array to pointer\<close>
    where
      "to_rval (res.L addr) = do {
        r \<leftarrow> eget (l_addr addr) \<mu>;
        assert (r\<noteq>val.Uninit) uninitalized_error;

        if (val.is_Array r) then do {
          addr \<leftarrow> cnv_array_to_eptr \<mu> addr;
          return (val.Addr addr)
        } else
          return r
        }"
    | "to_rval (res.R v) = do {
        assert (v\<noteq>val.Uninit) uninitalized_error;
        return v
      }"

    primrec to_lval :: "res \<hookrightarrow> addr"
      -- \<open>Convert operand to plain value\<close>
    where
      "to_lval (res.L addr) = return addr"
    | "to_lval (res.R v) = EAssert type_error"

    fun to_int_aux :: "val \<hookrightarrow> int_val" where
      "to_int_aux (val.I i) = return i"
    | "to_int_aux _ = EAssert type_error"

    fun to_bool_aux :: "val \<hookrightarrow> bool" where
      "to_bool_aux (val.I i) = return (i2b i)"
    | "to_bool_aux (val.Addr addr) = do {
        assert (is_allocated \<mu> addr) pointer_error;
        return True
      }"
    | "to_bool_aux (val.Null) = return False"
    | "to_bool_aux _ = EAssert type_error"

    definition "to_int \<equiv> to_rval #> to_int_aux"

    definition "un_arith_op f r \<equiv> do {
      i \<leftarrow> to_int r;
      i \<leftarrow> f i;
      return (res.R (val.I i))
    }"

    definition to_ptr :: "res \<hookrightarrow> addr" where
      "to_ptr x \<equiv> do {
        x \<leftarrow> to_rval x;
        case x of
          val.Addr addr \<Rightarrow> return (addr)
        | val.Null \<Rightarrow> EAssert pointer_error
        | _ \<Rightarrow> EAssert type_error
      }"

    primrec eval0 :: "op0 \<hookrightarrow> res" where
      "eval0 (op0.Const i) = do {v \<leftarrow> mk_repr i; return (res.R (val.I v))}"
    | "eval0 (op0.Null) = return (res.R val.Null)"
    | "eval0 (op0.Var x) = (case EV x of
        None \<Rightarrow> EAssert type_error
      | Some addr \<Rightarrow> return (res.L addr)
      )"

    definition deref_op :: "res \<hookrightarrow> res" where
      "deref_op x \<equiv> do {
        addr \<leftarrow> to_ptr x;
        return (res.L addr)
      }"

    primrec ref_op :: "res \<hookrightarrow> res" where
      "ref_op (res.L addr) = return (res.R (val.Addr addr))"
    | "ref_op (res.R _) = EAssert type_error"

    fun memb_op :: "mname \<Rightarrow> res \<hookrightarrow> res" where
      "memb_op name (res.L addr) = do {
        addr \<leftarrow> memb_addr \<mu> name addr;
        return (res.L addr)
      }"
    (*| "memb_op name (res.R (val.Struct ms)) = do {
        v \<leftarrow> elookup (\<lambda>_. type_error) (map_of ms) name;
        return (res.R v)
      }"*)
    | "memb_op _ (res.R _) = EAssert type_error"

    definition membp_op :: "mname \<Rightarrow> res \<hookrightarrow> res" where
      "membp_op name r = do {
        r \<leftarrow> deref_op r;
        memb_op name r
      }"

    primrec eval1 :: "op1 \<Rightarrow> res \<hookrightarrow> res" where
      "eval1 op1.UMinus v = un_arith_op iop_uminus v"
    | "eval1 op1.Not v = un_arith_op iop_Not v"
    | "eval1 op1.BNot v = un_arith_op iop_BNot v"
    | "eval1 op1.Deref v = deref_op v"
    | "eval1 op1.Ref v = ref_op v"
    | "eval1 (op1.Memb name) v = memb_op name v"
    | "eval1 (op1.Membp name) v = membp_op name v"

    definition "rvop2 f v1 v2 \<equiv> do { v1 \<leftarrow> to_rval v1; v2 \<leftarrow> to_rval v2; f v1 v2 }"

    fun plus_op :: "val \<Rightarrow> val \<hookrightarrow> res" where
      "plus_op (val.Addr addr) (val.I i) = do {
        let i = sint i;
        addr \<leftarrow> index_addr \<mu> i addr;
        return (res.R (val.Addr addr))
      }"
    | "plus_op (val.Null) (val.I _) = EAssert pointer_error"
    | "plus_op (val.I x1) (val.I x2) = do {
        r \<leftarrow> iop_plus x1 x2;
        return (res.R (val.I r))
      }"
    | "plus_op _ _ = EAssert type_error"

    fun minus_op :: "val \<Rightarrow> val \<hookrightarrow> res" where
      "minus_op (val.Addr addr1) (val.Addr addr2) = do {
        i \<leftarrow> diff_addr \<mu> addr1 addr2;
        i \<leftarrow> mk_repr i;
        return (res.R (val.I i))
      }"
    | "minus_op (val.Null) (val.Addr _) = EAssert pointer_error"
    | "minus_op (val.Addr _) (val.Null) = EAssert pointer_error"
    | "minus_op (val.Null) (val.Null) = EAssert pointer_error"
    | "minus_op (val.I x1) (val.I x2) = do {
        r \<leftarrow> iop_minus x1 x2;
        return (res.R (val.I r))
      }"
    | "minus_op _ _ = EAssert type_error"

    fun eq_op :: "val \<Rightarrow> val \<hookrightarrow> res" where
      "eq_op (val.Addr addr1) (val.Addr addr2) = do {
        r \<leftarrow> addr_eq \<mu> addr1 addr2;
        return (res.R (val.I (b2i r)))
      }"
    | "eq_op (val.Addr _) (val.Null) = return (res.R (val.I (b2i False)))"
    | "eq_op (val.Null) (val.Addr _) = return (res.R (val.I (b2i False)))"
    | "eq_op (val.Null) (val.Null) = return (res.R (val.I (b2i True)))"
    | "eq_op (val.I x1) (val.I x2) = do {
        r \<leftarrow> iop_eq x1 x2;
        return (res.R (val.I r))
      }"
    | "eq_op _ _ = EAssert type_error"

    fun less_op :: "val \<Rightarrow> val \<hookrightarrow> res" where
      "less_op (val.Addr addr1) (val.Addr addr2) = do {
        r \<leftarrow> addr_less \<mu> addr1 addr2;
        return (res.R (val.I (b2i r)))
      }"
    | "less_op (val.Addr _) (val.Null) = EAssert pointer_error"
    | "less_op (val.Null) (val.Addr _) = EAssert pointer_error"
    | "less_op (val.Null) (val.Null) = return (res.R (val.I (b2i False)))"
    | "less_op (val.I x1) (val.I x2) = do {
        r \<leftarrow> iop_less x1 x2;
        return (res.R (val.I r))
      }"
    | "less_op _ _ = EAssert type_error"

    fun le_op :: "val \<Rightarrow> val \<hookrightarrow> res" where
      "le_op (val.Addr addr1) (val.Addr addr2) = do {
        r \<leftarrow> addr_leq \<mu> addr1 addr2;
        return (res.R (val.I (b2i r)))
      }"
    | "le_op (val.Addr _) (val.Null) = EAssert pointer_error"
    | "le_op (val.Null) (val.Addr _) = EAssert pointer_error"
    | "le_op (val.Null) (val.Null) = return (res.R (val.I (b2i True)))"
    | "le_op (val.I x1) (val.I x2) = do {
        r \<leftarrow> iop_le x1 x2;
        return (res.R (val.I r))
      }"
    | "le_op _ _ = EAssert type_error"

    definition "bin_arith_op f r1 r2 \<equiv> do {
      i1 \<leftarrow> to_int r1;
      i2 \<leftarrow> to_int r2;
      i \<leftarrow> f i1 i2;
      return (res.R (val.I i))
    }"

    definition "index_op v1 v2 \<equiv> do {
      r \<leftarrow> plus_op v1 v2;
      r \<leftarrow> deref_op r;
      return r
    }"

    primrec eval2 :: "op2 \<Rightarrow> res \<Rightarrow> res \<hookrightarrow> res" where
      "eval2 op2.Plus v1 v2 = rvop2 plus_op v1 v2"
    | "eval2 op2.Minus v1 v2 = rvop2 minus_op v1 v2"

    | "eval2 op2.Mult v1 v2 = bin_arith_op iop_mult v1 v2"
    | "eval2 op2.Div v1 v2 = bin_arith_op iop_div v1 v2"
    | "eval2 op2.Mod v1 v2 = bin_arith_op iop_mod v1 v2"

    | "eval2 op2.Less v1 v2 = rvop2 less_op v1 v2"
    | "eval2 op2.Leq v1 v2 = rvop2 le_op v1 v2"
    | "eval2 op2.Eq v1 v2 = rvop2 eq_op v1 v2"

    | "eval2 op2.And v1 v2 = bin_arith_op iop_And v1 v2"
    | "eval2 op2.Or v1 v2 = bin_arith_op iop_Or v1 v2"
    | "eval2 op2.BAnd v1 v2 = bin_arith_op iop_BAnd v1 v2"
    | "eval2 op2.BOr v1 v2 = bin_arith_op iop_BOr v1 v2"
    | "eval2 op2.BXor v1 v2 = bin_arith_op iop_BXor v1 v2"

    | "eval2 op2.Index v1 v2 = rvop2 index_op v1 v2"

    primrec eval_exp :: "exp \<hookrightarrow> res" where
      "eval_exp (exp.E0 f) = eval0 f"
    | "eval_exp (exp.E1 f e) = do {
        r \<leftarrow> eval_exp e;
        eval1 f r
      }"
    | "eval_exp (exp.E2 f e1 e2) = do {
        r1 \<leftarrow> eval_exp e1;
        r2 \<leftarrow> eval_exp e2;   (* TODO/FIXME: We loose short-circuit semantics, i.e.,
          the behaviour of both expressions must be defined. As expressions have no
          side effects, this only limits the defined expressions, but does not introduce
          non-conforming defined behaviour. *)
        eval2 f r1 r2
      }"

    text \<open>C99: 6.5.2.1.2: The definition of the subscript operator $[]$ is that $E1[E2]$ is identical to $(*((E1)+(E2)))$\<close>
    lemma index_alt_repr: "eval_exp (exp.E2 op2.Index v1 v2) = eval_exp (exp.E1 op1.Deref (exp.E2 op2.Plus v1 v2))"
      by (simp add: index_op_def[abs_def] rvop2_def)

  end

  code_thms eval_exp
  export_code eval_exp checking SML

  subsection \<open>Theorems about Evaluation\<close>
  text \<open>Theorems to ensure confidence in the semantics.\<close>

  lemma direct_lval_mem_indep:
    -- \<open>Direct lval-expressions are independent of effects on the memory\<close>
    assumes "direct_lval_exp e"
    shows "eval_exp SM \<mu> e = eval_exp SM \<mu>' e"
  proof -
    (* Note: Extending this lemma to structure member access requires some argumentation that
      the static memory where the structure is stored has not been destroyed in between \<mu> and \<mu>'.
      *)
    show ?thesis
      using assms
      apply (induction e rule: direct_lval_exp.induct)
      apply auto
      done

  qed

end


(*  Title:      JinjaThreads/Common/WellForm.thy
    Author:     Tobias Nipkow, Andreas Lochbihler

    Based on the Jinja theory Common/WellForm.thy by Tobias Nipkow
*)

header {* \isaheader{Generic Well-formedness of programs} *}

theory WellForm
imports
  SystemClasses
  ExternalCall
begin

text {*\noindent This theory defines global well-formedness conditions
for programs but does not look inside method bodies.  Hence it works
for both Jinja and JVM programs. Well-typing of expressions is defined
elsewhere (in theory @{text WellType}).

Because JinjaThreads does not have method overloading, its policy for method
overriding is the classical one: \emph{covariant in the result type
but contravariant in the argument types.} This means the result type
of the overriding method becomes more specific, the argument types
become more general.
*}

type_synonym 'm wf_mdecl_test = "'m prog \<Rightarrow> cname \<Rightarrow> 'm mdecl \<Rightarrow> bool"

definition wf_fdecl :: "'m prog \<Rightarrow> fdecl \<Rightarrow> bool"
where "wf_fdecl P \<equiv> \<lambda>(F,T,fm). is_type P T"

definition wf_mdecl :: "'m wf_mdecl_test \<Rightarrow> 'm prog \<Rightarrow> cname \<Rightarrow> 'm mdecl' \<Rightarrow> bool" where
  "wf_mdecl wf_md P C \<equiv>
  \<lambda>(M,Ts,T,m). (\<forall>T\<in>set Ts. is_type P T) \<and> is_type P T \<and>
    (case m of Native \<Rightarrow> C\<bullet>M(Ts) :: T | \<lfloor>mb\<rfloor> \<Rightarrow> wf_md P C (M,Ts,T,mb))"

fun wf_overriding :: "'m prog \<Rightarrow> cname \<Rightarrow> 'm mdecl' \<Rightarrow> bool"
where
  "wf_overriding P D (M,Ts,T,m) =
  (\<forall>D' Ts' T' m'. P \<turnstile> D sees M:Ts' \<rightarrow> T' = m' in D' \<longrightarrow> P \<turnstile> Ts' [\<le>] Ts \<and> P \<turnstile> T \<le> T')"

definition wf_cdecl :: "'m wf_mdecl_test \<Rightarrow> 'm prog \<Rightarrow> 'm cdecl \<Rightarrow> bool"
where
  "wf_cdecl wf_md P  \<equiv>  \<lambda>(C,(D,fs,ms)).
  (\<forall>f\<in>set fs. wf_fdecl P f) \<and> distinct_fst fs \<and>
  (\<forall>m\<in>set ms. wf_mdecl wf_md P C m) \<and>
  distinct_fst ms \<and>
  (C \<noteq> Object \<longrightarrow>
   is_class P D \<and> \<not> P \<turnstile> D \<preceq>\<^sup>* C \<and>
   (\<forall>m\<in>set ms. wf_overriding P D m)) \<and>
  (C = Thread \<longrightarrow> (\<exists>m. (run, [], Void, m) \<in> set ms))"

definition wf_prog :: "'m wf_mdecl_test \<Rightarrow> 'm prog \<Rightarrow> bool"
where
  "wf_prog wf_md P \<longleftrightarrow> wf_syscls P \<and> distinct_fst (classes P) \<and> (\<forall>c \<in> set (classes P). wf_cdecl wf_md P c)"

lemma wf_prog_def2:
  "wf_prog wf_md P \<longleftrightarrow> wf_syscls P \<and> (\<forall>C rest. class P C = \<lfloor>rest\<rfloor> \<longrightarrow> wf_cdecl wf_md P (C, rest)) \<and> distinct_fst (classes P)"
by(cases P)(auto simp add: wf_prog_def dest: map_of_SomeD map_of_SomeI)

subsection{* Well-formedness lemmas *}

lemma wf_prog_wf_syscls: "wf_prog wf_md P \<Longrightarrow> wf_syscls P"
by(simp add: wf_prog_def)

lemma class_wf:
  "\<lbrakk>class P C = Some c; wf_prog wf_md P\<rbrakk> \<Longrightarrow> wf_cdecl wf_md P (C,c)"
by (cases P) (fastforce dest: map_of_SomeD simp add: wf_prog_def)

lemma [simp]:
  assumes "wf_prog wf_md P"
  shows is_class_Object: "is_class P Object"
  and is_class_Thread: "is_class P Thread"
using wf_prog_wf_syscls[OF assms] by simp_all

lemma xcpt_subcls_Throwable:
  "\<lbrakk> C \<in> sys_xcpts; wf_prog wf_md P \<rbrakk> \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* Throwable"
by(simp add: wf_prog_wf_syscls wf_syscls_xcpt_subcls_Throwable)

lemma is_class_Throwable:
  "wf_prog wf_md P \<Longrightarrow> is_class P Throwable"
by(rule wf_prog_wf_syscls wf_syscls_is_class_Throwable)+

lemma is_class_sub_Throwable:
  "\<lbrakk> wf_prog wf_md P; P \<turnstile> C \<preceq>\<^sup>* Throwable \<rbrakk> \<Longrightarrow> is_class P C"
by(rule wf_syscls_is_class_sub_Throwable[OF wf_prog_wf_syscls])

lemma is_class_xcpt:
  "\<lbrakk> C \<in> sys_xcpts; wf_prog wf_md P \<rbrakk> \<Longrightarrow> is_class P C"
by(rule wf_syscls_is_class_xcpt[OF _ wf_prog_wf_syscls])

context heap_base begin
lemma wf_preallocatedE:
  assumes "wf_prog wf_md P"
  and "preallocated h"
  and "C \<in> sys_xcpts"
  obtains "typeof_addr h (addr_of_sys_xcpt C) = \<lfloor>Class_type C\<rfloor>" "P \<turnstile> C \<preceq>\<^sup>* Throwable"
proof -
  from `preallocated h` `C \<in> sys_xcpts` have "typeof_addr h (addr_of_sys_xcpt C) = \<lfloor>Class_type C\<rfloor>"
    by(rule typeof_addr_sys_xcp)
  moreover from `C \<in> sys_xcpts` `wf_prog wf_md P` have "P \<turnstile> C \<preceq>\<^sup>* Throwable" by(rule xcpt_subcls_Throwable)
  ultimately show thesis by(rule that)
qed

lemma wf_preallocatedD:
  assumes "wf_prog wf_md P"
  and "preallocated h"
  and "C \<in> sys_xcpts"
  shows "typeof_addr h (addr_of_sys_xcpt C) = \<lfloor>Class_type C\<rfloor> \<and> P \<turnstile> C \<preceq>\<^sup>* Throwable"
using assms
by(rule wf_preallocatedE) blast

end

lemma (in heap_conf) hconf_start_heap:
  "wf_prog wf_md P \<Longrightarrow> hconf start_heap"
unfolding start_heap_def start_heap_data_def initialization_list_def sys_xcpts_list_def
using hconf_empty
by -(simp add: create_initial_object_simps del: hconf_empty, clarsimp split: prod.split elim!: not_empty_pairE simp del: hconf_empty, drule (1) allocate_Eps, drule (1) hconf_allocate_mono, simp add: is_class_xcpt)+

lemma subcls1_wfD:
  "\<lbrakk> P \<turnstile> C \<prec>\<^sup>1 D; wf_prog wf_md P \<rbrakk> \<Longrightarrow> D \<noteq> C \<and> \<not> (subcls1 P)\<^sup>+\<^sup>+ D C"
apply( frule tranclp.r_into_trancl[where r="subcls1 P"])
apply( drule subcls1D)
apply(clarify)
apply( drule (1) class_wf)
apply( unfold wf_cdecl_def)
apply(rule conjI)
 apply(force)
apply(unfold reflclp_tranclp[symmetric, where r="subcls1 P"])
apply(blast)
done

lemma wf_cdecl_supD:
  "\<lbrakk>wf_cdecl wf_md P (C,D,r); C \<noteq> Object\<rbrakk> \<Longrightarrow> is_class P D"
(*<*)by (auto simp: wf_cdecl_def)(*>*)

lemma subcls_asym:
  "\<lbrakk> wf_prog wf_md P; (subcls1 P)\<^sup>+\<^sup>+ C D \<rbrakk> \<Longrightarrow> \<not> (subcls1 P)\<^sup>+\<^sup>+ D C"
(*<*)
apply(erule tranclp.cases)
apply(fast dest!: subcls1_wfD )
apply(fast dest!: subcls1_wfD intro: tranclp_trans)
done
(*>*)

lemma subcls_irrefl:
  "\<lbrakk> wf_prog wf_md P; (subcls1 P)\<^sup>+\<^sup>+ C D\<rbrakk> \<Longrightarrow> C \<noteq> D"
(*<*)
apply (erule tranclp_trans_induct)
apply  (auto dest: subcls1_wfD subcls_asym)
done
(*>*)

lemma acyclicP_def:
  "acyclicP r \<longleftrightarrow> (\<forall>x. \<not> r^++ x x)"
  unfolding acyclic_def trancl_def
by(auto)

lemma acyclic_subcls1:
  "wf_prog wf_md P \<Longrightarrow> acyclicP (subcls1 P)"
by(unfold acyclicP_def)(fast dest: subcls_irrefl)

lemma finite_conversep: "finite {(x, y). r\<inverse>\<inverse> x y} = finite {(x, y). r x y}"
by(subst finite_converse[unfolded converse_unfold, symmetric]) simp

lemma acyclicP_wf_subcls1:
  "acyclicP (subcls1 P) \<Longrightarrow> wfP ((subcls1 P)\<inverse>\<inverse>)"
unfolding wfP_def
by(rule finite_acyclic_wf)(simp_all only: finite_conversep finite_subcls1 acyclicP_converse)

lemma wf_subcls1:
  "wf_prog wf_md P \<Longrightarrow> wfP ((subcls1 P)\<inverse>\<inverse>)"
by(rule acyclicP_wf_subcls1)(rule acyclic_subcls1)

lemma single_valued_subcls1:
  "wf_prog wf_md G \<Longrightarrow> single_valuedP (subcls1 G)"
(*<*)
by(auto simp:wf_prog_def distinct_fst_def single_valued_def dest!:subcls1D)
(*>*)

lemma subcls_induct:
  "\<lbrakk> wf_prog wf_md P; \<And>C. \<forall>D. (subcls1 P)\<^sup>+\<^sup>+ C D \<longrightarrow> Q D \<Longrightarrow> Q C \<rbrakk> \<Longrightarrow> Q C"
(*<*)
  (is "?A \<Longrightarrow> PROP ?P \<Longrightarrow> _")
proof -
  assume p: "PROP ?P"
  assume ?A thus ?thesis apply -
apply(drule wf_subcls1)
apply(drule wfP_trancl)
apply(simp only: tranclp_converse)
apply(erule_tac a = C in wfP_induct)
apply(rule p)
apply(auto)
done
qed
(*>*)

lemma subcls1_induct_aux:
  "\<lbrakk> is_class P C; wf_prog wf_md P; Q Object;
    \<And>C D fs ms.
    \<lbrakk> C \<noteq> Object; is_class P C; class P C = Some (D,fs,ms) \<and>
      wf_cdecl wf_md P (C,D,fs,ms) \<and> P \<turnstile> C \<prec>\<^sup>1 D \<and> is_class P D \<and> Q D\<rbrakk> \<Longrightarrow> Q C \<rbrakk>
  \<Longrightarrow> Q C"
(*<*)
  (is "?A \<Longrightarrow> ?B \<Longrightarrow> ?C \<Longrightarrow> PROP ?P \<Longrightarrow> _")
proof -
  assume p: "PROP ?P"
  assume ?A ?B ?C thus ?thesis apply -
apply(unfold is_class_def)
apply( rule impE)
prefer 2
apply(   assumption)
prefer 2
apply(  assumption)
apply( erule thin_rl)
apply( rule subcls_induct)
apply(  assumption)
apply( rule impI)
apply( case_tac "C = Object")
apply(  fast)
apply safe
apply( frule (1) class_wf)
apply( frule (1) wf_cdecl_supD)

apply( subgoal_tac "P \<turnstile> C \<prec>\<^sup>1 a")
apply( erule_tac [2] subcls1I)
apply(  rule p)
apply (unfold is_class_def)
apply auto
done
qed
(*>*)

lemma subcls1_induct [consumes 2, case_names Object Subcls]:
  "\<lbrakk> wf_prog wf_md P; is_class P C; Q Object;
    \<And>C D. \<lbrakk>C \<noteq> Object; P \<turnstile> C \<prec>\<^sup>1 D; is_class P D; Q D\<rbrakk> \<Longrightarrow> Q C \<rbrakk>
  \<Longrightarrow> Q C"
(*<*)
  apply (erule subcls1_induct_aux, assumption, assumption)
  apply blast
  done
(*>*)

lemma subcls_C_Object:
  "\<lbrakk> is_class P C; wf_prog wf_md P \<rbrakk> \<Longrightarrow> P \<turnstile> C \<preceq>\<^sup>* Object"
(*<*)
apply(erule (1) subcls1_induct)
 apply( fast)
apply(erule (1) converse_rtranclp_into_rtranclp)
done
(*>*)

lemma converse_subcls_is_class:
  assumes wf: "wf_prog wf_md P"
  shows "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* D; is_class P C \<rbrakk> \<Longrightarrow> is_class P D"
proof(induct rule: rtranclp_induct)
  assume "is_class P C"
  thus "is_class P C" .
next
  fix D E
  assume PDE: "P \<turnstile> D \<prec>\<^sup>1 E"
    and IH: "is_class P C \<Longrightarrow> is_class P D"
    and iPC: "is_class P C"
  have "is_class P D" by (rule IH[OF iPC])
  with PDE obtain fsD MsD where classD: "class P D = \<lfloor>(E, fsD, MsD)\<rfloor>"
    by(auto simp add: is_class_def elim!: subcls1.cases)
  thus "is_class P E" using wf PDE
    by(auto elim!: subcls1.cases dest: class_wf simp: wf_cdecl_def)
qed

lemma is_class_is_subcls:
  "wf_prog m P \<Longrightarrow> is_class P C = P \<turnstile> C \<preceq>\<^sup>* Object"
(*<*)by (fastforce simp:is_class_def
                  elim: subcls_C_Object converse_rtranclpE subcls1I
                  dest: subcls1D)
(*>*)

lemma subcls_antisym:
  "\<lbrakk>wf_prog m P; P \<turnstile> C \<preceq>\<^sup>* D; P \<turnstile> D \<preceq>\<^sup>* C\<rbrakk> \<Longrightarrow> C = D"
apply(drule acyclic_subcls1)
apply(drule acyclic_impl_antisym_rtrancl)
apply(drule antisymD)
apply(unfold Transitive_Closure.rtrancl_def)
apply(auto)
done

lemma is_type_pTs:
  "\<lbrakk> wf_prog wf_md P; class P C = \<lfloor>(S,fs,ms)\<rfloor>; (M,Ts,T,m) \<in> set ms \<rbrakk> \<Longrightarrow> set Ts \<subseteq> types P"
by(fastforce dest: class_wf simp add: wf_cdecl_def wf_mdecl_def)

lemma widen_asym_1:
  assumes wfP: "wf_prog wf_md P"
  shows "P \<turnstile> C \<le> D \<Longrightarrow> C = D \<or> \<not> (P \<turnstile> D \<le> C)"
proof (erule widen.induct)
  fix T
  show "T = T \<or> \<not> (P \<turnstile> T \<le> T)" by simp
next
  fix C D
  assume CscD: "P \<turnstile> C \<preceq>\<^sup>* D"
  then have CpscD: "C = D \<or> (C \<noteq> D \<and> (subcls1 P)\<^sup>+\<^sup>+ C D)" by (simp add: rtranclpD)
  { assume "P \<turnstile> D \<preceq>\<^sup>* C"
    then have DpscC: "D = C \<or> (D \<noteq> C \<and> (subcls1 P)\<^sup>+\<^sup>+ D C)" by (simp add: rtranclpD)
    { assume "(subcls1 P)\<^sup>+\<^sup>+ D C"
      with wfP have CnscD: "\<not> (subcls1 P)\<^sup>+\<^sup>+ C D" by (rule subcls_asym)
      with CpscD have "C = D" by simp
    }
    with DpscC have "C = D" by blast
  }
  hence "Class C = Class D \<or> \<not> (P \<turnstile> D \<preceq>\<^sup>* C)" by blast
  thus "Class C = Class D \<or> \<not> P \<turnstile> Class D \<le> Class C" by simp
next
  fix C
  show "NT = Class C \<or> \<not> P \<turnstile> Class C \<le> NT" by simp
next
  fix A
  { assume "P \<turnstile> A\<lfloor>\<rceil> \<le> NT"
    hence "A\<lfloor>\<rceil> = NT" by fastforce
    hence "False" by simp }
  hence "\<not> (P \<turnstile> A\<lfloor>\<rceil> \<le> NT)" by blast
  thus "NT = A\<lfloor>\<rceil> \<or> \<not> P \<turnstile> A\<lfloor>\<rceil> \<le> NT" by simp
next
  fix A
  show "A\<lfloor>\<rceil> = Class Object \<or> \<not> P \<turnstile> Class Object \<le> A\<lfloor>\<rceil>"
    by(auto dest: Object_widen)
next
  fix A B
  assume AsU: "P \<turnstile> A \<le> B" and BnpscA: "A = B \<or> \<not> P \<turnstile> B \<le> A"
  { assume "P \<turnstile> B\<lfloor>\<rceil> \<le> A\<lfloor>\<rceil>"
    hence "P \<turnstile> B \<le> A" by (auto dest: Array_Array_widen)
    with BnpscA have "A = B" by blast
    hence "A\<lfloor>\<rceil> = B\<lfloor>\<rceil>" by simp }
  thus "A\<lfloor>\<rceil> = B\<lfloor>\<rceil> \<or> \<not> P \<turnstile> B\<lfloor>\<rceil> \<le> A\<lfloor>\<rceil>" by blast
qed

lemma widen_asym: "\<lbrakk> wf_prog wf_md P; P \<turnstile> C \<le> D; C \<noteq> D \<rbrakk> \<Longrightarrow> \<not> (P \<turnstile> D \<le> C)"
proof -
  assume wfP: "wf_prog wf_md P" and CsD: "P \<turnstile> C \<le> D" and CneqD: "C \<noteq> D"
  from wfP CsD have "C = D \<or> \<not> (P \<turnstile> D \<le> C)" by (rule widen_asym_1)
  with CneqD show ?thesis by simp
qed

lemma widen_antisym:
  "\<lbrakk> wf_prog m P; P \<turnstile> T \<le> U; P \<turnstile> U \<le> T \<rbrakk> \<Longrightarrow> T = U"
by(auto dest: widen_asym)

lemma widen_C_Object: "\<lbrakk> wf_prog wf_md P; is_class P C \<rbrakk> \<Longrightarrow> P \<turnstile> Class C \<le> Class Object"
by(simp add: subcls_C_Object)

lemma is_refType_widen_Object:
  assumes wfP: "wf_prog wfmc P"
  shows "\<lbrakk> is_type P A; is_refT A \<rbrakk> \<Longrightarrow> P \<turnstile> A \<le> Class Object"
by(induct A)(auto elim: refTE intro: subcls_C_Object[OF _ wfP] widen_array_object)

lemma is_lub_unique:
  assumes wf: "wf_prog wf_md P"
  shows "\<lbrakk> P \<turnstile> lub(U, V) = T; P \<turnstile> lub(U, V) = T' \<rbrakk> \<Longrightarrow> T = T'"
by(auto elim!: is_lub.cases intro: widen_antisym[OF wf])

subsection{* Well-formedness and method lookup *}

lemma sees_wf_mdecl:
  "\<lbrakk> wf_prog wf_md P; P \<turnstile> C sees M:Ts\<rightarrow>T = m in D \<rbrakk> \<Longrightarrow> wf_mdecl wf_md P D (M,Ts,T,m)"
(*<*)
apply(drule visible_method_exists)
apply(clarify)
apply(drule class_wf, assumption)
apply(drule map_of_SomeD)
apply(auto simp add: wf_cdecl_def)
done
(*>*)

lemma sees_method_mono [rule_format (no_asm)]:
  "\<lbrakk> P \<turnstile> C' \<preceq>\<^sup>* C; wf_prog wf_md P \<rbrakk> \<Longrightarrow>
  \<forall>D Ts T m. P \<turnstile> C sees M:Ts\<rightarrow>T = m in D \<longrightarrow>
     (\<exists>D' Ts' T' m'. P \<turnstile> C' sees M:Ts'\<rightarrow>T' = m' in D' \<and> P \<turnstile> Ts [\<le>] Ts' \<and> P \<turnstile> T' \<le> T)"
apply( drule rtranclpD)
apply( erule disjE)
apply(  fastforce intro: widen_refl widens_refl)
apply( erule conjE)
apply( erule tranclp_trans_induct)
prefer 2
apply(  clarify)
apply(  drule spec, drule spec, drule spec, drule spec, erule (1) impE)
apply clarify
apply(  fast elim: widen_trans widens_trans)
apply( clarify)
apply( drule subcls1D)
apply( clarify)
apply(clarsimp simp:Method_def)
apply(frule (2) sees_methods_rec)
apply(rule refl)
apply(case_tac "map_of ms M")
apply(rule_tac x = D in exI)
apply(rule_tac x = Ts in exI)
apply(rule_tac x = T in exI)
apply(clarsimp simp add: widens_refl)
apply(rule_tac x = m in exI)
apply(fastforce simp add:map_add_def split:option.split)
apply clarsimp
apply(rename_tac Ts' T' m')
apply( drule (1) class_wf)
apply( unfold wf_cdecl_def Method_def)
apply( frule map_of_SomeD)
apply(clarsimp)
apply(drule (1) bspec)+
apply clarsimp
apply(erule_tac x=D in allE)
apply(erule_tac x=Ts in allE)
apply(rotate_tac -1)
apply(erule_tac x=T in allE)
apply(fastforce simp:map_add_def Method_def split:option.split)
done
(*>*)

lemma sees_method_mono2:
  "\<lbrakk> P \<turnstile> C' \<preceq>\<^sup>* C; wf_prog wf_md P;
     P \<turnstile> C sees M:Ts\<rightarrow>T = m in D; P \<turnstile> C' sees M:Ts'\<rightarrow>T' = m' in D' \<rbrakk>
  \<Longrightarrow> P \<turnstile> Ts [\<le>] Ts' \<and> P \<turnstile> T' \<le> T"
(*<*)by(blast dest:sees_method_mono sees_method_fun)(*>*)

lemma mdecls_visible:
  assumes wf: "wf_prog wf_md P" and "class": "is_class P C"
  shows "\<And>D fs ms. class P C = Some(D,fs,ms)
         \<Longrightarrow> \<exists>Mm. P \<turnstile> C sees_methods Mm \<and> (\<forall>(M,Ts,T,m) \<in> set ms. Mm M = Some((Ts,T,m),C))"
using wf "class"
proof (induct rule:subcls1_induct)
  case Object
  with wf have "distinct_fst ms"
    by(auto dest: class_wf simp add: wf_cdecl_def)
  with Object show ?case by(fastforce intro!: sees_methods_Object map_of_SomeI)
next
  case Subcls
  with wf have "distinct_fst ms"
    by(auto dest: class_wf simp add: wf_cdecl_def)
  with Subcls show ?case
    by(fastforce elim:sees_methods_rec dest:subcls1D map_of_SomeI
                simp:is_class_def)
qed

lemma mdecl_visible:
  assumes wf: "wf_prog wf_md P" and C: "class P C = \<lfloor>(S,fs,ms)\<rfloor>" and  m: "(M,Ts,T,m) \<in> set ms"
  shows "P \<turnstile> C sees M:Ts\<rightarrow>T = m in C"
proof -
  from C have "is_class P C" by(auto simp:is_class_def)
  with assms show ?thesis
    by(bestsimp simp:Method_def dest:mdecls_visible)
qed

lemma sees_wf_native:
  "\<lbrakk> wf_prog wf_md P; P \<turnstile> C sees M:Ts\<rightarrow>T=Native in D \<rbrakk> \<Longrightarrow> D\<bullet>M(Ts) :: T"
apply(drule (1) sees_wf_mdecl)
apply(simp add: wf_mdecl_def)
done

lemma Call_lemma:
  "\<lbrakk> P \<turnstile> C sees M:Ts\<rightarrow>T = m in D; P \<turnstile> C' \<preceq>\<^sup>* C; wf_prog wf_md P \<rbrakk>
  \<Longrightarrow> \<exists>D' Ts' T' m'.
       P \<turnstile> C' sees M:Ts'\<rightarrow>T' = m' in D' \<and> P \<turnstile> Ts [\<le>] Ts' \<and> P \<turnstile> T' \<le> T \<and> P \<turnstile> C' \<preceq>\<^sup>* D'
       \<and> is_type P T' \<and> (\<forall>T\<in>set Ts'. is_type P T) \<and> (m' \<noteq> Native \<longrightarrow> wf_md P D' (M,Ts',T',the m'))"
apply(frule (2) sees_method_mono)
apply(fastforce intro:sees_method_decl_above dest:sees_wf_mdecl
               simp: wf_mdecl_def)
done

lemma sub_Thread_sees_run:
  assumes wf: "wf_prog wf_md P"
  and PCThread: "P \<turnstile> C \<preceq>\<^sup>* Thread"
  shows "\<exists>D mthd. P \<turnstile> C sees run: []\<rightarrow>Void = \<lfloor>mthd\<rfloor> in D"
proof -
  from class_Thread[OF wf] obtain T' fsT MsT
    where classT: "class P Thread = \<lfloor>(T', fsT, MsT)\<rfloor>" by blast
  hence wfcThread: "wf_cdecl wf_md P (Thread, T', fsT, MsT)" using wf by(rule class_wf)
  then obtain mrunT where runThread: "(run, [], Void, mrunT) \<in> set MsT"
    by(auto simp add: wf_cdecl_def)
  moreover have "\<exists>MmT. P \<turnstile> Thread sees_methods MmT \<and>
                       (\<forall>(M,Ts,T,m) \<in> set MsT. MmT M = Some((Ts,T,m),Thread))"
    by(rule mdecls_visible[OF wf is_class_Thread[OF wf] classT])
  then obtain MmT where ThreadMmT: "P \<turnstile> Thread sees_methods MmT"
    and MmT: "\<forall>(M,Ts,T,m) \<in> set MsT. MmT M = Some((Ts,T,m),Thread)"
    by blast
  ultimately obtain mthd
    where "MmT run = \<lfloor>(([], Void, mthd), Thread)\<rfloor>"
    by(fastforce)
  with ThreadMmT have Tseesrun: "P \<turnstile> Thread sees run: []\<rightarrow>Void = mthd in Thread"
    by(auto simp add: Method_def)
  from sees_method_mono[OF PCThread wf Tseesrun]
  obtain D' m' where "P \<turnstile> C sees run: []\<rightarrow>Void = m' in D'" by auto
  moreover have "m' \<noteq> None"
  proof
    assume "m' = None"
    with wf `P \<turnstile> C sees run: []\<rightarrow>Void = m' in D'` have "D'\<bullet>run([]) :: Void"
      by(auto intro: sees_wf_native)
    thus False by cases auto
  qed
  ultimately show ?thesis by auto
qed

lemma wf_prog_lift:
  assumes wf: "wf_prog (\<lambda>P C bd. A P C bd) P"
  and rule:
  "\<And>wf_md C M Ts C T m.
   \<lbrakk> wf_prog wf_md P; P \<turnstile> C sees M:Ts\<rightarrow>T = \<lfloor>m\<rfloor> in C; is_class P C; set Ts \<subseteq> types P; A P C (M,Ts,T,m) \<rbrakk>
   \<Longrightarrow> B P C (M,Ts,T,m)"
  shows "wf_prog (\<lambda>P C bd. B P C bd) P"
proof(cases P)
  case (Program P')
  thus ?thesis using wf
    apply(clarsimp simp add: wf_prog_def wf_cdecl_def)
    apply(drule (1) bspec)
    apply(rename_tac C D fs ms)
    apply(subgoal_tac "is_class P C")
     prefer 2
     apply(simp add: is_class_def)
     apply(drule weak_map_of_SomeI)
     apply(simp add: Program)
    apply(clarsimp simp add: Program wf_mdecl_def split del: option.split)
    apply(drule (1) bspec)
    apply clarsimp
    apply(rule conjI)
     apply clarsimp
    apply clarsimp
    apply(frule (1) map_of_SomeI)
    apply(rule rule[OF wf, unfolded Program])
    apply(clarsimp simp add: is_class_def)
    apply(rule mdecl_visible[OF wf[unfolded Program]])
    apply(fastforce intro: is_type_pTs [OF wf, unfolded Program])+
    done
qed

subsection{* Well-formedness and field lookup *}

lemma wf_Fields_Ex:
  "\<lbrakk> wf_prog wf_md P; is_class P C \<rbrakk> \<Longrightarrow> \<exists>FDTs. P \<turnstile> C has_fields FDTs"
(*<*)
apply(frule class_Object)
apply(erule (1) subcls1_induct)
 apply(blast intro:has_fields_Object)
apply(blast intro:has_fields_rec dest:subcls1D)
done
(*>*)

lemma has_fields_types:
  "\<lbrakk> P \<turnstile> C has_fields FDTs; (FD, T, fm) \<in> set FDTs; wf_prog wf_md P \<rbrakk> \<Longrightarrow> is_type P T"
(*<*)
apply(induct rule:Fields.induct)
 apply(fastforce dest!: class_wf simp: wf_cdecl_def wf_fdecl_def)
apply(fastforce dest!: class_wf simp: wf_cdecl_def wf_fdecl_def)
done
(*>*)

lemma sees_field_is_type:
  "\<lbrakk> P \<turnstile> C sees F:T (fm) in D; wf_prog wf_md P \<rbrakk> \<Longrightarrow> is_type P T"
by(fastforce simp: sees_field_def
            elim: has_fields_types map_of_SomeD[OF map_of_remap_SomeD])

lemma wf_has_field_mono2:
  assumes wf: "wf_prog wf_md P"
  and has: "P \<turnstile> C has F:T (fm) in E"
  shows "\<lbrakk> P \<turnstile> C \<preceq>\<^sup>* D; P \<turnstile> D \<preceq>\<^sup>* E \<rbrakk> \<Longrightarrow> P \<turnstile> D has F:T (fm) in E"
proof(induct rule: rtranclp_induct)
  case base show ?case using has .
next
  case (step D D')
  note DsubD' = `P \<turnstile> D \<prec>\<^sup>1 D'`
  from DsubD' obtain rest where classD: "class P D = \<lfloor>(D', rest)\<rfloor>"
    and DObj: "D \<noteq> Object" by(auto elim!: subcls1.cases)
  from DsubD' `P \<turnstile> D' \<preceq>\<^sup>* E` have DsubE: "P \<turnstile> D \<preceq>\<^sup>* E" and DsubE2: "(subcls1 P)^++ D E"
    by(rule converse_rtranclp_into_rtranclp rtranclp_into_tranclp2)+
  from wf DsubE2 have DnE: "D \<noteq> E" by(rule subcls_irrefl)
  from DsubE have hasD: "P \<turnstile> D has F:T (fm) in E" by(rule `P \<turnstile> D \<preceq>\<^sup>* E \<Longrightarrow> P \<turnstile> D has F:T (fm) in E`)
  then obtain FDTs where hasf: "P \<turnstile> D has_fields FDTs" and FE: "map_of FDTs (F, E) = \<lfloor>(T, fm)\<rfloor>"
    unfolding has_field_def by blast
  from hasf show ?case
  proof cases
    case has_fields_Object with DObj show ?thesis by simp
  next
    case (has_fields_rec DD' fs ms FDTs')
    with classD have [simp]: "DD' = D'" "rest = (fs, ms)"
      and hasf': "P \<turnstile> D' has_fields FDTs'"
      and FDTs: "FDTs = map (\<lambda>(F, Tm). ((F, D), Tm)) fs @ FDTs'" by auto
    from FDTs FE DnE hasf' show ?thesis by(auto dest: map_of_SomeD simp add: has_field_def)
  qed
qed

lemma wf_has_field_idemp:
  "\<lbrakk> wf_prog wf_md P; P \<turnstile> C has F:T (fm) in D \<rbrakk> \<Longrightarrow> P \<turnstile> D has F:T (fm) in D"
apply(frule has_field_decl_above)
apply(erule (2) wf_has_field_mono2)
apply(rule rtranclp.rtrancl_refl)
done

lemma map_of_remap_conv:
  "\<lbrakk> distinct_fst fs; map_of (map (\<lambda>(F, y). ((F, D), y)) fs) (F, D) = \<lfloor>T\<rfloor> \<rbrakk>
  \<Longrightarrow> map_of (map (\<lambda>((F, D), T). (F, D, T)) (map (\<lambda>(F, y). ((F, D), y)) fs)) F = \<lfloor>(D, T)\<rfloor>"
apply(induct fs)
apply auto
done

lemma has_field_idemp_sees_field:
  assumes wf: "wf_prog wf_md P"
  and has: "P \<turnstile> D has F:T (fm) in D"
  shows "P \<turnstile> D sees F:T (fm) in D"
proof -
  from has obtain FDTs where hasf: "P \<turnstile> D has_fields FDTs"
    and FD: "map_of FDTs (F, D) = \<lfloor>(T, fm)\<rfloor>" unfolding has_field_def by blast
  from hasf have "map_of (map (\<lambda>((F, D), T). (F, D, T)) FDTs) F = \<lfloor>(D, T, fm)\<rfloor>"
  proof cases
    case (has_fields_Object D' fs ms)
    from `class P Object = \<lfloor>(D', fs, ms)\<rfloor>` wf
    have "wf_cdecl wf_md P (Object, D', fs, ms)" by(rule class_wf)
    hence "distinct_fst fs" by(simp add: wf_cdecl_def)
    with FD has_fields_Object show ?thesis by(auto intro: map_of_remap_conv simp del: map_map)
  next
    case (has_fields_rec D' fs ms FDTs')
    hence [simp]: "FDTs = map (\<lambda>(F, Tm). ((F, D), Tm)) fs @ FDTs'"
      and classD: "class P D = \<lfloor>(D', fs, ms)\<rfloor>" and DnObj: "D \<noteq> Object"
      and hasf': "P \<turnstile> D' has_fields FDTs'" by auto
    from `class P D = \<lfloor>(D', fs, ms)\<rfloor>` wf
    have "wf_cdecl wf_md P (D, D', fs, ms)" by(rule class_wf)
    hence "distinct_fst fs" by(simp add: wf_cdecl_def)
    moreover have "map_of FDTs' (F, D) = None"
    proof(rule ccontr)
      assume "map_of FDTs' (F, D) \<noteq> None"
      then obtain T' fm' where "map_of FDTs' (F, D) = \<lfloor>(T', fm')\<rfloor>" by(auto)
      with hasf' have "P \<turnstile> D' \<preceq>\<^sup>* D" by(auto dest!: map_of_SomeD intro: has_fields_decl_above)
      with classD DnObj have "(subcls1 P)^++ D D"
        by(auto intro: subcls1.intros rtranclp_into_tranclp2)
      with wf show False by(auto dest: subcls_irrefl)
    qed
    ultimately show ?thesis using FD hasf'
      by(auto simp add: map_add_Some_iff intro: map_of_remap_conv simp del: map_map)
  qed
  with hasf show ?thesis unfolding sees_field_def by blast
qed

lemma has_fields_distinct:
  assumes wf: "wf_prog wf_md P"
  and "P \<turnstile> C has_fields FDTs"
  shows "distinct (map fst FDTs)"
using `P \<turnstile> C has_fields FDTs`
proof(induct)
  case (has_fields_Object D fs ms FDTs)
  have eq: "map (fst \<circ> (\<lambda>(F, y). ((F, Object), y))) fs = map ((\<lambda>F. (F, Object)) \<circ> fst) fs" by(auto)
  from `class P Object = \<lfloor>(D, fs, ms)\<rfloor>` wf
  have "wf_cdecl wf_md P (Object, D, fs, ms)" by(rule class_wf)
  hence "distinct (map fst fs)" by(simp add: wf_cdecl_def distinct_fst_def)
  hence "distinct (map (fst \<circ> (\<lambda>(F, y). ((F, Object), y))) fs)"
    unfolding eq distinct_map by(auto intro: comp_inj_on inj_onI)
  thus ?case using `FDTs = map (\<lambda>(F, T). ((F, Object), T)) fs` by(simp)
next
  case (has_fields_rec C D fs ms FDTs FDTs')
  have eq: "map (fst \<circ> (\<lambda>(F, y). ((F, C), y))) fs = map ((\<lambda>F. (F, C)) \<circ> fst) fs" by(auto)
  from `class P C = \<lfloor>(D, fs, ms)\<rfloor>` wf
  have "wf_cdecl wf_md P (C, D, fs, ms)" by(rule class_wf)
  hence "distinct (map fst fs)" by(simp add: wf_cdecl_def distinct_fst_def)
  hence "distinct (map (fst \<circ> (\<lambda>(F, y). ((F, C), y))) fs)"
    unfolding eq distinct_map by(auto intro: comp_inj_on inj_onI)
  moreover from `class P C = \<lfloor>(D, fs, ms)\<rfloor>` `C \<noteq> Object`
  have "P \<turnstile> C \<prec>\<^sup>1 D" by(rule subcls1.intros)
  with `P \<turnstile> D has_fields FDTs`
  have "(fst \<circ> (\<lambda>(F, y). ((F, C), y))) ` set fs \<inter> fst ` set FDTs = {}"
    by(auto dest: subcls_notin_has_fields)
  ultimately show ?case using `FDTs' = map (\<lambda>(F, T). ((F, C), T)) fs @ FDTs` `distinct (map fst FDTs)` by simp
qed

subsection {* Code generation *}

code_pred
  (modes: i \<Rightarrow> i \<Rightarrow> i \<Rightarrow> bool)
  [inductify]
  wf_overriding
.

text {*
  Separate subclass acycilicity from class declaration check.
  Otherwise, cyclic class hierarchies might lead to non-termination
  as @{term "Methods"} recurses over the class hierarchy.
*}

definition acyclic_class_hierarchy :: "'m prog \<Rightarrow> bool"
where
  "acyclic_class_hierarchy P \<longleftrightarrow>
  (\<forall>(C, D, fs, ml) \<in> set (classes P). C \<noteq> Object \<longrightarrow> \<not> P \<turnstile> D \<preceq>\<^sup>* C)"

definition wf_cdecl' :: "'m wf_mdecl_test \<Rightarrow> 'm prog \<Rightarrow> 'm cdecl \<Rightarrow> bool"
where
  "wf_cdecl' wf_md P = (\<lambda>(C,(D,fs,ms)).
  (\<forall>f\<in>set fs. wf_fdecl P f) \<and> distinct_fst fs \<and>
  (\<forall>m\<in>set ms. wf_mdecl wf_md P C m) \<and>
  distinct_fst ms \<and>
  (C \<noteq> Object \<longrightarrow> is_class P D \<and> (\<forall>m\<in>set ms. wf_overriding P D m)) \<and>
  (C = Thread \<longrightarrow> (\<exists>m. (run, [], Void, m) \<in> set ms)))"

lemma acyclic_class_hierarchy_code [code]:
  "acyclic_class_hierarchy P \<longleftrightarrow> (\<forall>(C, D, fs, ml) \<in> set (classes P). C \<noteq> Object \<longrightarrow> \<not> subcls' P D C)"
by(simp add: acyclic_class_hierarchy_def subcls'_def)

lemma wf_cdecl'_code [code]:
  "wf_cdecl' wf_md P = (\<lambda>(C,(D,fs,ms)).
  (\<forall>f\<in>set fs. wf_fdecl P f) \<and>  distinct_fst fs \<and>
  (\<forall>m\<in>set ms. wf_mdecl wf_md P C m) \<and>
  distinct_fst ms \<and>
  (C \<noteq> Object \<longrightarrow> is_class P D \<and> (\<forall>m\<in>set ms. wf_overriding P D m)) \<and>
  (C = Thread \<longrightarrow> ((run, [], Void) \<in> set (map (\<lambda>(M, Ts, T, b). (M, Ts, T)) ms))))"
by(auto simp add: wf_cdecl'_def intro!: ext intro: rev_image_eqI)

declare set_append [symmetric, code_unfold]

lemma wf_prog_code [code]:
  "wf_prog wf_md P \<longleftrightarrow>
   acyclic_class_hierarchy P \<and>
   wf_syscls P \<and> distinct_fst (classes P) \<and>
   (\<forall>c \<in> set (classes P). wf_cdecl' wf_md P c)"
unfolding wf_prog_def wf_cdecl_def wf_cdecl'_def acyclic_class_hierarchy_def split_def
by blast

end


(*  Title:      Smartphone.thy
    Author:     Felipe Rodopoulos, University of Brasilia
    Copyright   2018  University of Brasilia

Theory of Events for Security Protocol that use the offline and out-of-band
  channels defined by communications means created using the smartphone
  camera for decoding QR codes displayed at other insecure devices screens.

"badP" smartphones are compromised by the Spy; their private keys and internal
  stores are visible to her
*)

theory EventSP imports "~~/src/HOL/Auth/Message" "~~/src/HOL/Library/Simps_Case_Conv" begin

consts (* Initial states of agents -- parameter of the construction *)
  initState :: "agent => msg set"

datatype smartphone = Smartphone agent

datatype
  event = Says    agent agent msg
        | Notes   agent       msg
        | Gets    agent       msg
        | Scans   agent       smartphone msg (* Agent scans a message with her smartphone and ... *)
        | SGets  smartphone  msg (* ... smartphone receives it. *)
        | Shows smartphone  agent msg (* Smartphone shows information to its agent and ... *)
        | AGets  agent       msg (* ... agent receives it. *)
        | Inputs  agent       smartphone msg (* Agent manually inputs data into smartphone *)

consts
  bad        :: "agent set"      (* compromised agents *)
  badP       :: "smartphone set" (* compromised smartphones *)
  stolen     :: "smartphone set" (* stolen smartphones *)
  secureP    :: "bool" (* assumption of secure smartphones, inviolable by the Spy *)

abbreviation
  insecureP :: bool where (* certain protocols make no assumption of secure smartphones *)
    "insecureP == \<not>secureP"

specification (bad)
  Spy_in_bad     [iff]: "Spy \<in> bad"
  Server_not_bad [iff]: "Server \<notin> bad"
  apply (rule exI [of _ "{Spy}"], simp)
done

specification (badP)
  (* Spy phone is secured because she already can use it freely *)
  Spy_phone_not_badP     [iff]: "Smartphone Spy \<notin> badP"
  Server_phone_not_badP [iff]: "Smartphone Server \<notin> badP"
  apply blast
done

specification (stolen)
  Server_phone_not_stolen [iff]: "Smartphone Server \<notin> stolen"
  Spy_phone_not_stolen    [iff]: "Smartphone Spy \<notin> stolen"
  Stolen_in_badP [iff] : "stolen \<subseteq> badP"
  apply blast
done

(* Agents' knowledge definition over a trace is extended to comprehend new Smartphone events *)
primrec knows :: "agent \<Rightarrow> event list \<Rightarrow> msg set" where
  knows_Nil :  "knows A [] = initState A" |
  knows_Cons : "knows A (ev # evs) =
    (case ev of
      \<comment> \<open>An agent knows what he sends to anyone. The Spy knows everything sent on a trace\<close>
      Says A' B X \<Rightarrow>
        if (A = A' | A = Spy) then insert X (knows A evs)
        else (knows A evs)

      \<comment> \<open>An agent knows what he notes. The Spy knows what compromised agents knows on a trace\<close>
      | Notes A' X \<Rightarrow>
        if (A = A' | (A = Spy & A' \<in> bad)) then insert X (knows A evs)
        else knows A evs

      \<comment> \<open>An agent, except the Spy, knows what she receives in a trace. Due to the Says event and
      reception invariant, the Spy knowledge does not need to be extended\<close>
      | Gets A' X \<Rightarrow>
        if (A = A' & A \<noteq> Spy) then insert X (knows A evs)
        else knows A evs

      \<comment> \<open>An agent knows what she shows to her smartphone to scan. The Spy knows what a compromised
         agent shows to her smartphones to scan\<close>
      | Scans A' P X \<Rightarrow>
        if (A = A' | (A = Spy & A' \<in> bad)) then insert X (knows A evs)
        else knows A evs

      \<comment> \<open>Due to reception invariant of Scans event, an agent does not enrich her knowledge set
         from what her smartphone receives\<close>
      | SGets P X \<Rightarrow>
        if secureP then knows A evs
        \<comment> \<open>However, if devices can be compromised, the Spy knows what a compromised phone receives\<close>
        else
          if (A = Spy & P \<in> badP) then insert X (knows A evs)
          else knows A evs

      \<comment> \<open>An agent, including the Spy, knows what her smartphone shows to her\<close>
      | Shows P A' X \<Rightarrow>
        if secureP then
          if (A = A') then insert X (knows A evs)
          else knows A evs
        \<comment> \<open>When insecure devices hold, the Spy knows what compromised devices shows\<close>
        else
          if (A = Spy & P \<in> badP) then insert X (knows A evs)
          else knows A evs

      \<comment> \<open>An agent knows what she receives from her smartphone. The Spy already knows from the previous event\<close>
      | AGets A' X \<Rightarrow>
        if (A = A' & A \<noteq> Spy) then insert X (knows A evs)
        else knows A evs

      \<comment> \<open>An agent, and only her, knows what she manually inputs to her smartphone\<close>
      | Inputs A' P X \<Rightarrow>
        if (A = A') then insert X (knows A evs)
        else knows A evs
  )"

primrec used :: "event list \<Rightarrow> msg set" where
  used_Nil  : "used [] = (\<Union> B. parts (initState B))" |
  used_Cons : "used (ev # evs) =
    (case ev of
        Says A B X \<Rightarrow> parts {X} \<union> (used evs)
      | Notes A X \<Rightarrow> parts {X} \<union> (used evs)
      | Gets A X \<Rightarrow> used evs
      | Scans A P X \<Rightarrow> parts {X} \<union> used evs
      | SGets P X \<Rightarrow> parts {X} \<union> used evs
      | Shows P A X \<Rightarrow> parts {X} \<union> used evs
      | AGets A X \<Rightarrow> used evs
      | Inputs A P X \<Rightarrow> parts {X} \<union> used evs
  )"

text\<open>Describing how some the set used evs is enriched given our events\<close>
lemma Notes_imp_used [rule_format] :
  "Notes A X \<in> set evs \<longrightarrow> X \<in> used evs"
apply (induct_tac evs)
apply (auto split: event.split)
done

lemma Says_imp_used [rule_format] :
  "Says A B X \<in> set evs \<longrightarrow> X \<in> used evs"
apply (induct_tac evs)
apply (auto split: event.split)
done

lemma Scans_imp_used [rule_format] :
  "Scans A P X \<in> set evs \<longrightarrow> X \<in> used evs"
apply (induct_tac evs)
apply (auto split: event.split)
done

lemma Shows_imp_used [rule_format] :
  "Shows P A X \<in> set evs \<longrightarrow> X \<in> used evs"
apply (induct_tac evs)
apply (auto split: event.split)
done

lemma Inputs_imp_used :
  "Inputs A P X \<in> set evs \<longrightarrow> X \<in> used evs"
apply (induct_tac evs)
apply (auto split: event.split)
done

section\<open>Function \<^term>\<open>knows\<close>\<close>
(* Simplifying:
   parts(insert X (knows Spy evs)) = parts{X} \<union> parts(knows Spy evs) *)
lemmas parts_insert_knows_A = parts_insert [of _ "knows A evs"] for A evs

lemma knows_Spy_Says [simp] :
  "knows Spy (Says A B X # evs) = insert X (knows Spy evs)"
by simp

lemma knows_Spy_Gets [simp] :
  "knows Spy (Gets B X # evs) = knows Spy evs"
by simp

lemma knows_Spy_Notes [simp] :
  "knows Spy (Notes A X # evs) =
    (if A \<in> bad then insert X (knows Spy evs)
     else knows Spy evs)"
by simp

lemma knows_Spy_Scans [simp] :
  "knows Spy (Scans A P X # evs) =
    (if A \<in> bad then insert X (knows Spy evs)
     else knows Spy evs)"
by simp

lemma knows_Spy_SGets_secureP [simp] :
  "secureP \<Longrightarrow> knows Spy (SGets P X # evs) = knows Spy evs"
by simp

lemma knows_Spy_SGets_insecureP [simp] :
  "insecureP \<Longrightarrow> knows Spy (SGets P X # evs) =
    (if (P \<in> badP) then insert X (knows Spy evs)
    else knows Spy evs)"
by simp

lemma knows_Spy_Shows_secureP [simp] :
  "secureP \<Longrightarrow> knows Spy (Shows P A X # evs) =
    (if A = Spy then insert X (knows Spy evs)
     else knows Spy evs)"
by simp

lemma knows_Spy_Shows_insecureP [simp] :
  "insecureP \<Longrightarrow> knows Spy (Shows P A X # evs) =
    (if P \<in> badP then insert X (knows Spy evs)
     else knows Spy evs)"
by simp

lemma knows_Spy_AGets [simp] :
  "knows Spy (AGets A X # evs) = knows Spy evs"
by simp

lemma knows_Spy_Inputs [simp] :
  "knows Spy (Inputs A P X # evs) =
    (if A = Spy then insert X (knows Spy evs)
     else knows Spy evs)"
by simp

lemma knows_Spy_subset_knows_Spy_Says :
  "knows Spy evs \<subseteq> knows Spy (Says A B X # evs)"
by (simp add: subset_insertI)

lemma knows_Spy_subset_knows_Spy_Notes :
  "knows Spy evs \<subseteq> knows Spy (Notes A X # evs)"
by force

lemma knows_Spy_subset_knows_Spy_Gets :
  "knows Spy evs \<subseteq> knows Spy (Gets A X # evs)"
by (simp add: subset_insertI)

lemma knows_Spy_subset_knows_Spy_Scans :
  "knows Spy evs \<subseteq> knows Spy (Scans A P X # evs)"
by auto

lemma knows_Spy_subset_knows_Spy_SGets :
  "knows Spy evs \<subseteq> knows Spy (SGets P X # evs)"
by (simp add: subset_insertI)

lemma knows_Spy_subset_knows_Spy_Shows :
  "knows Spy evs \<subseteq> knows Spy (Shows P A X # evs)"
by (simp add: subset_insertI)

lemma knows_Spy_subset_knows_Spy_AGets :
  "knows Spy evs \<subseteq> knows Spy (AGets A X # evs)"
by (simp add: subset_insertI)

lemma knows_Spy_subset_knows_Spy_Inputs :
  "knows Spy evs \<subseteq> knows Spy (Inputs A P X # evs)"
by (simp add: subset_insertI)

lemma Says_imp_knows_Spy [rule_format (no_asm)] :
  "Says A B X \<in> set evs \<longrightarrow> X \<in> knows Spy evs"

  apply (induct_tac "evs")
  apply (simp_all split: event.split)
done

lemma Notes_imp_knows_Spy [rule_format (no_asm)] :
  "Notes A X \<in> set evs \<longrightarrow> A \<in> bad \<longrightarrow> X \<in> knows Spy evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
done

\<comment> \<open>Nothing can be stated about Gets event\<close>

lemma Scans_imp_knows_Spy [rule_format (no_asm)] :
  "Scans A P X \<in> set evs \<longrightarrow> A \<in> bad \<longrightarrow> X \<in> knows Spy evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
done

\<comment> \<open>Nothing can be stated on a SGets when phones are secured event\<close>
lemma SGets_imp_knows_Spy_insecureP [rule_format (no_asm)] :
  "SGets P X \<in> set evs \<longrightarrow> (insecureP \<and> P \<in> badP) \<longrightarrow> X \<in> knows Spy evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
done

lemma Shows_imp_knows_Spy_secureM [rule_format (no_asm)] :
  "Shows P Spy X \<in> set evs \<longrightarrow> secureP \<longrightarrow> X \<in> knows Spy evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
done

lemma Shows_imp_know_Spy_insecureM [rule_format (no_asm)] :
  "Shows P A X \<in> set evs \<longrightarrow> (insecureP \<and> P \<in> badP) \<longrightarrow> X \<in> knows Spy evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
done

\<comment> \<open>Nothing can be stated here on a AGets event\<close>
lemma Inputs_imp_knows_Spy [rule_format] :
  "Inputs Spy P X \<in> set evs \<longrightarrow> X \<in> knows Spy evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
done

lemmas knows_Spy_partsEs =
     Says_imp_knows_Spy [THEN parts.Inj, elim_format]
     parts.Body [elim_format]

lemma knows_Says: "knows A (Says A B X # evs) = insert X (knows A evs)"
by simp

lemma knows_Notes: "knows A (Notes A X # evs) = insert X (knows A evs)"
by simp

lemma knows_Gets:
  "A \<noteq> Spy \<longrightarrow> knows A (Gets A X # evs) = insert X (knows A evs)"
by simp

lemma knows_Scans: "knows A (Scans A P X # evs) = insert X (knows A evs)"
by simp

lemma knows_SGets:
  "A \<noteq> Spy \<longrightarrow> knows A (SGets P X # evs) = knows A evs"
by simp

lemma knows_Shows_secureP:
  "secureP \<longrightarrow> knows A (Shows P A X # evs) = insert X (knows A evs)"
by simp

lemma knows_Shows_insecureP:
  "(insecureP \<and> A \<noteq> Spy) \<longrightarrow> knows A (Shows P A X # evs) = knows A evs"
by simp

lemma knows_Inputs:
  "knows A (Inputs A P X # evs) = insert X (knows A evs)"
by simp

lemma knows_subset_knows_Says: "knows A evs \<subseteq> knows A (Says A' B X # evs)"
by (simp add: subset_insertI)

lemma knows_subset_knows_Notes: "knows A evs \<subseteq> knows A (Notes A' X # evs)"
by (simp add: subset_insertI)

lemma knows_subset_knows_Gets: "knows A evs \<subseteq> knows A (Gets A' X # evs)"
by (simp add: subset_insertI)

lemma knows_subset_knows_Scans: "knows A evs \<subseteq> knows A (Scans A' P X # evs)"
by (simp add: subset_insertI)

lemma knows_subset_knows_SGets: "knows A evs \<subseteq> knows A (SGets P X # evs)"
by (simp add: subset_insertI)

lemma knows_subset_knows_Shows: "knows A evs \<subseteq> knows A (Shows P A' X # evs)"
by (simp add: subset_insertI)

lemma knows_subset_knows_AGets: "knows A evs \<subseteq> knows A (AGets A' X # evs)"
by (simp add: subset_insertI)

lemma knows_subset_knows_Inputs: "knows A evs \<subseteq> knows A (Inputs A' P X # evs)"
by (simp add: subset_insertI)

\<comment> \<open>Agents know what they say\<close>
lemma Says_imp_knows [rule_format] :
  "Says A B X \<in> set evs \<longrightarrow> X \<in> knows A evs"
  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
  apply (auto)
done

\<comment> \<open>Agents know what they note\<close>
lemma Notes_imp_knows [rule_format] :
  "Notes A X \<in> set evs \<longrightarrow> X \<in> knows A evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
  apply (auto)
done

\<comment> \<open>Agents know what they receive\<close>
lemma Gets_imp_knows [rule_format] :
  "A \<noteq> Spy \<longrightarrow> Gets A X \<in> set evs \<longrightarrow> X \<in> knows A evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
done

\<comment> \<open>Agents know what their smartphone scans\<close>
lemma Scans_imp_knows [rule_format] :
  "Scans A (Smartphone A) X \<in> set evs \<longrightarrow> X \<in> knows A evs"
  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
  apply (auto)
done

\<comment> \<open>Agents know what they input to their smartphone\<close>
lemma Inputs_imp_knows [rule_format] :
  "Inputs A (Smartphone A) X \<in> set evs \<longrightarrow> X \<in> knows A evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
  apply (auto)
done

\<comment> \<open>Agents do not know what they smartphones reads...\<close>

\<comment> \<open>Agents know what their smartphones shows to them, if the device are secured\<close>
lemma Shows_imp_knows_secureP [rule_format] :
  "secureP \<longrightarrow> Shows (Smartphone A) A X \<in> set evs \<longrightarrow> X \<in> knows A evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
done

lemma Shows_imp_knows_insecureP [rule_format] :
  "(insecureP \<and> (Smartphone A) \<in> badP) \<longrightarrow> Shows (Smartphone A) A X \<in> set evs \<longrightarrow> X \<in> knows Spy evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
done

\<comment> \<open>Agents know what they receive from a smartphone\<close>
lemma AGets_imp_knows [rule_format] :
  "A \<noteq> Spy \<longrightarrow> AGets A X \<in> set evs \<longrightarrow> X \<in> knows A evs"

  apply (induct_tac "evs")
  apply (simp_all (no_asm_simp) split: event.split)
done

(* REMEMBER: knows (Spy evs) = everything that appeared in the trace so far *)
(* Everything that appeared in the trace is not fresh *)
lemma parts_knows_Spy_subset_used :
  "parts (knows Spy evs) \<subseteq> used evs"
apply (induct_tac "evs", force)
apply (simp add: parts_insert_knows_A split: event.split)
apply (auto)
done

lemmas usedI = parts_knows_Spy_subset_used [THEN subsetD, intro]

lemma initState_into_used :
  "X \<in> parts (initState B) ==> X \<in> used evs"
apply (induct_tac "evs")
apply (simp_all add: parts_insert_knows_A split: event.split, blast)
done

simps_of_case used_Cons_simps [simp]: used_Cons

section\<open>Function \<^term>\<open>used\<close>\<close>
lemma Says_parts_used [rule_format (no_asm)] :
  "Says A B X \<in> set evs \<longrightarrow> (parts {X}) \<subseteq> used evs "
apply (induct_tac "evs")
apply (simp_all (no_asm_simp) split: event.split)
apply (auto)
done

lemma Notes_parts_used [rule_format (no_asm)] :
  "Notes A X \<in> set evs \<longrightarrow> (parts {X}) \<subseteq> used evs"
apply (induct_tac "evs")
apply (simp_all (no_asm_simp) split: event.split)
apply (auto)
done

lemma Scans_parts_used [rule_format (no_asm)] :
  "Scans A P X \<in> set evs \<longrightarrow> (parts {X}) \<subseteq> used evs"
apply (induct_tac "evs")
apply (simp_all (no_asm_simp) split: event.split)
apply (auto)
done

lemma Shows_parts_used [rule_format (no_asm)] :
  "Shows P A X \<in> set evs \<longrightarrow> (parts {X}) \<subseteq> used evs"
apply (induct_tac "evs")
apply (simp_all (no_asm_simp) split: event.split)
apply (auto)
done

lemma Inputs_parts_used [rule_format (no_asm)] :
  "Inputs A P X \<in> set evs \<longrightarrow> (parts {X}) \<subseteq> used evs"
apply (induct_tac "evs")
apply (simp_all (no_asm_simp) split: event.split)
apply (auto)
done

declare knows_Cons [simp del]
        used_Nil [simp del]
        used_Cons [simp del]

lemma knows_subset_knows_Cons :
  "knows A evs \<subseteq> knows A (e # evs)"
by (induct e, auto simp: knows_Cons)

lemma initState_subset_knows :
  "initState A \<subseteq> knows A evs"
apply (induct_tac evs, simp)
apply (blast intro: knows_subset_knows_Cons [THEN subsetD])
done

lemma keysFor_parts_insert:
     "\<lbrakk> K \<in> keysFor (parts (insert X G));  X \<in> synth (analz H) \<rbrakk>
      \<Longrightarrow> K \<in> keysFor (parts (G \<union> H)) \<or> Key (invKey K) \<in> parts H"
by (force
    dest!: parts_insert_subset_Un [THEN keysFor_mono, THEN [2] rev_subsetD]
           analz_subset_parts [THEN keysFor_mono, THEN [2] rev_subsetD]
    intro: analz_subset_parts [THEN subsetD] parts_mono [THEN [2] rev_subsetD])

end


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

theory word_abs_options imports "AutoCorres.AutoCorres" begin

external_file "word_abs_options.c"
install_C_file "word_abs_options.c"

autocorres [
  ts_rules = nondet,
  unsigned_word_abs = usum2, no_signed_word_abs = isum1
  ] "word_abs_options.c"

context word_abs_options begin

lemma "\<lbrace> \<top> \<rbrace> isum1' (a :: sword32) (b :: sword32) \<lbrace> \<lambda>r _. r = a + b \<rbrace>"
  unfolding isum1'_def
  apply (wp refl impI)
  done

lemma "\<lbrace> \<top> \<rbrace> isum2' (a :: int) (b :: int) \<lbrace> \<lambda>r _. r = a + b \<rbrace>"
  unfolding isum2'_def
  apply (wp refl impI)
  done

lemma "\<lbrace> \<top> \<rbrace> usum1' (a :: word32) (b :: word32) \<lbrace> \<lambda>r _. r = a + b \<rbrace>"
  unfolding usum1'_def
  apply (wp refl impI)
  done

lemma "\<lbrace> \<top> \<rbrace> usum2' (a :: nat) (b :: nat) \<lbrace> \<lambda>r _. r = a + b \<rbrace>"
  unfolding usum2'_def
  apply (wp refl impI)
  done

end

end


(*  Title:      HOL/Auth/n_german_lemma_on_inv__44.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__44 imports n_german_base
begin
section{*All lemmas on causal relation between inv__44 and some rule r*}
lemma n_SendInvEVsinv__44:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvE  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 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_SendInvE  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>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__Inv3)"
  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__Inv3\<and>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_SendInvSVsinv__44:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvS  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 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_SendInvS  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>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__Inv3)"
  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__Inv3\<and>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__44:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 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__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>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__Inv3)"
  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__Inv3\<and>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__44:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 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_RecvInvAck  i" apply fastforce done
from a2 obtain p__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>i~=p__Inv4)" apply (cut_tac a1 a2, auto) done
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
}
moreover {
  assume b1: "(i=p__Inv3)"
  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__Inv3\<and>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__44:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntS  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 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__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>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__Inv3)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Ident ''ExGntd'')) (Const false)) (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const GntE))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>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__44:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_SendGntE N i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 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__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>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__Inv3)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Ident ''ExGntd'')) (Const false)) (eqn (IVar (Field (Para (Ident ''Chan2'') p__Inv4) ''Cmd'')) (Const GntE))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i~=p__Inv3\<and>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__44:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 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__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>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__Inv3)"
  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__Inv3\<and>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__44:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)" and
a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 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__Inv3 p__Inv4 where a2:"p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 p__Inv4" apply fastforce done
have "(i=p__Inv4)\<or>(i=p__Inv3)\<or>(i~=p__Inv3\<and>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__Inv3)"
  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__Inv3\<and>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_StoreVsinv__44:
  assumes a1: "\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

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

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

lemma n_SendReqSVsinv__44:
  assumes a1: "\<exists> j. j\<le>N\<and>r=n_SendReqS  j" and
  a2: "(\<exists> p__Inv3 p__Inv4. p__Inv3\<le>N\<and>p__Inv4\<le>N\<and>p__Inv3~=p__Inv4\<and>f=inv__44  p__Inv3 p__Inv4)"
  shows "invHoldForRule s f r (invariants N)"
  apply (rule noEffectOnRule, cut_tac a1 a2, auto) done

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

end


theory Resource_Space_Inst_Tools
  imports Resource_Space
begin

quotient_type (overloaded) ('a,'b) sum1 (infixr "+\<^sub>1" 10) =
  \<open>('a::one) + ('b::one)\<close> / \<open>(\<lambda>x y. ((x = Inl 1 \<or> x = Inr 1) \<and> (y = Inl 1 \<or> y = Inr 1))\<or> x = y)\<close>
  by (rule equivpI; simp add: reflp_def symp_def transp_def split_sum_all)

instantiation sum1 :: (one, one) one begin
lift_definition one_sum1 :: "'a +\<^sub>1 'b" is "Inl 1" .
instance ..
end

instantiation sum1 :: (mult_1, mult_1) mult_1
begin

lift_definition times_sum1 :: "'a +\<^sub>1 'b \<Rightarrow> 'a +\<^sub>1 'b \<Rightarrow> 'a +\<^sub>1 'b"
  is "\<lambda>x y. case x of Inl x1 \<Rightarrow> (case y of Inl y1 \<Rightarrow> Inl (x1 * y1)
                                         | Inr y2 \<Rightarrow> (if y2 = 1 then Inl x1 else if x1 = 1 then Inr y2 else undefined))
                    | Inr x2 \<Rightarrow> (case y of Inl y1 \<Rightarrow> (if y1 = 1 then Inr x2 else if x2 = 1 then Inl y1 else undefined)
                                         | Inr y2 \<Rightarrow> Inr (x2 * y2))"
  by (clarsimp simp add: atomize_all atomize_imp split_sum_all)

instance by (standard; transfer; case_tac x; simp)
end

instantiation sum1 :: (sep_magma_1, sep_magma_1) sep_magma_1 begin

lift_definition sep_disj_sum1 :: "'a +\<^sub>1 'b \<Rightarrow> 'a +\<^sub>1 'b \<Rightarrow> bool"
  is "\<lambda>x y. case x of Inl x1 \<Rightarrow> (case y of Inl y1 \<Rightarrow> x1 ## y1
                                         | Inr y2 \<Rightarrow> (y2 = 1 \<or> x1 = 1))
                    | Inr x2 \<Rightarrow> (case y of Inl y1 \<Rightarrow> (y1 = 1 \<or> x2 = 1)
                                         | Inr y2 \<Rightarrow> x2 ## y2)"
  by (clarsimp simp add: atomize_all atomize_imp split_sum_all)

instance by (standard; transfer; case_tac x; simp)
end

instantiation sum1 :: (sep_monoid, sep_monoid) sep_monoid begin

instance apply standard
       apply (unfold join_sub_def; transfer; case_tac x; case_tac y; clarsimp simp add: split_sum_ex)
       apply (smt (z3) Inl_Inr_False join_positivity join_sub_def sum.inject(1))
  apply (case_tac \<open>b = 1\<close>; simp)
  apply (metis Inl_not_Inr old.sum.inject(1) sep_no_inverse)
         apply fastforce
  apply (case_tac \<open>b = 1\<close>; simp)
  apply (metis Inl_not_Inr old.sum.inject(1) sep_no_inverse)
        apply fastforce
  apply (case_tac \<open>ba = 1\<close>; simp)
  apply force
  apply (metis Inl_Inr_False join_positivity join_sub_def sum.inject(2))

  apply (transfer; case_tac x; case_tac y; case_tac z; clarsimp simp add: sep_mult_assoc; fastforce)

  apply (transfer; case_tac x; case_tac y; case_tac z; clarsimp simp add: sep_mult_assoc)
  using sep_disj_multD1 apply blast
  apply fastforce
  apply fastforce
  using sep_disj_multD1 apply blast
  apply (transfer; case_tac x; case_tac y; case_tac z; clarsimp simp add: sep_mult_assoc)
  using sep_disj_multI1 apply blast
  using sum.sel(2) apply fastforce
  apply (smt (verit, best) old.sum.simps(5) old.sum.simps(6) sep_magma_1_left)
  apply (smt (verit, best) old.sum.simps(5) old.sum.simps(6) sep_magma_1_left)
  using sum.sel(1) apply fastforce
  using sep_disj_multI1 apply blast

  apply (transfer; case_tac x; case_tac y; case_tac z; clarsimp simp add: sep_mult_assoc)
  using sep_disj_multD2 apply blast
  apply (smt (verit, best) old.sum.simps(6) sep_magma_1_right)
  apply (smt (verit, best) old.sum.simps(5) sep_magma_1_right)
  using sep_disj_multD2 apply blast

  apply (transfer; case_tac x; case_tac y; case_tac z; clarsimp simp add: sep_mult_assoc)
  using sep_disj_multI2 apply blast
  apply fastforce
  apply fastforce
  apply fastforce
  apply fastforce
  using sep_disj_multI2 by blast
end

instantiation sum1 :: (sep_algebra, sep_algebra) sep_algebra begin
instance apply (standard; transfer; case_tac x; case_tac y; simp)
  using sep_disj_commuteI apply blast
  apply fastforce
  apply fastforce
  using sep_disj_commuteI apply blast
  using sep_mult_commute apply blast
  using sep_mult_commute by blast
end

setup \<open>Sign.mandatory_path "sum1"\<close>

lift_definition Inl :: "'a \<Rightarrow> 'a::one +\<^sub>1 'b::one" is \<open>Sum_Type.Inl\<close> .
lift_definition Inr :: "'b \<Rightarrow> 'a::one +\<^sub>1 'b::one" is \<open>Sum_Type.Inr\<close> .

lift_definition projl :: "'a::one +\<^sub>1 'b::one \<Rightarrow> 'a"
  is \<open>\<lambda>x. case x of Inl x1 \<Rightarrow> x1 | Inr x2 \<Rightarrow> 1\<close>
  by (case_tac sum1; case_tac sum2; simp; fastforce)

lift_definition projr :: "'a::one +\<^sub>1 'b::one \<Rightarrow> 'b"
  is \<open>\<lambda>x. case x of Inl x1 \<Rightarrow> 1 | Inr x2 \<Rightarrow> x2\<close>
  by (case_tac sum1; case_tac sum2; simp; fastforce)

lemma proj1[simp]:
  \<open>sum1.projl 1 = 1\<close>
  \<open>sum1.projr 1 = 1\<close>
  by (transfer; simp)+

lemma proj_In[simp]:
  \<open>sum1.projl (sum1.Inl x) = x\<close>
  \<open>sum1.projr (sum1.Inr x) = x\<close>
  by (transfer; simp)+

lemma In_1[simp]:
  \<open>sum1.Inl 1 = 1\<close>
  \<open>sum1.Inr 1 = 1\<close>
  by (transfer; simp)+

interpretation left: sep_insertion sum1.Inl sum1.projl
  apply (standard; transfer)
  apply (simp)
  apply (simp)
  apply (case_tac x; case_tac y; simp; meson)
    apply (case_tac a; case_tac b; simp; meson; simp)
    apply simp
apply simp
apply (case_tac a; case_tac b; simp; meson; simp)
  by blast

interpretation right: sep_insertion sum1.Inr sum1.projr
  apply (standard; transfer)
  apply (simp)
  apply (simp)
  apply (case_tac x; case_tac y; simp; meson)
    apply (case_tac a; case_tac b; simp; meson; simp)
    apply simp
apply simp
apply (case_tac a; case_tac b; simp; meson; simp)
  by blast

setup \<open>Sign.parent_path\<close>

end


(*
 * Copyright 2020, Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

theory signed_div
imports "CParser.CTranslation"
begin

external_file "signed_div.c"
install_C_file "signed_div.c"

context signed_div
begin

lemma f_result:
  "\<Gamma> \<turnstile> \<lbrace> True \<rbrace> \<acute>ret__int :== CALL f(5, -1) \<lbrace> \<acute>ret__int = -5 \<rbrace>"
  apply vcg
  apply (clarsimp simp: sdiv_word_def sdiv_int_def)
  done

lemma f_overflow:
  shows "\<lbrakk> a_' s = of_int (- (2^31)); b_' s = -1 \<rbrakk> \<Longrightarrow> \<Gamma> \<turnstile> \<langle> Call f_'proc ,Normal s\<rangle> \<Rightarrow> Fault SignedArithmetic"
  apply (rule exec.Call [where \<Gamma>=\<Gamma>, OF f_impl, simplified f_body_def creturn_def])
  apply (rule exec.CatchMiss)
  apply (subst exec.simps, clarsimp simp del: word_neq_0_conv simp: sdiv_word_def sdiv_int_def)+
  apply simp
  done

lemma g_result:
  "\<Gamma> \<turnstile> \<lbrace> True \<rbrace> \<acute>ret__int :== CALL g(-5, 10) \<lbrace> \<acute>ret__int = -5 \<rbrace>"
  apply vcg
  apply (clarsimp simp: smod_word_def smod_int_def sdiv_int_def)
  done

lemma h_result:
  "\<Gamma> \<turnstile> \<lbrace> True \<rbrace> \<acute>ret__int :== CALL h(5, -1) \<lbrace> \<acute>ret__int = 0 \<rbrace>"
  apply vcg
  apply (simp add: word_div_def uint_word_ariths)
  done

(* FIXME: f! *)
lemma i_result:
  "\<Gamma> \<turnstile> \<lbrace> True \<rbrace> \<acute>ret__int :== CALL f(5, -1) \<lbrace> \<acute>ret__int = -5 \<rbrace>"
  apply vcg
  apply (clarsimp simp: sdiv_word_def sdiv_int_def)
  done

end

end


(*  Title:      HOL/Auth/n_germanish_on_ini.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_germanish Protocol Case Study*}

theory n_germanish_on_ini imports n_germanish_base
begin
lemma iniImply_inv__1:
assumes a1: "(\<exists> p__Inv0 p__Inv2. p__Inv0\<le>N\<and>p__Inv2\<le>N\<and>p__Inv0~=p__Inv2\<and>f=inv__1  p__Inv0 p__Inv2)"
and a2: "formEval (andList (allInitSpecs N)) s"
shows "formEval f s"
using a1 a2 by auto

lemma iniImply_inv__2:
assumes a1: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__2  p__Inv2)"
and a2: "formEval (andList (allInitSpecs N)) s"
shows "formEval f s"
using a1 a2 by auto

lemma iniImply_inv__3:
assumes a1: "(\<exists> p__Inv0 p__Inv2. p__Inv0\<le>N\<and>p__Inv2\<le>N\<and>p__Inv0~=p__Inv2\<and>f=inv__3  p__Inv0 p__Inv2)"
and a2: "formEval (andList (allInitSpecs N)) s"
shows "formEval f s"
using a1 a2 by auto
end


theory Paper_Aut_PC
imports "../Observation_Setup" Paper_Value_Setup "Bounded_Deducibility_Security.Compositional_Reasoning"
begin

subsection \<open>Confidentiality protection from users who are not the
paper's authors or PC members\<close>

text \<open>We verify the following property:

\ \\
A group of users UIDs
learns nothing about the various uploads of a paper PID
(save for the non-existence of any upload)
unless/until one of the following occurs:
\begin{itemize}
\item a user in UIDs becomes the paper's author or
\item a user in UIDs becomes a PC member in the paper's conference
and the conference moves to the bidding phase.
\end{itemize}
\<close>

fun T :: "(state,act,out) trans \<Rightarrow> bool" where
"T (Trans _ _ ou s') =
 (\<exists> uid \<in> UIDs.
    isAUT s' uid PID \<or>
    (\<exists> cid. PID \<in>\<in> paperIDs s' cid \<and> isPC s' cid uid \<and> phase s' cid \<ge> bidPH)
 )"

declare T.simps [simp del]

definition B :: "value list \<Rightarrow> value list \<Rightarrow> bool" where
"B vl vl1 \<equiv> vl \<noteq> []"

interpretation BD_Security_IO where
istate = istate and step = step and
\<phi> = \<phi> and f = f and \<gamma> = \<gamma> and g = g and T = T and B = B
done

lemma reachNT_non_isAut_isPC_isChair:
assumes "reachNT s" and "uid \<in> UIDs"
shows
"\<not> isAut s cid uid PID \<and>
 (isPC s cid uid \<longrightarrow> \<not> PID \<in>\<in> paperIDs s cid \<or> phase s cid \<le> subPH) \<and>
 (isChair s cid uid \<longrightarrow> \<not> PID \<in>\<in> paperIDs s cid \<or> phase s cid \<le> subPH)"
  using assms
  apply (cases rule: reachNT_state_cases)
   apply (auto simp: istate_def)[]
  apply clarsimp
    (* safety property used: isChair_isPC *)
  by (simp add: T.simps assms(1) isAUT_def isChair_isPC not_less_eq_eq reachNT_reach)

lemma P_\<phi>_\<gamma>:
assumes 1: "reachNT s" and 2: "step s a = (ou,s')" "\<phi> (Trans s a ou s')"
shows "\<not> \<gamma> (Trans s a ou s')"
using reachNT_non_isAut_isPC_isChair[OF 1] 2 unfolding T.simps \<phi>_def2
by (auto simp add: u_defs)

(* Note: the following alternative formulation is not always guaranteed to hold,
due to the trigger T speaking about s', not s:
lemma P_\<phi>_\<gamma>:
assumes 1: "\<not> T (Trans s a ou s')" and 2: "step s a = (ou,s')" "\<phi> (Trans s a ou s')"
shows "\<not> \<gamma> (Trans s a ou s')"
using 1 2 unfolding T.simps \<phi>_def2
by (auto simp add: u_defs)
*)

text \<open>major\<close> lemma eqButPID_step_out:
assumes s's1': "eqButPID s s1"
and step: "step s a = (ou,s')" and step1: "step s1 a = (ou1,s1')"
and sT: "reachNT s" and s1: "reach s1"
and PID: "PID \<in>\<in> paperIDs s cid"
and UIDs: "userOfA a \<in> UIDs"
shows "ou = ou1"
proof-
  note Inv = reachNT_non_isAut_isPC_isChair[OF sT UIDs]
  note eqs = eqButPID_imp[OF s's1']
  note eqs' = eqButPID_imp1[OF s's1']
  note s = reachNT_reach[OF sT]

  note simps[simp] = c_defs u_defs uu_defs r_defs l_defs Paper_dest_conv eqButPID_def eeqButPID_def eqButC
  note * = step step1 eqs eqs' s s1 PID UIDs paperIDs_equals[OF s] Inv

  show ?thesis
  proof (cases a)
    case (Cact x1)
    then show ?thesis using * by (cases x1; auto)
  next
    case (Uact x2)
    then show ?thesis using * by (cases x2; auto)
  next
    case (UUact x3)
    then show ?thesis using * by (cases x3; auto)
  next
    case (Ract x4)
    with * show ?thesis
    proof (cases x4)
      case (rPaperC x61 x62 x63 x64)
      then show ?thesis using * Ract by (clarsimp; metis not_less_eq_eq)
    next
      case (rMyReview x81 x82 x83 x84)
      then show ?thesis using * Ract by (auto simp: getNthReview_def)
    next
      case (rReviews x91 x92 x93 x94)
      then show ?thesis using * Ract by (clarsimp; metis Suc_leD eqButPID_imp2 not_less_eq_eq s's1')
    qed auto
  next
    case (Lact x5)
    then show ?thesis using * by (cases x5; auto)
  qed
qed

definition \<Delta>1 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>1 s vl s1 vl1 \<equiv> \<not> (\<exists>cid. PID \<in>\<in> paperIDs s cid) \<and> s = s1 \<and> B vl vl1"

definition \<Delta>2 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>2 s vl s1 vl1 \<equiv>
 \<exists>cid. PID \<in>\<in> paperIDs s cid \<and> phase s cid = subPH \<and> eqButPID s s1"

definition \<Delta>3 :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>3 s vl s1 vl1 \<equiv>
 \<exists>cid. PID \<in>\<in> paperIDs s cid \<and> eqButPID s s1 \<and> phase s cid > subPH \<and> vl=[] \<and> vl1=[]"

definition \<Delta>e :: "state \<Rightarrow> value list \<Rightarrow> state \<Rightarrow> value list \<Rightarrow> bool" where
"\<Delta>e s vl s1 vl1 \<equiv>
 \<exists>cid. PID \<in>\<in> paperIDs s cid \<and> phase s cid > subPH \<and> vl \<noteq> []"

lemma istate_\<Delta>1:
assumes B: "B vl vl1"
shows "\<Delta>1 istate vl istate vl1"
using B unfolding \<Delta>1_def B_def istate_def by auto

lemma unwind_cont_\<Delta>1: "unwind_cont \<Delta>1 {\<Delta>1,\<Delta>2,\<Delta>e}"
proof(rule, goal_cases)
  case (1 s vl s1 vl1)
  (*fix s s1 :: state and vl vl1 :: "value list"*)
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>1 s vl s1 vl1"
  hence rs: "reach s" and ss1: "s1 = s" and vl: "vl \<noteq> []"
    and pid: "\<forall>cid. PID \<notin> set (paperIDs s cid)"
  using reachNT_reach unfolding \<Delta>1_def B_def by auto
  show ?case (is "?iact \<or> (_ \<and> ?react)")
  proof-
    have ?react proof (rule, goal_cases)
      case (1 a ou s' vl')
      let ?trn = "Trans s a ou s'"  let ?trn1 = "Trans s1 a ou s'"
      assume step: "step s a = (ou, s')"
        and T: "\<not> T ?trn" and c: "consume ?trn vl vl'"
      have \<phi>: "\<not> \<phi> ?trn"
        apply(cases a)
        subgoal by simp
        subgoal for x2 apply(cases x2) using step pid by(auto simp: u_defs)
        by simp_all
      hence vl': "vl' = vl" using c unfolding consume_def by auto
      show ?case (is "?match \<or> ?ignore")
      proof-
        have ?match proof
          show "validTrans ?trn1" unfolding ss1 using step by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def ss1 using \<phi> by auto
        next
          show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
        next
          assume "\<gamma> ?trn" thus "g ?trn = g ?trn1" unfolding ss1 by simp
        next
          show "disjAll {\<Delta>1, \<Delta>2, \<Delta>e} s' vl' s' vl1"
          proof (cases "\<exists>cid. PID \<in>\<in> paperIDs s' cid")
            case False hence "\<Delta>1 s' vl' s' vl1"
              by (simp add: \<Delta>1_def B_def vl vl')
            thus ?thesis by simp
          next
            case True
            hence "\<Delta>2 s' vl' s' vl1"
              using step pid
              apply (simp add: \<Delta>2_def vl' vl)
              apply (erule exE)
              subgoal for cid apply (rule exI[of _ cid])
                apply (cases a)
                  subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
                  subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
                  subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
                  by simp_all
              done
            thus ?thesis by simp
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis using vl by simp
  qed
qed

lemma unwind_cont_\<Delta>2: "unwind_cont \<Delta>2 {\<Delta>2,\<Delta>3,\<Delta>e}"
proof(rule,goal_cases)
  case (1 s vl s1 vl1)
  assume rsT: "reachNT s" and rs1: "reach s1" and "\<Delta>2 s vl s1 vl1"
  then obtain cid where rs: "reach s"
    and pid: "PID \<in>\<in> paperIDs s cid" and ss1: "eqButPID s s1"
    and ph: "phase s cid = subPH"
    using reachNT_reach unfolding \<Delta>2_def by auto

  have cid: "cid \<in>\<in> confIDs s"
    by (metis paperIDs_confIDs pid rs)

  from pid ph cid have
    pid1: "PID \<in>\<in> paperIDs s1 cid"
    and ph1: "phase s1 cid = subPH"
    and cid1: "cid \<in>\<in> confIDs s1"
    by (auto simp add: eqButPID_imp[OF ss1])

  show ?case (is "?iact \<or> (_ \<and> ?react)")
  proof (cases vl1)
    case (Cons v vl1') note this[simp]
    obtain uid1 where aut1: "isAut s1 cid uid1 PID"
      thm paperID_ex_userID
      using paperID_ex_userID[OF rs1 pid1] by auto
    have uid1: "uid1 \<in>\<in> userIDs s1"
      by (metis roles_userIDs rs1 aut1)

    from aut1 have "isAut s cid uid1 PID"
      using ss1 aut1 by (simp add: eqButPID_imp[OF ss1])
    with reachNT_non_isAut_isPC_isChair[OF rsT] uid1 have uid1_ne: "uid1\<notin>UIDs"
      by auto

    let ?a1 = "(Uact (uPaperC cid uid1 (pass s1 uid1) PID v))"
    obtain s1' where step: "step s1 ?a1 = (outOK,s1')" and s1's1: "eqButPID s1' s1"
      by (cases "paper s1 PID")
         (auto simp add: u_defs cid1 uid1 pid1 ph1 aut1 eqButPID_def eeqButPID_def)

    have "?iact"
    proof
      show "step s1 ?a1 = (outOK,s1')" using step .
      show "\<phi> (Trans s1 ?a1 outOK s1')" by simp
      show "consume (Trans s1 ?a1 outOK s1') vl1 vl1'" by (simp add: consume_def)
      show "\<not>\<gamma> (Trans s1 ?a1 outOK s1')" by (simp add: uid1_ne)
      have "\<Delta>2 s vl s1' vl1'" unfolding \<Delta>2_def
        apply (rule exI[where x=cid])
        using ph pid
        apply clarsimp
        by (metis s1's1 eqButPID_sym eqButPID_trans ss1)
      thus "disjAll {\<Delta>2, \<Delta>3, \<Delta>e} s vl s1' vl1'" by simp
    qed
    thus ?thesis by simp
  next
    case Nil note this[simp]
    have "?react"
    proof (rule, goal_cases)
      case (1 a ou s' vl')
      assume STEP: "step s a = (ou, s')" and "\<not> T (Trans s a ou s')"
        and CONSUME: "consume (Trans s a ou s') vl vl'"

      have ph': "phase s' cid \<ge> subPH"
        by (smt STEP ph phase_increases)

      have pid': "PID \<in>\<in> paperIDs s' cid" using pid STEP
        by (metis paperIDs_mono)

      {
        fix s1 vl1
        assume "phase s' cid \<noteq> subPH" "vl'\<noteq>[]"
        hence "\<Delta>e s' vl' s1 vl1"
          unfolding \<Delta>e_def
          apply -
          apply(rule exI[of _ cid])
          using STEP CONSUME ph
          apply (cases a)
          subgoal for x1 apply (cases x1) apply(auto simp: c_defs) .
          subgoal for x2 apply (cases x2) apply(auto simp: u_defs consume_def pid) .
          subgoal for x3 apply (cases x3) apply(auto simp: uu_defs) .
          by simp_all
      } note \<Delta>e=this

      obtain s1' ou' where
        STEP': "step s1 a = (ou',s1')" and s's1': "eqButPID s' s1'"
        using eqButPID_step[OF ss1 STEP]
        by fastforce

      from eqButPID_step_\<phi>[OF ss1 STEP STEP']
      have \<phi>_eq: "\<phi> (Trans s1 a ou' s1') = \<phi> (Trans s a ou s')" by simp

      show ?case (is "?match \<or> ?ignore")
      proof (cases "\<phi> (Trans s a ou s')")
        case True note \<phi>=this

        then obtain cid' uid p where
          a[simp]: "a=Uact (uPaperC cid' uid p PID (hd vl))" "ou=outOK"
          using CONSUME
          by (cases "(Trans s a ou s')" rule: f.cases) (auto simp add: consume_def)

        from STEP pid have [simp]: "cid'=cid"
          by (simp add: u_defs paperIDs_equals[OF rs])

        from \<phi>_step_eqButPID[OF \<phi> STEP] have ss': "eqButPID s s'" .

        have n\<gamma>: "\<not>\<gamma> (Trans s a ou s')"
          using P_\<phi>_\<gamma>[OF rsT STEP] by simp

        have ph': "phase s' cid = subPH"
          using STEP by (auto simp add: u_defs)

        have ?ignore
        proof
          show "\<not> \<gamma> (Trans s a ou s')" by (rule n\<gamma>)
          have "\<Delta>2 s' vl' s1 vl1"
            unfolding \<Delta>2_def
            using ph' pid' eqButPID_trans[OF eqButPID_sym[OF ss'] ss1]
            by auto
          thus "disjAll {\<Delta>2, \<Delta>3, \<Delta>e} s' vl' s1 vl1" by simp
        qed
        thus ?thesis by simp
      next
        case False note \<phi>=this
        with CONSUME have [simp]: "vl'=vl" by (simp add: consume_def)

        have ?match proof
          show "validTrans (Trans s1 a ou' s1')" using STEP' by simp
          show "consume (Trans s1 a ou' s1') vl1 vl1" using \<phi>
            by (simp add: consume_def \<phi>_eq)
          show "\<gamma> (Trans s a ou s') = \<gamma> (Trans s1 a ou' s1')" by simp
          show "\<gamma> (Trans s a ou s') \<Longrightarrow> g (Trans s a ou s') = g (Trans s1 a ou' s1')"
            using eqButPID_step_out[OF ss1 STEP STEP' rsT rs1 pid]
            by simp
          show "disjAll {\<Delta>2, \<Delta>3, \<Delta>e} s' vl' s1' vl1"
          proof (cases "phase s' cid = subPH")
            case True
            hence "\<Delta>2 s' vl' s1' vl1"
              unfolding \<Delta>2_def
              using eqButPID_step[OF ss1 STEP STEP']
              using ph' pid' by auto
            thus ?thesis by simp
          next
            case False with ph' have ph': "subPH < phase s' cid" by simp
            show ?thesis proof (cases "vl'=[]")
              case False
              hence "\<Delta>e s' vl' s1' vl1" using \<Delta>e ph' by simp
              thus ?thesis by simp
            next
              case True
              hence "\<Delta>3 s' vl' s1' vl1"
                unfolding \<Delta>3_def
                apply(intro exI[of _ cid])
                using ph' pid' eqButPID_step[OF ss1 STEP STEP']
                by simp
              thus ?thesis by simp
            qed
          qed
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?thesis by simp
  qed
qed

lemma unwind_cont_\<Delta>3: "unwind_cont \<Delta>3 {\<Delta>3,\<Delta>e}"
proof (rule, goal_cases)
  case (1 s vl s1 vl1)
  assume rsT: "reachNT s" and rs1: "reach s1" and \<Delta>: "\<Delta>3 s vl s1 vl1"
  thm \<Delta>3_def
  then obtain cid where ss1: "eqButPID s s1" and [simp]: "vl=[]" "vl1=[]"
    and pid: "PID \<in>\<in> paperIDs s cid" and ph: "subPH < phase s cid"
    unfolding \<Delta>3_def by auto

  from rsT have rs: "reach s"
    by (metis reachNT_reach)

  from pid ph have
    pid1: "PID \<in>\<in> paperIDs s1 cid"
    and ph1: "subPH < phase s1 cid"
    using ss1
    by (auto simp add: eqButPID_imp)

  thus ?case (is "_ \<or> (_ \<and> ?react)")
  proof -
    have "?react"
    proof (rule, goal_cases)
      case (1 a ou s' vl')
      assume STEP: "step s a = (ou, s')" and NT: "\<not> T (Trans s a ou s')" (is "\<not>T ?trn")
        and CONSUME: "consume (Trans s a ou s') vl vl'"

      show ?case (is "?match \<or> _")
      proof -

        have ph': "subPH < phase s' cid"
         using STEP ph phase_increases by (meson le_trans not_less)

        have [simp]: "vl'=[]" using CONSUME by (auto simp add: consume_def)

        obtain ou1 and s1' where STEP1: "step s1 a = (ou1,s1')"
          by (metis prod.exhaust)
        let ?trn1 = "Trans s1 a ou1 s1'"
        have s's1': "eqButPID s' s1'" using eqButPID_step[OF ss1 STEP STEP1] .

        from s's1' ph' have ph1': "subPH < phase s1' cid"
          by (simp add: eqButPID_imp)

        have \<phi>: "\<not> \<phi> ?trn1"
          using STEP1 ph1' unfolding \<phi>_def2 by (auto simp: u_defs paperIDs_equals[OF rs1 pid1])

        have ?match proof
          show "validTrans ?trn1" using STEP1 by simp
        next
          show "consume ?trn1 vl1 vl1" unfolding consume_def using \<phi> by auto
        next
          show "\<gamma> ?trn = \<gamma> ?trn1" unfolding ss1 by simp
        next
          assume "\<gamma> ?trn" thus "g ?trn = g ?trn1"
          using eqButPID_step_out[OF ss1 STEP STEP1 rsT rs1 pid] by simp
        next
          have "\<Delta>3 s' vl' s1' vl1" using ph' s's1' paperIDs_mono[OF STEP pid]
            unfolding \<Delta>3_def by auto
          thus "disjAll {\<Delta>3, \<Delta>e} s' vl' s1' vl1" by simp
        qed
        thus ?thesis by simp
      qed
    qed
    thus ?case by simp
  qed
qed

definition K1exit where
"K1exit s \<equiv> \<exists>cid. phase s cid > subPH \<and> PID \<in>\<in> paperIDs s cid"

lemma invarNT_K1exit: "invarNT K1exit"
  unfolding invarNT_def apply (safe dest!: reachNT_reach)
  subgoal for _ a apply(cases a)
    subgoal for x1 apply (cases x1, auto simp: c_defs K1exit_def) .
    subgoal for x2 apply (cases x2)
      apply(auto simp: u_defs K1exit_def paperIDs_equals)
      apply (metis less_nat_zero_code)
      apply (metis Suc_lessD) .
    subgoal for x3 apply (cases x3, auto simp: uu_defs K1exit_def) .
    by simp_all
  done

lemma noVal_K1exit: "noVal K1exit v"
  apply(rule no\<phi>_noVal)
  unfolding no\<phi>_def apply safe
  subgoal for _ a apply(cases a)
    subgoal by simp
    subgoal for x2
      apply(cases x2, auto simp add: u_defs K1exit_def) []
      apply (metis reachNT_reach less_not_refl paperIDs_equals) .
    by simp_all
  done

lemma unwind_exit_\<Delta>e: "unwind_exit \<Delta>e"
proof
  fix s s1 :: state and vl vl1 :: "value list"
  assume rsT: "reachNT s" and rs1: "reach s1" and \<Delta>e: "\<Delta>e s vl s1 vl1"
  hence vl: "vl \<noteq> []" using reachNT_reach unfolding \<Delta>e_def by auto
  hence "K1exit s" using \<Delta>e unfolding K1exit_def \<Delta>e_def by auto
  thus "vl \<noteq> [] \<and> exit s (hd vl)" apply(simp add: vl)
  by (metis rsT exitI2 invarNT_K1exit noVal_K1exit)
qed

theorem secure: secure
  apply(rule unwind_decomp3_secure[of \<Delta>1 \<Delta>2 \<Delta>e \<Delta>3])
  using
    istate_\<Delta>1
    unwind_cont_\<Delta>1 unwind_cont_\<Delta>2 unwind_cont_\<Delta>3
    unwind_exit_\<Delta>e
  by auto

end