theory LLVM_Memory
imports Monad2 LLVM_Integer LLVM_Pre_Syntax Definition_Utils
begin

  section \<open>Monad Setup\<close>

  datatype err = is_static: STATIC_ERROR string | MEM_ERROR | UNINIT_ERROR | OVERFLOW_ERROR
  hide_const (open) is_static

  abbreviation lift_lens_static ("'(_')\<^sub>S")
    where "lift_lens_static \<equiv> lift_lens (STATIC_ERROR ''lens'')"

  abbreviation lift_lens_mem ("'(_')\<^sub>M")
    where "lift_lens_mem \<equiv> lift_lens MEM_ERROR"

  abbreviation lift_lens_uninit ("'(_')\<^sub>U")
    where "lift_lens_uninit \<equiv> lift_lens UNINIT_ERROR"

  section \<open>Values\<close>

  subsection \<open>Pointers\<close>
  datatype block_addr = BLOCK_ADDR (the_block: nat)

  datatype va_item = VA_ARRAY_IDX (aidx: nat) | VA_FIELD_IDX (fidx: nat)
  hide_const (open) aidx fidx
  define_lenses (open) va_item

  type_synonym vaddr = "va_item list"

  datatype addr = ADDR (block_addr: block_addr) (vaddr: vaddr)
  hide_const (open) block_addr vaddr
  define_lenses (open) addr

  subsection \<open>Structured Values\<close>

  datatype val =
    VINT (lint: "nat + lint")   \<comment> \<open>\<open>width + lint\<close>\<close>
  | VPTR (addr: "addr option option")
  | VARRAY (items: "val list")
  | VSTRUCT (fields: "val list")

  hide_const (open) lint addr items fields
  define_lenses (open) val

  fun uninit where
    "uninit (TINT w) = VINT (Inl w)"
  | "uninit (TPTR _) = VPTR None"
  | "uninit (TARRAY n ty) = VARRAY (replicate n (uninit ty))"
  | "uninit (TSTRUCT tys) = VSTRUCT (map uninit tys)"

  fun wpi_width where
    "wpi_width (Inl w) = w"
  | "wpi_width (Inr i) = width i"

  fun same_struct :: "val \<Rightarrow> val \<Rightarrow> bool" where
    "same_struct (VINT a) (VINT b) \<longleftrightarrow> wpi_width a = wpi_width b"
  | "same_struct (VPTR _) (VPTR _) \<longleftrightarrow> True"
  | "same_struct (VARRAY xs) (VARRAY ys) \<longleftrightarrow> list_all2 same_struct xs ys"
  | "same_struct (VSTRUCT xs) (VSTRUCT ys) \<longleftrightarrow> list_all2 same_struct xs ys"
  | "same_struct _ _ \<longleftrightarrow> False"

  lemma same_struct_refl[simp]: "same_struct v v"
    apply (induction v)
    apply (auto simp: list.rel_refl_strong)
    done

  lemma same_struct_sym: "same_struct a b \<Longrightarrow> same_struct b a"
    apply (induction a b rule: same_struct.induct)
    apply (auto simp: list_all2_conv_all_nth)
    done

  lemma same_struct_trans[trans]: "same_struct a b \<Longrightarrow> same_struct b c \<Longrightarrow> same_struct a c"
    apply (induction a b arbitrary: c rule: same_struct.induct)
    apply simp_all
    apply (case_tac c; auto simp: list_all2_conv_all_nth in_set_conv_nth; blast)+
    done

  definition "put_same_struct L a b \<equiv> doM {
    v \<leftarrow> mget L b;
    fcheck (STATIC_ERROR ''val-struct change'') (same_struct a v);
    mput L a b
  }"

  subsection \<open>Conversion to Type-Representations\<close>
  definition to_ptr where
    "to_ptr v \<equiv> case (v) of
        (VPTR (Some p)) \<Rightarrow> return p
      | (VPTR None) \<Rightarrow> fail UNINIT_ERROR
      | _ \<Rightarrow> fail (STATIC_ERROR ''to_ptr'')"

  definition to_addr where
    "to_addr v \<equiv> case (v) of
        (VPTR (Some (Some p))) \<Rightarrow> return p
      | (VPTR (Some None)) \<Rightarrow> fail MEM_ERROR
      | (VPTR None) \<Rightarrow> fail UNINIT_ERROR
      | _ \<Rightarrow> fail (STATIC_ERROR ''to_addr'')"

  definition to_lint where
    "to_lint v \<equiv> case (v) of
        (VINT (Inr i)) \<Rightarrow> return i
      | (VINT (Inl _)) \<Rightarrow> fail UNINIT_ERROR
      | _ \<Rightarrow> fail (STATIC_ERROR ''to_int'')"

  definition to_uint where
    "to_uint v \<equiv> doM { v\<leftarrow>to_lint v; return (lint_to_uint v) }"

  definition to_sint where
    "to_sint v \<equiv> doM { v\<leftarrow>to_lint v; return (lint_to_sint v) }"

  definition to_nat where
    "to_nat v \<equiv> doM { v \<leftarrow> to_uint v; return (nat v) }"

  definition to_bool where
    "to_bool v \<equiv> doM {
      v \<leftarrow> to_lint v;
      fcheck (STATIC_ERROR ''to_bool'') (width v = 1);
      return (lint_to_bool v)
    }"

  definition "from_addr addr \<equiv> return (VPTR (Some (Some addr)))"
  definition "from_lint i \<equiv> return (VINT (Inr i))"
  definition "from_bool b \<equiv> return (VINT (Inr (bool_to_lint b)))"

  definition "op_lift1 T R f x \<equiv> doM {
    x \<leftarrow> T x;
    r \<leftarrow> f x;
    R r
  }"

  definition "op_lift2 T1 T2 R f x1 x2 \<equiv> doM {
    x1 \<leftarrow> T1 x1;
    x2 \<leftarrow> T2 x2;
    r \<leftarrow> f x1 x2;
    R r
  }"

  definition "op_lift3 T1 T2 T3 R f x1 x2 x3 \<equiv> doM {
    x1 \<leftarrow> T1 x1;
    x2 \<leftarrow> T2 x2;
    x3 \<leftarrow> T3 x3;
    r \<leftarrow> f x1 x2 x3;
    R r
  }"

  section \<open>Memory\<close>

  datatype block_type = ON_STACK | ON_HEAP
  hide_const (open) ON_STACK ON_HEAP

  datatype memory = MEM (mem: "(val \<times> block_type) option list")
  hide_const (open) mem
  define_lenses memory

  abbreviation "memL \<equiv> (mem\<^sub>L)\<^sub>S"
  abbreviation "idxL i \<equiv> (idx\<^sub>L i)\<^sub>M"

  definition "mem_empty \<equiv> MEM []"

  subsection \<open>Allocate and Free\<close>

  definition "block_allocate bty v \<equiv> (doM {
    \<mu>\<leftarrow>use memL;
    memL %= (\<lambda>\<mu>. \<mu>@[Some (v,bty)]);
    return (BLOCK_ADDR (length \<mu>))
  })"

  definition "block_free bty b \<equiv> doM {
    let L = memL \<bullet> idxL (the_block b);
    (_,ty')\<leftarrow>use (L \<bullet> (the\<^sub>L)\<^sub>M);
    fcheck MEM_ERROR (bty=ty');
    L := None
  }"

  definition "llb_malloc ty n \<equiv> doM {
    fcheck MEM_ERROR (n>0);
    let n = nat n;
    let v = uninit (TARRAY n ty);
    r \<leftarrow> block_allocate block_type.ON_HEAP v;
    return (ADDR r [VA_ARRAY_IDX 0])
  }"

  definition "llb_free addr \<equiv> doM {
    case addr of
        ADDR b [VA_ARRAY_IDX 0] \<Rightarrow> block_free block_type.ON_HEAP b
      | _ \<Rightarrow> fail MEM_ERROR
  }"

  definition "blockL' b \<equiv> memL \<bullet> (idx\<^sub>L (the_block b))\<^sub>S \<bullet> (the\<^sub>L)\<^sub>M"
  definition "blockL b \<equiv> memL \<bullet> (idx\<^sub>L (the_block b))\<^sub>S \<bullet> (the\<^sub>L)\<^sub>M \<bullet> (fst\<^sub>L)\<^sub>S"

  lemma blockL_elens[simp]:
    "elens (blockL b)"
    "elens (blockL' b)"
    by (auto simp: blockL_def blockL'_def)

  subsection \<open>Load and Store\<close>

  definition "struct_field\<^sub>L i \<equiv> (val.fields\<^sub>L \<bullet>\<^sub>L idx\<^sub>L i)\<^sub>S"
  (*definition "static_array_item\<^sub>L i \<equiv> (val.items\<^sub>L \<bullet>\<^sub>L idx\<^sub>L i)\<^sub>S"*)
  definition "array_item\<^sub>L i \<equiv> (val.items\<^sub>L)\<^sub>S \<bullet> idxL i"

  fun lens_of_vai where
    "lens_of_vai (VA_ARRAY_IDX i) = array_item\<^sub>L i"
  | "lens_of_vai (VA_FIELD_IDX i) = struct_field\<^sub>L i"

  definition "lens_of_vaddr va \<equiv> foldr (\<lambda>vai p. lens_of_vai vai \<bullet> p) va (id\<^sub>L)\<^sub>S"

  fun lens_of_addr where
    "lens_of_addr (ADDR b va) = blockL b \<bullet> lens_of_vaddr va"

  definition llb_load where
    "llb_load addr \<equiv> use (lens_of_addr addr)"

  definition llb_store where
    "llb_store v addr \<equiv> doM {
      ov \<leftarrow> use (lens_of_addr addr);
      fcheck (STATIC_ERROR ''mem-struct change'') (same_struct v ov);
      lens_of_addr addr := v
    }"

  subsection \<open>GEP, Insert, and Extract\<close>

  definition llb_ofs_addr :: "addr \<Rightarrow> int \<Rightarrow> _" where
    "llb_ofs_addr a i \<equiv> map_lens (addr.vaddr\<^sub>L\<bullet>\<^sub>Llast\<^sub>L\<bullet>\<^sub>Lva_item.aidx\<^sub>L)\<^sub>M (\<lambda>idx. doM {
      let idx = int idx + i;
      fcheck MEM_ERROR (idx\<ge>0);
      return (nat idx)
    }) a"

  definition llb_idx_array :: "addr \<Rightarrow> int \<Rightarrow> _" where
    "llb_idx_array a i \<equiv> map_lens (addr.vaddr\<^sub>L)\<^sub>S (\<lambda>x. doM {
      fcheck MEM_ERROR (i\<ge>0);
      return (x@[VA_ARRAY_IDX (nat i)])
    } ) a"

  definition llb_idx_field :: "addr \<Rightarrow> nat \<Rightarrow> _" where
    "llb_idx_field a i \<equiv> map_lens (addr.vaddr\<^sub>L)\<^sub>S (\<lambda>x. doM {
      return (x@[VA_FIELD_IDX i])
    } ) a"

  definition ll_insert_s_value' where "ll_insert_s_value' bv ev idx \<equiv> put_same_struct (struct_field\<^sub>L idx) ev bv"
  definition ll_extract_s_value' where "ll_extract_s_value' bv idx \<equiv> mget (struct_field\<^sub>L idx) bv"
  definition ll_insert_a_value' where "ll_insert_a_value' bv ev idx \<equiv> put_same_struct (array_item\<^sub>L idx) ev bv"
  definition ll_extract_a_value' where "ll_extract_a_value' bv idx \<equiv> mget (array_item\<^sub>L idx) bv"

section \<open>Arithmetic\<close>

  definition "op_arith2 ovf f x1 x2 = doM {
    fcheck (STATIC_ERROR ''arith2 incompatible widths'') (width x1 = width x2);
    fcheck (OVERFLOW_ERROR) (\<not>ovf x1 x2);
    return (f x1 x2)
  }"

  definition "op_lift_arith2 ovf f \<equiv> op_lift2 to_lint to_lint from_lint (op_arith2 ovf f)"
  definition "op_lift_arith2' \<equiv> op_lift_arith2 (\<lambda>_ _. False)"
  definition "op_lift_cmp2 f \<equiv> op_lift2 to_lint to_lint from_bool (op_arith2 (\<lambda>_ _. False) f)"

  definition "llb_trunc i w \<equiv> doM {
    fcheck (STATIC_ERROR ''Trunc must go to smaller type'') (width i > w);
    return (trunc w i)
  }"

  definition "llb_sext i w \<equiv> doM {
    fcheck (STATIC_ERROR ''Sext must go to greater type'') (width i < w);
    return (sext w i)
  }"

  definition "llb_zext i w \<equiv> doM {
    fcheck (STATIC_ERROR ''Zext must go to greater type'') (width i < w);
    return (zext w i)
  }"

  definition "to_iTw ty \<equiv> case ty of TINT w \<Rightarrow> return w | _ \<Rightarrow> fail (STATIC_ERROR ''Expected int type'')"

  definition "shift_ovf a n \<equiv> nat (lint_to_uint n) \<ge> width a"

  definition "bitSHL' a n \<equiv> bitSHL a (nat (lint_to_uint n))"
  definition "bitASHR' a n \<equiv> bitASHR a (nat (lint_to_uint n))"
  definition "bitLSHR' a n \<equiv> bitLSHR a (nat (lint_to_uint n))"

section \<open>LLVM Operations\<close>

  type_synonym llM = "(_,unit,memory,err) M"

  definition ll_add :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_add \<equiv> op_lift_arith2' (+)"
  definition ll_sub :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_sub \<equiv> op_lift_arith2' (-)"
  definition ll_mul :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_mul \<equiv> op_lift_arith2' ( * )"
  definition ll_udiv :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_udiv \<equiv> op_lift_arith2' (div)"
  definition ll_urem :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_urem \<equiv> op_lift_arith2' (mod)"
  definition ll_sdiv :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_sdiv \<equiv> op_lift_arith2 sdivrem_ovf (div\<^sub>s)"
  definition ll_srem :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_srem \<equiv> op_lift_arith2 sdivrem_ovf (rem\<^sub>s)"
  definition ll_shl :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_shl \<equiv> op_lift_arith2 shift_ovf bitSHL'"
  definition ll_lshr :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_lshr \<equiv> op_lift_arith2 shift_ovf bitLSHR'"
  definition ll_ashr :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_ashr \<equiv> op_lift_arith2 shift_ovf bitASHR'"
  definition ll_trunc :: "val \<Rightarrow> type \<Rightarrow> llM" where "ll_trunc \<equiv> op_lift2 to_lint to_iTw from_lint llb_trunc"
  definition ll_sext :: "val \<Rightarrow> type \<Rightarrow> llM" where "ll_sext \<equiv> op_lift2 to_lint to_iTw from_lint llb_sext"
  definition ll_zext :: "val \<Rightarrow> type \<Rightarrow> llM" where "ll_zext \<equiv> op_lift2 to_lint to_iTw from_lint llb_zext"

  definition ll_and :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_and \<equiv> op_lift_arith2' (AND)"
  definition ll_or :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_or \<equiv> op_lift_arith2' (OR)"
  definition ll_xor :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_xor \<equiv> op_lift_arith2' (XOR)"

  definition ll_icmp_eq :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_icmp_eq \<equiv> op_lift_cmp2 (=)"
  definition ll_icmp_ne :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_icmp_ne \<equiv> op_lift_cmp2 (\<noteq>)"
  definition ll_icmp_sle :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_icmp_sle \<equiv> op_lift_cmp2 (\<le>\<^sub>s)"
  definition ll_icmp_slt :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_icmp_slt \<equiv> op_lift_cmp2 (<\<^sub>s)"
  definition ll_icmp_ule :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_icmp_ule \<equiv> op_lift_cmp2 (\<le>)"
  definition ll_icmp_ult :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_icmp_ult \<equiv> op_lift_cmp2 (<)"

  definition ll_malloc :: "type \<Rightarrow> val \<Rightarrow> llM" where "ll_malloc \<equiv> op_lift2 return to_uint from_addr llb_malloc"
  definition ll_free :: "val \<Rightarrow> llM" where "ll_free \<equiv> op_lift1 to_addr return llb_free"

  definition ll_load :: "val \<Rightarrow> llM" where "ll_load \<equiv> op_lift1 to_addr return llb_load"
  definition ll_store :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_store \<equiv> op_lift2 return to_addr return llb_store"

  definition ll_insert_s_value :: "val \<Rightarrow> val \<Rightarrow> nat \<Rightarrow> llM" where "ll_insert_s_value bv ev idx \<equiv> put_same_struct (struct_field\<^sub>L idx) ev bv"
  definition ll_extract_s_value :: "val \<Rightarrow> nat \<Rightarrow> llM" where "ll_extract_s_value bv idx \<equiv> mget (struct_field\<^sub>L idx) bv"
  definition ll_insert_a_value :: "val \<Rightarrow> val \<Rightarrow> nat \<Rightarrow> llM" where "ll_insert_a_value bv ev idx \<equiv> put_same_struct (array_item\<^sub>L idx) ev bv"
  definition ll_extract_a_value :: "val \<Rightarrow> nat \<Rightarrow> llM" where "ll_extract_a_value bv idx \<equiv> mget (array_item\<^sub>L idx) bv"

  definition ll_ofs_addr :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_ofs_addr \<equiv> op_lift2 to_addr to_sint from_addr llb_ofs_addr"
  definition ll_idx_array :: "val \<Rightarrow> val \<Rightarrow> llM" where "ll_idx_array \<equiv> op_lift2 to_addr to_sint from_addr llb_idx_array"
  definition ll_idx_field :: "val \<Rightarrow> nat \<Rightarrow> llM" where "ll_idx_field \<equiv> op_lift2 to_addr return from_addr llb_idx_field"

  definition "llop_iconst w i \<equiv> VINT (Inr (lconst w i))"
  definition "llop_undef ty \<equiv> uninit ty"

  definition llc_if :: "val \<Rightarrow> llM \<Rightarrow> llM \<Rightarrow> llM" where
    "llc_if b t e \<equiv> doM {
      b \<leftarrow> to_bool b;
      if b then t else e
    }"

  definition llc_while :: "(val \<Rightarrow> llM) \<Rightarrow> (val \<Rightarrow> llM) \<Rightarrow> val \<Rightarrow> llM" where
    "llc_while b f s\<^sub>0 \<equiv> mwhile (\<lambda>s. b s \<bind> to_bool) f s\<^sub>0"

  abbreviation "ty_i64xi64 \<equiv> TSTRUCT [TINT 64, TINT 64]"

  definition exp where "exp i \<equiv> doM {
    s \<leftarrow> ll_insert_s_value (llop_undef ty_i64xi64) (llop_iconst 64 1) 0;
    s \<leftarrow> ll_insert_s_value s i 1;

    s \<leftarrow> llc_while
      (\<lambda>s. doM {
        c \<leftarrow> ll_extract_s_value s 0;
        i \<leftarrow> ll_extract_s_value s 1;
        ll_icmp_ne i (llop_iconst 64 0)
      })
      (\<lambda>s. doM {
        c \<leftarrow> ll_extract_s_value s 0;
        i \<leftarrow> ll_extract_s_value s 1;
        c \<leftarrow> ll_mul c (llop_iconst 64 2);
        i \<leftarrow> ll_sub i (llop_iconst 64 1);
        s \<leftarrow> ll_insert_s_value (llop_undef ty_i64xi64) c 0;
        s \<leftarrow> ll_insert_s_value s i 1;
        return s
      })
      s;

    c \<leftarrow> ll_extract_s_value s 0;
    return c
  }"

  definition exec :: "(val, unit, memory, err) M \<Rightarrow> (int, unit, memory, err) mres"
    where "exec m \<equiv> run (m \<bind> to_sint) mem_empty"

  term pretty_val

  value "exec (ll_insert_s_value (llop_undef ty_i64xi64) (llop_iconst 64 1) 0)"

  value "exec (exp (llop_iconst 64 5))"

  thm exp_def[unfolded llc_while_def mwhile_def]

  lemma gen_code_thm_llc_while:
    assumes "f \<equiv> llc_while b body"
    shows "f s = doM { ctd \<leftarrow> b s; llc_if ctd (doM { s\<leftarrow>body s; f s}) (return s)}"
    unfolding assms
    unfolding llc_while_def llc_if_def
    apply (rewrite mwhile_unfold)
    by simp

  setup {*
    Definition_Utils.add_extraction "llc_while" {
      pattern = Logic.varify_global @{term "llc_while b body"},
      gen_thm = @{thm gen_code_thm_llc_while},
      gen_tac = Partial_Function.mono_tac
    }
  *}

  prepare_code_thms exp_def
  print_theorems

  thm exp.code

  lemma aux: "(NO_MATCH (bind mm ff) (f x)) \<Longrightarrow> doM { x\<leftarrow>m; f x } = doM { x\<leftarrow>m; r\<leftarrow>f x; return r }" by simp

  declare [[eta_contract = false]]

  ML_file "LLVM_Builder.ml"

  ML \<open>

    structure LLVM_Compiler = struct
      fun normalize_code_thm ctxt thm = let
        fun ensure_abs (t as Abs _) = t
          | ensure_abs t = @{mk_term "\<lambda>x. ?t x"}

        fun normalize_bind1 t = let
          val (f,args) = strip_comb t
          val _ = is_Const f orelse is_Free f orelse raise TERM ("Invalid head",[f])

          val _ = @{print} f

          fun is_M_type (Type (@{type_name M},_)) = true | is_M_type _ = false

          val args_is_M = fastype_of f |> binder_types |> map is_M_type

          val args = map2 (fn isM => isM?normalize) args_is_M args

        in
          list_comb (f, args)
        end

        and normalize @{mpat "bind ?m ?f"} = let
            val m = normalize_bind1 m
            val f = ensure_abs f |> normalize
          in @{mk_term "bind ?m ?f"} end
        | normalize (Abs (x,T,t)) = Abs (x,T,normalize t)
        | normalize (t as @{mpat "return _"}) = t
        | normalize t = let val t = normalize_bind1 t in @{mk_term "bind ?t (\<lambda>x. return x)"} end

        fun normalize_eq @{mpat "?a = ?b"} = let val b = normalize b in @{mk_term "?a = ?b"} end
          | normalize_eq t = raise TERM ("normalize_eq", [t])

        fun norm_tac ctxt = ALLGOALS (simp_tac (put_simpset HOL_ss ctxt addsimps @{thms bind_laws}))

      in
        thm
        |> (simplify (put_simpset HOL_ss ctxt addsimps @{thms bind_laws atomize_eq}))
        |> (Conv.fconv_rule (HOLogic.Trueprop_conv (Refine_Util.f_tac_conv ctxt normalize_eq (norm_tac ctxt))))
      end

      datatype bcontext = BCTXT of LLVM_Builder.value Symtab.table * LLVM_Builder.value option list

      fun bctxt_add_bound v (BCTXT (args,bnds)) = BCTXT (args,v::bnds)

      fun bctxt_lookup_bound (BCTXT (_,bnds)) i = nth bnds i |> the
      fun bctxt_lookup_free (BCTXT (args,_)) n = Symtab.lookup args n |> the
      fun val_of_op bc (Bound i) = bctxt_lookup_bound bc i
        | val_of_op bc (Free (n,_)) = bctxt_lookup_free bc n
        | val_of_op _ t = raise TERM ("val_of_op", [t])

      fun compile_do_block b bc t = let
        fun bld_arith_instr bc iname dst op1 op2 = SOME (LLVM_Builder.mk_arith_instr iname b dst (val_of_op bc op1) (val_of_op bc op2))

        fun bld_cmd bc dst @{mpat "ll_add ?op1.0 ?op2.0"} = bld_arith_instr bc "add" dst op1 op2

        fun bld bc @{mpat "bind ?m (\<lambda>x. ?f)"} = let
            val _ = x_T
            val resv = bld_cmd bc x m
            val bc = bctxt_add_bound resv bc
          in
            bld bc f
          end
        | bld bc @{mpat "return ?x"} = val_of_op bc x
        | bld _ t = raise TERM ("bld: bind-chain structural error",[t])

      in
        bld bc t
      end

      fun compile_eq

      xxx, skipped from here to do SHALLOW embedding of types!

    end
  \<close>

  ML_val \<open>
    let

      fun ensure_abs (t as Abs _) = t
        | ensure_abs t = @{mk_term "\<lambda>x. ?t x"}

      fun normalize_bind1 t = let
        val (f,args) = strip_comb t
        val _ = is_Const f orelse is_Free f orelse raise TERM ("Invalid head",[f])

        val _ = @{print} f

        fun is_M_type (Type (@{type_name M},_)) = true | is_M_type _ = false

        val args_is_M = fastype_of f |> binder_types |> map is_M_type

        val args = map2 (fn isM => isM?normalize) args_is_M args

      in
        list_comb (f, args)
      end

      and normalize @{mpat "bind ?m ?f"} = let
          val m = normalize_bind1 m
          val f = ensure_abs f |> normalize
        in @{mk_term "bind ?m ?f"} end
      | normalize (Abs (x,T,t)) = Abs (x,T,normalize t)
      | normalize (t as @{mpat "return _"}) = t
      | normalize t = let val t = normalize_bind1 t in @{mk_term "bind ?t (\<lambda>x. return x)"} end

      fun normalize_eq @{mpat "?a = ?b"} = let val b = normalize b in @{mk_term "?a = ?b"} end
        | normalize_eq t = raise TERM ("normalize_eq", [t])

      fun norm_tac ctxt = ALLGOALS (simp_tac (put_simpset HOL_ss ctxt addsimps @{thms bind_laws}))

      val ctxt = @{context}
    in
      @{thms exp.code}
      |> map (simplify (put_simpset HOL_ss ctxt addsimps @{thms bind_laws atomize_eq}))
      |> map (Conv.fconv_rule (HOLogic.Trueprop_conv (Refine_Util.f_tac_conv ctxt normalize_eq (norm_tac ctxt))))

    end

  \<close>

  find_theorems "(_\<equiv>_)" "(_=_)"

  value "exec (exp (llop_iconst 64 5))"

  ML_val implode

  oops
    xxx, ctd here:
      Produce llvm code from code equations. Generate one procedure per equation.
      Use LLVM-generator interface in ML

      export_code

    ML_val \<open>
      val (s,context) = Name.variant "tmp" Name.context
      val (t,context) = Name.variant "tmp" context

    \<close>

    ML_val \<open>open Int\<close>

end


(*
 * Copyright 2014, NICTA
 *
 * This software may be distributed and modified according to the terms of
 * the GNU General Public License version 2. Note that NO WARRANTY is provided.
 * See "LICENSE_GPLv2.txt" for details.
 *
 * @TAG(NICTA_GPL)
 *)

theory ExampleSystem
imports Access
begin

context begin interpretation Arch . (*FIXME: arch_split*)

definition
  nat_to_bl :: "nat \<Rightarrow> nat \<Rightarrow> bool list option"
where
  "nat_to_bl bits n \<equiv>
    if n \<ge> 2^bits then
      None
    else
      Some $ bin_to_bl bits (of_nat n)"

lemma nat_to_bl_id [simp]: "nat_to_bl (size (x :: (('a::len) word))) (unat x) = Some (to_bl x)"
  apply (clarsimp simp: nat_to_bl_def to_bl_def)
  apply (auto simp: uint_nat le_def word_size)
  done

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

subsection {* Purpose *}

text {*

This file defines some example systems using the access control
definitions. The aim is a sanity check of the AC definitions, to
ensure they enable to reason about reasonable systems.

In particular, we want to make sure that

  . the function state_objs_to_policy does not connect everything to
  everything (Example 1)
  . we can talk about components sharing cnodes
  . we can talk about components sharing frames
  . we can have more than 1 untrusted component
  . we can have an EP between two untrusted components

*}

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

subsection {* Generic functions / lemmas *}

text {* Defining the authority between labels.

In addition to the intuitive authority we want, we need to add all the
authority required to have a wellformed graph. So we define
complete_AgentAuthGraph to add these 'extra' authorities (at least all
the ones not depending on the current label). These are:

  . self-authority (each label needs all the authorities to itself).
  . if Control edge is present between 2 labels then we add all
    authorities between them.
  . Control authority is transitive: we add an Control edge
    between 2 labels if we can connect them via Control
    edges. Actually we add all authorities because of the second
    clause.

*}

definition
  complete_AuthGraph :: "'a auth_graph \<Rightarrow> 'a set \<Rightarrow> 'a auth_graph"
where
  "complete_AuthGraph g ls \<equiv>
     g \<union> {(l,a,l) | a l. l \<in> ls}"

text {* converting a nat to a bool list of size 10 - for the cnodes *}

definition
  the_nat_to_bl :: "nat \<Rightarrow> nat \<Rightarrow> bool list"
where
  "the_nat_to_bl sz n \<equiv> the (nat_to_bl sz n)"

definition
  the_nat_to_bl_10  :: "nat \<Rightarrow> bool list"
where
  "the_nat_to_bl_10 n \<equiv> the_nat_to_bl 10 n"

lemma tcb_cnode_index_nat_to_bl:
  "n<10 \<Longrightarrow> the_nat_to_bl_10 n \<noteq> tcb_cnode_index n"
  by (clarsimp simp: the_nat_to_bl_10_def the_nat_to_bl_def
                     tcb_cnode_index_def
                     nat_to_bl_def to_bl_def bin_to_bl_aux_def)

(*---------------------------------------------------------*)
subsection {* Example 1 *}

text {*

This example aims at checking that we can extract a reasonable policy
from the state, i.e. that the function state_objs_to_policy does not connect
everything to everything.

This example is a system Sys1 made of 2 main components UT1 and T1,
connected through and endpoint EP1. EP1 is made of one single kernel
object: obj1_9, the endpoint. Both UT1 and T1 contains:

  . one TCB (obj1_3079 and obj1_3080 resp.)
  . one vspace made up of one page directory (obj1_6063 and obj1_3065 resp.)
  . each pd contains a single page table (obj1_3072 and obj1_3077 resp.)
  . one cspace made up of one cnode (obj1_6 and obj1_7 resp.)
  . each cspace contains 4 caps:
         one to the tcb
         one to the cnode itself
         one to the vspace
         one to the ep

UT1 can send to the ep while T1 can receive from it.

Attempt to ASCII art:

          --------    ----                      ----     --------
          |       |   |  |                      |  |     |      |
          V       |   |  V     S             R  |  V     |      V
obj1_3079(tcb)-->obj1_6(cnode)--->obj1_9(ep)<---obj1_7(cnode)<--obj1_3080(tcb)
  |               |                                   |            |
  V               |                                   |            V
obj1_3063(pd)<-----                                    -------> obj1_3065(pd)
  |                                                                |
  V                                                                V
obj1_3072(pt)                                                      obj1_3077(pt)

(the references are derived from the dump of the SAC system)

The aim is to be able to prove

  pas_refined Sys1PAS s1

where Sys1PAS is the label graph defining the AC policy for Sys1 and
s1 is the state of Sys1 described above.

This shows that the aag extracted from s1 (by state_objs_to_policy) is
included in the policy graph Sys1PAS.

*}

subsubsection {* Defining the State *}

text {* We need to define the asids of each pd and pt to ensure that
the object is included in the right ASID-label *}

text {* UT1's ASID *}

definition
  asid1_3063 :: machine_word
where
  "asid1_3063 \<equiv> 1<<asid_low_bits"

text {* T1's ASID *}

definition
  asid1_3065 :: machine_word
where
  "asid1_3065 \<equiv> 2<<asid_low_bits"

lemma "asid_high_bits_of asid1_3065 \<noteq> asid_high_bits_of asid1_3063"
by (simp add: asid1_3063_def asid_high_bits_of_def asid1_3065_def asid_low_bits_def)

text {* UT1's CSpace *}

definition
  caps1_6 :: cnode_contents
where
  "caps1_6 \<equiv>
   (empty_cnode 10)
      ( (the_nat_to_bl_10 1)
            \<mapsto> ThreadCap 3079,
        (the_nat_to_bl_10 2)
            \<mapsto> CNodeCap 6 undefined undefined,
        (the_nat_to_bl_10 3)
            \<mapsto> ArchObjectCap (PageDirectoryCap 3063
                                             (Some asid1_3063)),
        (the_nat_to_bl_10 318)
            \<mapsto> EndpointCap  9 0 {AllowSend} )"

definition
  obj1_6 :: kernel_object
where
  "obj1_6 \<equiv> CNode 10 caps1_6"

text {* T1's Cspace *}

definition
  caps1_7 :: cnode_contents
where
  "caps1_7 \<equiv>
   (empty_cnode 10)
      ( (the_nat_to_bl_10 1)
            \<mapsto> ThreadCap 3080,
        (the_nat_to_bl_10 2)
            \<mapsto> CNodeCap 7 undefined undefined,
        (the_nat_to_bl_10 3)
           \<mapsto> ArchObjectCap (PageDirectoryCap 3065
                                            (Some asid1_3065)),
        (the_nat_to_bl_10 318)
           \<mapsto> EndpointCap  9 0 {AllowRecv}) "

definition
  obj1_7 :: kernel_object
where
  "obj1_7 \<equiv> CNode 10 caps1_7"

text {* endpoint between UT1 and T1 *}

definition
  obj1_9 :: kernel_object
where
  "obj1_9 \<equiv> Endpoint IdleEP"

text {* UT1's VSpace (PageDirectory)*}

definition
  pt1_3072 :: "word8 \<Rightarrow> pte "
where
  "pt1_3072 \<equiv> (\<lambda>_. InvalidPTE)"

definition
  obj1_3072 :: kernel_object
where
  "obj1_3072 \<equiv> ArchObj (PageTable pt1_3072)"

definition
  pd1_3063 :: "12 word \<Rightarrow> pde "
where
  "pd1_3063 \<equiv>
    (\<lambda>_. InvalidPDE)
     (0 := PageTablePDE
              (addrFromPPtr 3072)
              undefined
              undefined )"

(* used addrFromPPtr because proof gives me ptrFromAddr.. TODO: check
if it's right *)

definition
  obj1_3063 :: kernel_object
where
  "obj1_3063 \<equiv> ArchObj (PageDirectory pd1_3063)"

text {* T1's VSpace (PageDirectory)*}

definition
  pt1_3077 :: "word8 \<Rightarrow> pte "
where
  "pt1_3077 \<equiv>
    (\<lambda>_. InvalidPTE)"

definition
  obj1_3077 :: kernel_object
where
  "obj1_3077 \<equiv> ArchObj (PageTable pt1_3077)"

definition
  pd1_3065 :: "12 word \<Rightarrow> pde "
where
  "pd1_3065 \<equiv>
    (\<lambda>_. InvalidPDE)
     (0 := PageTablePDE
             (addrFromPPtr 3077)
             undefined
             undefined )"

(* used addrFromPPtr because proof gives me ptrFromAddr.. TODO: check
if it's right *)

definition
  obj1_3065 :: kernel_object
where
  "obj1_3065 \<equiv> ArchObj (PageDirectory pd1_3065)"

text {* UT1's tcb *}

definition
  obj1_3079 :: kernel_object
where
  "obj1_3079 \<equiv>
   TCB \<lparr>
     tcb_ctable             = CNodeCap 6 undefined undefined,
     tcb_vtable             = ArchObjectCap (PageDirectoryCap 3063 (Some asid1_3063)),
     tcb_reply              = ReplyCap 3079 True, (* master reply cap to itself *)
     tcb_caller             = NullCap,
     tcb_ipcframe           = NullCap,
     tcb_state              = Running,
     tcb_fault_handler      = undefined,
     tcb_ipc_buffer         = undefined,
     tcb_fault              = undefined,
     tcb_bound_notification = None,
     tcb_mcpriority         = undefined,
     tcb_arch               = \<lparr>tcb_context = undefined\<rparr> \<rparr>"

text {* T1's tcb *}

definition
  obj1_3080 :: kernel_object
where
  "obj1_3080 \<equiv>
   TCB \<lparr>
     tcb_ctable             = CNodeCap 7 undefined undefined,
     tcb_vtable             = ArchObjectCap (PageDirectoryCap 3065 (Some asid1_3065)),
     tcb_reply              = ReplyCap 3080 True, (* master reply cap to itself *)
     tcb_caller             = NullCap,
     tcb_ipcframe           = NullCap,
     tcb_state              = BlockedOnReceive 9,
     tcb_fault_handler      = undefined,
     tcb_ipc_buffer         = undefined,
     tcb_fault              = undefined,
     tcb_bound_notification = None,
     tcb_mcpriority         = undefined,
     tcb_arch               = \<lparr>tcb_context = undefined\<rparr>\<rparr>"

definition
 "obj1_10 \<equiv> CNode 10 (Map.empty([] \<mapsto> cap.NullCap))"

(* the boolean in BlockedOnReceive is True if the object can receive but not send.
but Tom says it only matters if the sender can grant - which is not the case of the UT1 - I think *)

definition
  kh1 :: kheap
where
  "kh1 \<equiv> [ 6 \<mapsto> obj1_6,
          7 \<mapsto> obj1_7,
          9 \<mapsto> obj1_9,
          10 \<mapsto> obj1_10,
          3063 \<mapsto> obj1_3063,
          3065 \<mapsto> obj1_3065,
          3072 \<mapsto> obj1_3072,
          3077 \<mapsto> obj1_3077,
          3079 \<mapsto> obj1_3079,
          3080 \<mapsto> obj1_3080 ]"

lemmas kh1_obj_def =
  obj1_6_def obj1_7_def obj1_9_def obj1_10_def obj1_3063_def obj1_3065_def
  obj1_3072_def obj1_3077_def obj1_3079_def obj1_3080_def

definition exst1 :: "det_ext" where
  "exst1 \<equiv> \<lparr>work_units_completed_internal = undefined,
             scheduler_action_internal = undefined,
             ekheap_internal = \<lambda>x. None,
             domain_list_internal = undefined,
             domain_index_internal = undefined,
             cur_domain_internal = undefined,
             domain_time_internal = undefined,
             ready_queues_internal = undefined,
             cdt_list_internal = undefined\<rparr>"

definition
  s1 :: "det_ext state"
where
  "s1 \<equiv>  \<lparr>
    kheap = kh1,
    cdt = empty,
    is_original_cap = undefined,
    cur_thread = undefined,
    idle_thread = undefined,
    machine_state = undefined,
    interrupt_irq_node = (\<lambda>_. 10),
    interrupt_states = undefined,
    arch_state = \<lparr>
        arm_asid_table = (\<lambda> x. None),
        arm_hwasid_table = undefined,
        arm_next_asid = undefined,
        arm_asid_map = undefined,
        arm_global_pd = undefined,
        arm_global_pts = undefined,
        arm_kernel_vspace = undefined
        \<rparr>,
     exst = exst1
    \<rparr>"

subsubsection {* Defining the policy graph *}

datatype Sys1Labels =
    UT1 | T1 | EP1 | IRQ1

definition
  Sys1AgentMap :: "Sys1Labels agent_map"
where
  "Sys1AgentMap \<equiv>
   (\<lambda>_. undefined)
     (6 := UT1,
      7 := T1,
      9 := EP1,
      10 := IRQ1,
      3063 := UT1,
      3065 := T1,
      3072 := UT1,
      3077 := T1,
      3079 := UT1,
      3080 := T1 )"

lemma Sys1AgentMap_simps:
  "Sys1AgentMap 6 = UT1"
      "Sys1AgentMap 7 = T1"
      "Sys1AgentMap 9 = EP1"
      "Sys1AgentMap 10 = IRQ1"
      "Sys1AgentMap 3063 = UT1"
      "Sys1AgentMap 3065 = T1"
      "Sys1AgentMap 3072 = UT1"
      "Sys1AgentMap 3077 = T1"
      "Sys1AgentMap 3079 = UT1"
      "Sys1AgentMap 3080 = T1"
  unfolding Sys1AgentMap_def by simp_all

definition
  Sys1AuthGraph_aux :: "Sys1Labels auth_graph"
where
    "Sys1AuthGraph_aux \<equiv>
  { (UT1, auth.SyncSend,    EP1),
    (UT1, auth.Reset,   EP1),
    (T1,  auth.Receive, EP1),
    (T1,  auth.Reset,   EP1) }"

definition
  Sys1AuthGraph:: "Sys1Labels auth_graph"
where
    "Sys1AuthGraph \<equiv> complete_AuthGraph Sys1AuthGraph_aux {T1, UT1}"

definition
  Sys1ASIDMap :: "Sys1Labels agent_asid_map"
where
  "Sys1ASIDMap \<equiv>
    (\<lambda>x. if (asid_high_bits_of x = asid_high_bits_of asid1_3063)
          then UT1
         else if (asid_high_bits_of x = asid_high_bits_of asid1_3065)
          then T1 else undefined)"

definition Sys1PAS :: "Sys1Labels PAS" where
  "Sys1PAS \<equiv> \<lparr> pasObjectAbs = Sys1AgentMap, pasASIDAbs = Sys1ASIDMap, pasIRQAbs = (\<lambda>_. IRQ1),
              pasPolicy = Sys1AuthGraph, pasSubject = UT1, pasMayActivate = True, pasMayEditReadyQueues = True, pasMaySendIrqs = True, pasDomainAbs = undefined \<rparr>"

subsubsection {* Proof of pas_refined for Sys1 *}

lemma caps1_7_well_formed: "well_formed_cnode_n 10 caps1_7"
 apply (clarsimp simp: caps1_7_def well_formed_cnode_n_def)
 apply (clarsimp simp: the_nat_to_bl_10_def the_nat_to_bl_def nat_to_bl_def)
 apply (clarsimp simp: empty_cnode_def dom_def)
 apply (rule set_eqI, clarsimp)
 apply (rule iffI)
  apply (elim disjE, insert len_bin_to_bl, simp_all)[1]
 apply clarsimp
done

lemma caps1_6_well_formed: "well_formed_cnode_n 10 caps1_6"
 apply (clarsimp simp: caps1_6_def well_formed_cnode_n_def)
 apply (clarsimp simp: the_nat_to_bl_10_def the_nat_to_bl_def nat_to_bl_def)
 apply (clarsimp simp: empty_cnode_def dom_def)
 apply (rule set_eqI, clarsimp)
 apply (rule iffI)
  apply (elim disjE, insert len_bin_to_bl, simp_all)[1]
 apply clarsimp
done

(* clagged from KernelInit_R *)
lemma empty_cnode_apply[simp]:
  "(empty_cnode n xs = Some cap) = (length xs = n \<and> cap = NullCap)"
  by (auto simp add: empty_cnode_def)

lemma s1_caps_of_state :
  "caps_of_state s1 p = Some cap \<Longrightarrow>
     cap = NullCap \<or>
     (p,cap) \<in>
       { ((6::obj_ref,(the_nat_to_bl_10 1)),  ThreadCap 3079),
         ((6::obj_ref,(the_nat_to_bl_10 2)),  CNodeCap 6 undefined undefined),
         ((6::obj_ref,(the_nat_to_bl_10 3)),  ArchObjectCap (PageDirectoryCap 3063 (Some asid1_3063))),
         ((6::obj_ref,(the_nat_to_bl_10 318)),EndpointCap  9 0 {AllowSend}),
         ((7::obj_ref,(the_nat_to_bl_10 1)),  ThreadCap 3080),
         ((7::obj_ref,(the_nat_to_bl_10 2)),  CNodeCap 7 undefined undefined),
         ((7::obj_ref,(the_nat_to_bl_10 3)),  ArchObjectCap (PageDirectoryCap 3065 (Some asid1_3065))),
         ((7::obj_ref,(the_nat_to_bl_10 318)),EndpointCap  9 0 {AllowRecv}) ,
         ((3079::obj_ref, (tcb_cnode_index 0)), CNodeCap 6 undefined undefined ),
         ((3079::obj_ref, (tcb_cnode_index 1)), ArchObjectCap (PageDirectoryCap 3063 (Some asid1_3063))),
         ((3079::obj_ref, (tcb_cnode_index 2)), ReplyCap 3079 True),
         ((3079::obj_ref, (tcb_cnode_index 3)), NullCap),
         ((3079::obj_ref, (tcb_cnode_index 4)), NullCap),
         ((3080::obj_ref, (tcb_cnode_index 0)), CNodeCap 7 undefined undefined ),
         ((3080::obj_ref, (tcb_cnode_index 1)), ArchObjectCap (PageDirectoryCap 3065 (Some asid1_3065))),
         ((3080::obj_ref, (tcb_cnode_index 2)), ReplyCap 3080 True),
         ((3080::obj_ref, (tcb_cnode_index 3)), NullCap),
         ((3080::obj_ref, (tcb_cnode_index 4)), NullCap)} "
  apply (insert caps1_7_well_formed)
  apply (insert caps1_6_well_formed)
  apply (simp add: caps_of_state_cte_wp_at cte_wp_at_cases s1_def kh1_def kh1_obj_def)
  apply (case_tac p, clarsimp)
  apply (clarsimp split: if_splits)
     apply (clarsimp simp: cte_wp_at_cases tcb_cap_cases_def
                     split: if_split_asm)+
   apply (clarsimp simp: caps1_7_def split: if_splits)
  apply (clarsimp simp: caps1_6_def cte_wp_at_cases  split: if_splits)
done

lemma Sys1_wellformed: "pas_wellformed Sys1PAS"
 apply (clarsimp simp: Sys1PAS_def
                    policy_wellformed_def
                    Sys1AuthGraph_def
                    Sys1AuthGraph_aux_def
                    complete_AuthGraph_def)
 apply blast
 done

lemma tcb_states_of_state_1:
  "tcb_states_of_state s1 = [0xC08 \<mapsto> thread_state.BlockedOnReceive 9,  0xC07 \<mapsto> thread_state.Running ]"
  unfolding s1_def tcb_states_of_state_def
  apply (rule ext)
  apply (simp add: get_tcb_def)
  apply (simp add: kh1_def kh1_obj_def )
  done

lemma thread_bound_ntfns_1:
  "thread_bound_ntfns s1 = empty"
  unfolding s1_def thread_bound_ntfns_def
  apply (rule ext)
  apply (simp add: get_tcb_def)
  apply (simp add: kh1_def kh1_obj_def )
  done

declare AllowSend_def[simp] AllowRecv_def[simp]

lemma domains_of_state_s1[simp]:
  "domains_of_state s1 = {}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply clarsimp
   apply(erule domains_of_state_aux.induct)
   apply(simp add: s1_def exst1_def)
  apply simp
  done

lemma "pas_refined Sys1PAS s1"
  apply (clarsimp simp: pas_refined_def)
  apply (intro conjI)
       apply (simp add: Sys1_wellformed)
      apply (simp add: irq_map_wellformed_aux_def s1_def Sys1AgentMap_simps Sys1PAS_def)
     apply (clarsimp simp: auth_graph_map_def
                           Sys1PAS_def
                           state_objs_to_policy_def
                           state_bits_to_policy_def tcb_domain_map_wellformed_aux_def
                           )+
    apply (erule state_bits_to_policyp.cases, simp_all, clarsimp)
         apply (drule s1_caps_of_state, clarsimp)
         apply (simp add: Sys1AuthGraph_def complete_AuthGraph_def Sys1AuthGraph_aux_def)
         apply (elim disjE conjE, auto simp: Sys1AgentMap_simps cap_auth_conferred_def cap_rights_to_auth_def)[1]
        apply (drule s1_caps_of_state, clarsimp)
        apply (elim disjE, simp_all add: thread_bound_ntfns_def)[1]
       apply (clarsimp simp: state_refs_of_def thread_states_def tcb_states_of_state_1
              Sys1AuthGraph_def Sys1AgentMap_simps
              complete_AuthGraph_def
              Sys1AuthGraph_aux_def
              split: if_splits)
      apply (simp add:  thread_bound_ntfns_1)
     apply (simp add: s1_def) (* this is OK because cdt is empty..*)

    apply (clarsimp simp: state_vrefs_def
                           vs_refs_no_global_pts_def
                           s1_def kh1_def  Sys1AgentMap_simps
                           kh1_obj_def comp_def pt1_3072_def pt1_3077_def pte_ref_def pde_ref2_def pd1_3065_def pd1_3063_def
                           Sys1AuthGraph_def ptr_range_def
                           complete_AuthGraph_def
                           Sys1AuthGraph_aux_def
                     dest!: graph_ofD
                     split: if_splits)

   apply (rule subsetI, clarsimp)
   apply (erule state_asids_to_policy_aux.cases)
     apply clarsimp
     apply (drule s1_caps_of_state, clarsimp)
     apply (simp add: Sys1AuthGraph_def complete_AuthGraph_def Sys1AuthGraph_aux_def Sys1PAS_def Sys1ASIDMap_def)
     apply (elim disjE conjE, simp_all add: Sys1AgentMap_simps cap_auth_conferred_def cap_rights_to_auth_def asid1_3065_def asid1_3063_def
       asid_low_bits_def asid_high_bits_of_def )[1]
    apply (clarsimp simp: state_vrefs_def
                           vs_refs_no_global_pts_def
                           s1_def kh1_def  Sys1AgentMap_simps
                           kh1_obj_def comp_def pt1_3072_def pt1_3077_def pte_ref_def pde_ref2_def pd1_3065_def pd1_3063_def
                           Sys1AuthGraph_def ptr_range_def
                           complete_AuthGraph_def
                           Sys1AuthGraph_aux_def
                     dest!: graph_ofD
                     split: if_splits)
   apply (clarsimp simp: s1_def)
  apply (rule subsetI, clarsimp)
  apply (erule state_irqs_to_policy_aux.cases)
  apply (simp add: Sys1AuthGraph_def complete_AuthGraph_def Sys1AuthGraph_aux_def Sys1PAS_def Sys1ASIDMap_def)
  apply (drule s1_caps_of_state)
  apply (simp add: Sys1AuthGraph_def complete_AuthGraph_def Sys1AuthGraph_aux_def Sys1PAS_def Sys1ASIDMap_def)
  apply (elim disjE conjE, simp_all add: Sys1AgentMap_simps cap_auth_conferred_def cap_rights_to_auth_def asid1_3065_def asid1_3063_def
    asid_low_bits_def asid_high_bits_of_def )[1]
   done

(*---------------------------------------------------------*)
subsection {* Example 2 *}

text {*

This example systems Sys2 aims at checking that we can have 2
components, one untrusted UT2 and one truted T1, sharing a cnode obj2_5.

Both UT2 and T2 contains:

  . one TCB (obj2_3079 and obj2_3080 resp.)
  . one vspace made up of one page directory (obj2_6063 and obj2_3065 resp.)
  . each pd contains a single page table (obj2_3072 and obj2_3077 resp.)
  . one cspace made up of one cnode (obj2_6 and obj2_7 resp.)
  . each cspace contains 4 caps:
         one to the tcb
         one to the cnode itself
         one to the vspace
         one to obj2_5

Attempt to ASCII art:

          --------    ----                          ----     --------
          |       |   |  |                          |  |     |      |
          V       |   |  V     S             R      |  V     |      V
obj2_3079(tcb)-->obj2_6(cnode)--->obj2_5(cnode)<---obj2_7(cnode)<--obj2_3080(tcb)
  |               |                                   |            |
  V               |                                   |            V
obj2_3063(pd)<-----                                    -------> obj2_3065(pd)
  |                                                                |
  V                                                                V
obj2_3072(pt)                                                      obj2_3077(pt)

(the references are derived from the dump of the SAC system)

The aim is to be able to prove

  pas_refined Sys2PAS s2

where Sys2PAS is the label graph defining the AC policy for Sys2 and
s2 is the state of Sys2 described above.

This shows that the aag extracted from s2 (by state_objs_to_policy) is
included in the policy graph Sys2PAS.

*}

subsubsection {* Defining the State *}

text {* We need to define the asids of each pd and pt to ensure that
the object is included in the right ASID-label *}

text {* UT2's ASID *}

definition
  asid2_3063 :: machine_word
where
  "asid2_3063 \<equiv> 1<<asid_low_bits"

text {* T2's ASID *}

definition
  asid2_3065 :: machine_word
where
  "asid2_3065 \<equiv> 2<<asid_low_bits"

lemma "asid_high_bits_of asid2_3065 \<noteq> asid_high_bits_of asid2_3063"
by (simp add: asid2_3063_def asid_high_bits_of_def asid2_3065_def asid_low_bits_def)

text {* the intermediaite CSpace *}

definition
  caps2_5 :: cnode_contents
where
  "caps2_5 \<equiv>
   (empty_cnode 10)"

definition
  obj2_5 :: kernel_object
where
  "obj2_5 \<equiv> CNode 10 caps2_5"

text {* UT2's CSpace *}

definition
  caps2_6 :: cnode_contents
where
  "caps2_6 \<equiv>
   (empty_cnode 10)
      ( (the_nat_to_bl_10 1)
            \<mapsto> ThreadCap 3079,
        (the_nat_to_bl_10 2)
            \<mapsto> CNodeCap 6 undefined undefined,
        (the_nat_to_bl_10 3)
            \<mapsto> ArchObjectCap (PageDirectoryCap 3063
                                             (Some asid2_3063)),
        (the_nat_to_bl_10 4)
            \<mapsto> CNodeCap 5 undefined undefined )"

definition
  obj2_6 :: kernel_object
where
  "obj2_6 \<equiv> CNode 10 caps2_6"

text {* T2's Cspace *}

definition
  caps2_7 :: cnode_contents
where
  "caps2_7 \<equiv>
   (empty_cnode 10)
      ( (the_nat_to_bl_10 1)
            \<mapsto> ThreadCap 3080,
        (the_nat_to_bl_10 2)
            \<mapsto> CNodeCap 7 undefined undefined,
        (the_nat_to_bl_10 3)
           \<mapsto> ArchObjectCap (PageDirectoryCap 3065
                                            (Some asid2_3065)),
        (the_nat_to_bl_10 4)
            \<mapsto> CNodeCap 5 undefined undefined) "

definition
  obj2_7 :: kernel_object
where
  "obj2_7 \<equiv> CNode 10 caps2_7"

text {* endpoint between UT2 and T2 *}

definition
  obj2_9 :: kernel_object
where
  "obj2_9 \<equiv> Endpoint IdleEP"

text {* UT2's VSpace (PageDirectory)*}

definition
  pt2_3072 :: "word8 \<Rightarrow> pte "
where
  "pt2_3072 \<equiv> (\<lambda>_. InvalidPTE)"

definition
  obj2_3072 :: kernel_object
where
  "obj2_3072 \<equiv> ArchObj (PageTable pt2_3072)"

definition
  pd2_3063 :: "12 word \<Rightarrow> pde "
where
  "pd2_3063 \<equiv>
    (\<lambda>_. InvalidPDE)
     (0 := PageTablePDE
              (addrFromPPtr 3072)
              undefined
              undefined )"

(* used addrFromPPtr because proof gives me ptrFromAddr.. TODO: check
if it's right *)

definition
  obj2_3063 :: kernel_object
where
  "obj2_3063 \<equiv> ArchObj (PageDirectory pd2_3063)"

text {* T1's VSpace (PageDirectory)*}

definition
  pt2_3077 :: "word8 \<Rightarrow> pte "
where
  "pt2_3077 \<equiv>
    (\<lambda>_. InvalidPTE)"

definition
  obj2_3077 :: kernel_object
where
  "obj2_3077 \<equiv> ArchObj (PageTable pt2_3077)"

definition
  pd2_3065 :: "12 word \<Rightarrow> pde "
where
  "pd2_3065 \<equiv>
    (\<lambda>_. InvalidPDE)
     (0 := PageTablePDE
             (addrFromPPtr 3077)
             undefined
             undefined )"

(* used addrFromPPtr because proof gives me ptrFromAddr.. TODO: check
if it's right *)

definition
  obj2_3065 :: kernel_object
where
  "obj2_3065 \<equiv> ArchObj (PageDirectory pd2_3065)"

text {* UT1's tcb *}

definition
  obj2_3079 :: kernel_object
where
  "obj2_3079 \<equiv>
   TCB \<lparr>
     tcb_ctable             = CNodeCap 6 undefined undefined ,
     tcb_vtable             = ArchObjectCap (PageDirectoryCap 3063 (Some asid2_3063)),
     tcb_reply              = ReplyCap 3079 True, (* master reply cap to itself *)
     tcb_caller             = NullCap,
     tcb_ipcframe           = NullCap,
     tcb_state              = Running,
     tcb_fault_handler      = undefined,
     tcb_ipc_buffer         = undefined,
     tcb_fault              = undefined,
     tcb_bound_notification = None,
     tcb_mcpriority         = undefined,
     tcb_arch          = \<lparr>tcb_context = undefined\<rparr>\<rparr>"

text {* T1's tcb *}

definition
  obj2_3080 :: kernel_object
where
  "obj2_3080 \<equiv>
   TCB \<lparr>
     tcb_ctable             = CNodeCap 7 undefined undefined ,
     tcb_vtable             = ArchObjectCap (PageDirectoryCap 3065 (Some asid2_3065)),
     tcb_reply              = ReplyCap 3080 True, (* master reply cap to itself *)
     tcb_caller             = NullCap,
     tcb_ipcframe           = NullCap,
     tcb_state              = BlockedOnReceive 9,
     tcb_fault_handler      = undefined,
     tcb_ipc_buffer         = undefined,
     tcb_fault              = undefined,
     tcb_bound_notification = None,
     tcb_mcpriority         = undefined,
     tcb_arch               = \<lparr>tcb_context = undefined\<rparr>\<rparr>"

(* the boolean in BlockedOnReceive is True if the object can receive but not send.
but Tom says it only matters if the sender can grant - which is not the case of the UT1 - I think *)

definition
  kh2 :: kheap
where
  "kh2 \<equiv> [ 6 \<mapsto> obj2_6,
          7 \<mapsto> obj2_7,
          9 \<mapsto> obj2_9,
          3063 \<mapsto> obj2_3063,
          3065 \<mapsto> obj2_3065,
          3072 \<mapsto> obj2_3072,
          3077 \<mapsto> obj2_3077,
          3079 \<mapsto> obj2_3079,
          3080 \<mapsto> obj2_3080 ]"

lemmas kh2_obj_def =
  obj2_6_def obj2_7_def obj2_9_def obj2_3063_def obj2_3065_def
  obj2_3072_def obj2_3077_def obj2_3079_def obj2_3080_def

definition
  s2 :: "det_ext state"
where
  "s2 \<equiv>  \<lparr>
    kheap = kh2,
    cdt = empty,
    is_original_cap = undefined,
    cur_thread = undefined,
    idle_thread = undefined,
    machine_state = undefined,
    interrupt_irq_node = (\<lambda>_. 9001),
    interrupt_states = undefined,
    arch_state = \<lparr>
        arm_asid_table = (\<lambda> x. None),
        arm_hwasid_table = undefined,
        arm_next_asid = undefined,
        arm_asid_map = undefined,
        arm_global_pd = undefined,
        arm_global_pts = undefined,
        arm_kernel_vspace = undefined
        \<rparr>,
    exst = exst1
    \<rparr>"

subsubsection {* Defining the policy graph *}

datatype Sys2Labels =
    UT2 | T2 | IRQ2

definition
  Sys2AgentMap :: "Sys2Labels agent_map"
where
  "Sys2AgentMap \<equiv>
   (\<lambda>_. undefined)
     (5 := UT2,
      6 := UT2,
      7 := T2,
      9 := T2,
      3063 := UT2,
      3065 := T2,
      3072 := UT2,
      3077 := T2,
      3079 := UT2,
      3080 := T2,
      9001 := IRQ2 )"

definition
  Sys2AuthGraph_aux :: "Sys2Labels auth_graph"
where
    "Sys2AuthGraph_aux \<equiv>
       { (T2, Control, UT2) }"

definition
  Sys2AuthGraph:: "Sys2Labels auth_graph"
where
    "Sys2AuthGraph \<equiv> complete_AuthGraph Sys2AuthGraph_aux {T2, UT2}"

definition
  Sys2ASIDMap :: "Sys2Labels agent_asid_map"
where
  "Sys2ASIDMap \<equiv>
    (\<lambda>_. undefined)
     (asid2_3063 := UT2,
      asid2_3065 := T2 )"

definition Sys2PAS :: "Sys2Labels PAS" where
  "Sys2PAS \<equiv> \<lparr> pasObjectAbs = Sys2AgentMap, pasASIDAbs = Sys2ASIDMap,
              pasIRQAbs = (\<lambda>_. IRQ2),
              pasPolicy = Sys2AuthGraph, pasSubject = UT2, pasMayActivate = True, pasMayEditReadyQueues = True, pasMaySendIrqs = True, pasDomainAbs = undefined \<rparr>"

subsubsection {* Proof of pas_refined for Sys2 *}

lemma caps2_7_well_formed: "well_formed_cnode_n 10 caps2_7"
 apply (clarsimp simp: caps2_7_def well_formed_cnode_n_def)
 apply (clarsimp simp: the_nat_to_bl_10_def the_nat_to_bl_def nat_to_bl_def)
 apply (clarsimp simp: empty_cnode_def dom_def)
 apply (rule set_eqI, clarsimp)
 apply (rule iffI)
  apply (elim disjE, insert len_bin_to_bl, simp_all)[1]
 apply clarsimp
done

lemma caps2_6_well_formed: "well_formed_cnode_n 10 caps2_6"
 apply (clarsimp simp: caps2_6_def well_formed_cnode_n_def)
 apply (clarsimp simp: the_nat_to_bl_10_def the_nat_to_bl_def nat_to_bl_def)
 apply (clarsimp simp: empty_cnode_def dom_def)
 apply (rule set_eqI, clarsimp)
 apply (rule iffI)
  apply (elim disjE, insert len_bin_to_bl, simp_all)[1]
 apply clarsimp
done

lemma s2_caps_of_state :
  "caps_of_state s2 p = Some cap \<Longrightarrow>
     cap = NullCap \<or>
     (p,cap) \<in>
       { ((6::obj_ref,(the_nat_to_bl_10 1)),  ThreadCap 3079),
         ((6::obj_ref,(the_nat_to_bl_10 2)),  CNodeCap 6 undefined undefined),
         ((6::obj_ref,(the_nat_to_bl_10 3)),  ArchObjectCap (PageDirectoryCap 3063 (Some asid2_3063))),
         ((6::obj_ref,(the_nat_to_bl_10 4)),  CNodeCap 5 undefined undefined),
         ((7::obj_ref,(the_nat_to_bl_10 1)),  ThreadCap 3080),
         ((7::obj_ref,(the_nat_to_bl_10 2)),  CNodeCap 7 undefined undefined),
         ((7::obj_ref,(the_nat_to_bl_10 3)),  ArchObjectCap (PageDirectoryCap 3065 (Some asid2_3065))),
         ((7::obj_ref,(the_nat_to_bl_10 4)),  CNodeCap 5 undefined undefined),
         ((3079::obj_ref, (tcb_cnode_index 0)), CNodeCap 6 undefined undefined ),
         ((3079::obj_ref, (tcb_cnode_index 1)), ArchObjectCap (PageDirectoryCap 3063 (Some asid2_3063))),
         ((3079::obj_ref, (tcb_cnode_index 2)), ReplyCap 3079 True),
         ((3079::obj_ref, (tcb_cnode_index 3)), NullCap),
         ((3079::obj_ref, (tcb_cnode_index 4)), NullCap),
         ((3080::obj_ref, (tcb_cnode_index 0)), CNodeCap 7 undefined undefined ),
         ((3080::obj_ref, (tcb_cnode_index 1)), ArchObjectCap (PageDirectoryCap 3065 (Some asid2_3065))),
         ((3080::obj_ref, (tcb_cnode_index 2)), ReplyCap 3080 True),
         ((3080::obj_ref, (tcb_cnode_index 3)), NullCap),
         ((3080::obj_ref, (tcb_cnode_index 4)), NullCap)} "
  apply (insert caps2_7_well_formed)
  apply (insert caps2_6_well_formed)
  apply (simp add: caps_of_state_cte_wp_at cte_wp_at_cases s2_def kh2_def kh2_obj_def)
  apply (case_tac p, clarsimp)
  apply (clarsimp simp: cte_wp_at_cases split: if_splits)
     apply (clarsimp simp: tcb_cap_cases_def split: if_splits)+
   apply (clarsimp simp: caps2_7_def split: if_splits)
  apply (clarsimp simp: caps2_6_def cte_wp_at_cases  split: if_splits)
done

lemma Sys2_wellformed: "pas_wellformed Sys2PAS"
  apply (clarsimp simp: Sys2PAS_def policy_wellformed_def)
  apply (intro conjI)
  apply (simp_all add: Sys2AuthGraph_def complete_AuthGraph_def
                       Sys2AuthGraph_aux_def)
  done

lemma Sys2AgentMap_simps:
  "Sys2AgentMap 5 = UT2"
  "Sys2AgentMap 6 = UT2"
  "Sys2AgentMap 7 = T2"
  "Sys2AgentMap 9 = T2"
  "Sys2AgentMap 3063 = UT2"
  "Sys2AgentMap 3065 = T2"
  "Sys2AgentMap 3072 = UT2"
  "Sys2AgentMap 3077 = T2"
  "Sys2AgentMap 3079 = UT2"
  "Sys2AgentMap 3080 = T2"
  "Sys2AgentMap 9001 = IRQ2"
  by (simp_all add: Sys2AgentMap_def)

lemma domains_of_state_s2[simp]:
  "domains_of_state s2 = {}"
  apply(rule equalityI)
   apply(rule subsetI)
   apply clarsimp
   apply(erule domains_of_state_aux.induct)
   apply(simp add: s2_def exst1_def)
  apply simp
  done

lemma thread_bound_ntfns_2[simp]:
  "thread_bound_ntfns s2 = empty"
  unfolding s2_def thread_bound_ntfns_def
  apply (rule ext)
  apply (simp add: get_tcb_def)
  apply (simp add: kh2_def kh2_obj_def)
  done

lemma "pas_refined Sys2PAS s2"
  apply (clarsimp simp: pas_refined_def)
  apply (intro conjI)
      apply (simp add: Sys2_wellformed)
     apply (simp add: Sys2PAS_def s2_def Sys2AgentMap_def
                      irq_map_wellformed_aux_def)
    apply (clarsimp simp: auth_graph_map_def
                          Sys2PAS_def
                          state_objs_to_policy_def
                          state_bits_to_policy_def tcb_domain_map_wellformed_aux_def)+
    apply (erule state_bits_to_policyp.cases, simp_all)
        apply (drule s2_caps_of_state, clarsimp)
        apply (elim disjE, simp_all add: cap_auth_conferred_def
                                         Sys2AgentMap_simps
                                         Sys2AuthGraph_def Sys2AuthGraph_aux_def
                                         complete_AuthGraph_def
                             split: if_split_asm)[1]
       apply (drule s2_caps_of_state, clarsimp)
       apply (elim disjE, simp_all)[1]
      apply (clarsimp simp: state_refs_of_def s2_def kh2_def kh2_obj_def
                      split: if_splits)
      apply (clarsimp split:if_splits option.splits
                      simp: thread_states_def tcb_states_of_state_def
                            Sys2AgentMap_simps Sys2AuthGraph_def
                            complete_AuthGraph_def Sys2AuthGraph_aux_def
                     dest!: get_tcb_SomeD)
     apply (simp add: s2_def) (* this is OK because cdt is empty..*)

    apply ((clarsimp simp: state_vrefs_def
                           vs_refs_no_global_pts_def
                           s2_def kh2_def
                           kh2_obj_def
                     split: if_splits,
           ((clarsimp split: if_splits
                     simp: pd2_3065_def pd2_3063_def graph_of_def pde_ref_def
                           Sys2AgentMap_simps Sys2AuthGraph_def
                           complete_AuthGraph_def pt2_3077_def pte_ref_def
                           pt2_3072_def graph_of_def pde_ref2_def
                           Sys2AuthGraph_aux_def ptr_range_def)+))+)[1]
   apply clarsimp
   apply (erule state_asids_to_policy_aux.cases)
    apply clarsimp
    apply (auto simp: Sys2PAS_def Sys2AuthGraph_def Sys2AuthGraph_aux_def
                      complete_AuthGraph_def Sys2AgentMap_simps
                      Sys2ASIDMap_def asid2_3063_def asid2_3065_def
                      asid_low_bits_def
               dest!: s2_caps_of_state)[1]
   apply (clarsimp simp: state_vrefs_def
                         vs_refs_no_global_pts_def
                         s2_def kh2_def
                         kh2_obj_def
                  split: if_splits)
   apply (clarsimp simp: s2_def)
  apply (clarsimp)
  apply (erule state_irqs_to_policy_aux.cases)
  apply (auto simp: Sys2PAS_def Sys2AuthGraph_def Sys2AuthGraph_aux_def
                    complete_AuthGraph_def Sys2AgentMap_simps
                    Sys2ASIDMap_def asid2_3063_def asid2_3065_def
             dest!: s2_caps_of_state)[1]
  done

end

end


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

theory n_mesi_lemma_on_inv__2 imports n_mesi_base
begin
section{*All lemmas on causal relation between inv__2 and some rule r*}
lemma n_t1Vsinv__2:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_t1  i)" and
a2: "(\<exists> p__Inv0 p__Inv2. p__Inv0\<le>N\<and>p__Inv2\<le>N\<and>p__Inv0~=p__Inv2\<and>f=inv__2  p__Inv0 p__Inv2)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_t1  i" apply fastforce done
from a2 obtain p__Inv0 p__Inv2 where a2:"p__Inv0\<le>N\<and>p__Inv2\<le>N\<and>p__Inv0~=p__Inv2\<and>f=inv__2  p__Inv0 p__Inv2" apply fastforce done
have "(i=p__Inv2)\<or>(i=p__Inv0)\<or>(i~=p__Inv0\<and>i~=p__Inv2)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv2)"
  have "?P3 s"
  apply (cut_tac a1 a2 b1, simp, rule_tac x="(neg (andForm (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)) (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E))))" in exI, auto) done
  then have "invHoldForRule s f r (invariants N)" by auto
}
moreover {
  assume b1: "(i=p__Inv0)"
  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__Inv0\<and>i~=p__Inv2)"
  have "?P2 s"
  proof(cut_tac a1 a2 b1, auto) qed
  then have "invHoldForRule s f r (invariants N)" by auto
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

lemma n_t2Vsinv__2:
assumes a1: "(\<exists> i. i\<le>N\<and>r=n_t2 N i)" and
a2: "(\<exists> p__Inv0 p__Inv2. p__Inv0\<le>N\<and>p__Inv2\<le>N\<and>p__Inv0~=p__Inv2\<and>f=inv__2  p__Inv0 p__Inv2)"
shows "invHoldForRule s f r (invariants N)" (is "?P1 s \<or> ?P2 s \<or> ?P3 s")
proof -
from a1 obtain i where a1:"i\<le>N\<and>r=n_t2 N i" apply fastforce done
from a2 obtain p__Inv0 p__Inv2 where a2:"p__Inv0\<le>N\<and>p__Inv2\<le>N\<and>p__Inv0~=p__Inv2\<and>f=inv__2  p__Inv0 p__Inv2" apply fastforce done
have "(i=p__Inv2)\<or>(i=p__Inv0)\<or>(i~=p__Inv0\<and>i~=p__Inv2)" apply (cut_tac a1 a2, auto) done
moreover {
  assume b1: "(i=p__Inv2)"
  have "((formEval (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)) s))\<or>((formEval (andForm (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i=p__Inv0)"
  have "((formEval (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)) s))\<or>((formEval (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) s))\<or>((formEval (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) s))\<or>((formEval (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) s))" by auto
  moreover {
    assume c1: "((formEval (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
moreover {
  assume b1: "(i~=p__Inv0\<and>i~=p__Inv2)"
  have "((formEval (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E))) s))\<or>((formEval (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E))) s))\<or>((formEval (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E))) s))\<or>((formEval (andForm (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E))) s))\<or>((formEval (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (andForm (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))\<or>((formEval (andForm (andForm (andForm (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))" by auto
  moreover {
    assume c1: "((formEval (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (andForm (andForm (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I)) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  moreover {
    assume c1: "((formEval (andForm (andForm (andForm (andForm (andForm (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const I))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv2)) (Const E)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const I)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const M)))) (neg (eqn (IVar (Para (Ident ''state'') p__Inv0)) (Const E)))) s))"
    have "?P1 s"
    proof(cut_tac a1 a2 b1 c1, auto) qed
    then have "invHoldForRule s f r (invariants N)" by auto
  }
  ultimately have "invHoldForRule s f r (invariants N)" by satx
}
ultimately show "invHoldForRule s f r (invariants N)" by satx
qed

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

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


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

header{*The n_germanSymIndex Protocol Case Study*}

theory n_germanSymIndex_lemma_inv__38_on_rules imports n_germanSymIndex_lemma_on_inv__38
begin
section{*All lemmas on causal relation between inv__38*}
lemma lemma_inv__38_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__38  p__Inv2)"
  shows "invHoldForRule s f r (invariants N)"
  proof -
  have c1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendReqE__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqS N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvReqE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__0  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInv__part__1  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvInvAck  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_SendGntE N i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntS  i)\<or>
    (\<exists> i. i\<le>N\<and>r=n_RecvGntE  i)"
  apply (cut_tac b1, auto) done
    moreover {
      assume d1: "(\<exists> i d. i\<le>N\<and>d\<le>N\<and>r=n_Store  i d)"
      have "invHoldForRule s f r (invariants N)"
      apply (cut_tac b2 d1, metis n_StoreVsinv__38) done
    }

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

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

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

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

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

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

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

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

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

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

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

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

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

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

end