(*
  This file contains the provable assumptions which are required when proving correspondence of
  word array functions.
*)
theory WordArray_CorresProof_Asm
  imports WordArray_UAbsFun WordArray_VAbsFun
begin

context WordArray begin

section "Type Assumptions"

lemma proc_ctx_wellformed_\<Xi>:
  "proc_ctx_wellformed \<Xi>"
  apply (clarsimp simp: proc_ctx_wellformed_def \<Xi>_def)
  apply (clarsimp split: if_splits
                  simp: assoc_lookup.simps abbreviated_type_defs
                        wordarray_get_0_type_def wordarray_get_u32_type_def
                        wordarray_length_0_type_def wordarray_length_u32_type_def
                        wordarray_put2_0_type_def wordarray_put2_u32_type_def
                        wordarray_fold_no_break_0_type_def
                        wordarray_map_no_break_0_type_def
                        add_type_def sum_arr_type_def
                        mul_type_def mul_arr_type_def
                        inc_type_def inc_arr_type_def
                        dec_type_def dec_arr_type_def)
  done

section "First Order Abstract Function Assumptions"

subsection "Monomorphisation"

lemma value_sem_rename_mono_prog_rename_\<Xi>_\<xi>m_\<xi>p:
  "value_sem.rename_mono_prog wa_abs_typing_v rename \<Xi> \<xi>m \<xi>p"
  apply (clarsimp simp: val.rename_mono_prog_def)
  apply (rule conjI; clarsimp)
   apply (rule_tac x = v' in exI)
   apply (subst (asm) rename_def)
   apply (subst (asm) assoc_lookup.simps)+
   apply (clarsimp split: if_split_asm)
  apply (clarsimp simp: val_wa_length_rename_monoexpr_correct)
  apply (rule conjI)
   apply clarsimp
   apply (rule_tac x = v' in exI)
   apply (subst (asm) rename_def)
   apply (subst (asm) assoc_lookup.simps)+
   apply (clarsimp split: if_split_asm)
  apply (clarsimp simp: val_wa_get_rename_monoexpr_correct)
  apply clarsimp
  apply (rule_tac x = v' in exI)
  apply (subst (asm) rename_def)
  apply (subst (asm) assoc_lookup.simps)+
  apply (clarsimp split: if_split_asm)
  apply (clarsimp simp: val_wa_put2_rename_monoexpr_correct)
  done

subsection "Type preservation in the Value semantics"

lemma val_proc_env_matches_\<xi>m_\<Xi>:
  "val.proc_env_matches \<xi>m \<Xi>"
  apply (clarsimp simp: val.proc_env_matches_def)
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) assoc_lookup.simps)+
  apply (clarsimp split: if_split_asm)
    apply (clarsimp simp: wordarray_get_0_type_def abbreviated_type_defs)
    apply (drule val_wa_get_preservation; simp?)
   apply (clarsimp simp: wordarray_length_0_type_def)
  apply (drule val_wa_length_preservation; simp?)
  apply (clarsimp simp: wordarray_put2_0_type_def abbreviated_type_defs)
  apply (drule val_wa_put2_preservation; simp?)
  done

subsection "Correspondence and upward propagation from Update to the Value semantics"

lemma wa_get_upd_val:
  "\<lbrakk>upd_val_rel \<Xi>' \<sigma> au av (TRecord [(a, TCon ''WordArray'' [t] (Boxed ReadOnly ptrl), Present),
      (b, TPrim (Num U32), Present)] Unboxed) r w; upd_wa_get_0 (\<sigma>, au) (\<sigma>', v)\<rbrakk>
    \<Longrightarrow> (val_wa_get av v' \<longrightarrow> (\<exists>r' w'. upd_val_rel \<Xi>' \<sigma>' v v' t r' w' \<and> r' \<subseteq> r \<and>
      frame \<sigma> w \<sigma>' w')) \<and> Ex (val_wa_get av)"
 apply (clarsimp simp: upd_wa_get_0_def)
  apply (erule u_v_recE'; clarsimp)
  apply (erule u_v_r_consE'; clarsimp)
  apply (erule u_v_p_absE'[where s = "Boxed ReadOnly _", simplified])
  apply (drule_tac t = "type_repr _" in sym)+
  apply clarsimp
  apply (erule u_v_r_consE'; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)+
  apply clarsimp
  apply (erule u_v_r_emptyE'; clarsimp)
  apply (erule u_v_primE')+
  apply (subst (asm) lit_type.simps)+
  apply clarsimp
  apply (rule conjI)
   apply (clarsimp simp: val_wa_get_def)
   apply (rule_tac x = "{}" in exI)+
   apply (clarsimp simp: wa_abs_upd_val_def frame_def word_less_nat_alt)
   apply (case_tac "unat idx < length xs"; clarsimp)
    apply (erule_tac x = idx in allE; clarsimp)
    apply (rule u_v_prim'; clarsimp)
   apply (rule u_v_prim'; clarsimp)
  apply (clarsimp simp: word_less_nat_alt wa_abs_upd_val_def)
  apply (clarsimp split: vatyp.splits type.splits prim_type.splits)
  apply (case_tac "unat idx < length x12"; clarsimp simp: word_less_nat_alt)
   apply (erule_tac x = idx in allE; clarsimp)
   apply (rule_tac x = "VPrim x" in exI)
   apply (clarsimp simp: val_wa_get_def)
  apply (rule_tac x = "VPrim (zero_num_lit ta)" in exI)
  apply (clarsimp simp: val_wa_get_def)
  apply (case_tac ta; clarsimp)
  done

lemma wa_length_upd_val:
  "\<lbrakk>upd_val_rel \<Xi>' \<sigma> au av (TCon ''WordArray'' [t] (Boxed ReadOnly ptrl)) r w;
    upd_wa_length_0 (\<sigma>, au) (\<sigma>', v)\<rbrakk>
    \<Longrightarrow> (val_wa_length av v' \<longrightarrow> (\<exists>r' w'. upd_val_rel \<Xi>' \<sigma>' v v' (TPrim (Num U32)) r' w' \<and> r' \<subseteq> r \<and>
      frame \<sigma> w \<sigma>' w')) \<and> Ex (val_wa_length av)"
  apply (clarsimp simp: upd_wa_length_0_def)
  apply (erule u_v_p_absE'; clarsimp)
  apply (clarsimp simp: wa_abs_upd_val_def)
  apply (clarsimp split: vatyp.splits type.splits prim_type.splits)
  apply (rule conjI)
   apply (clarsimp simp: val_wa_length_def)
   apply (rule_tac x = "{}" in exI)+
   apply (clarsimp simp: frame_def)
   apply (rule u_v_prim'; clarsimp)
  apply (rule_tac x = "VPrim (LU32 len)" in exI)
  apply (clarsimp simp: val_wa_length_def)
  done

lemma wa_put2_upd_val:
  "\<lbrakk>upd_val_rel \<Xi>' \<sigma> au av (TRecord [(a, TCon ''WordArray'' [t] (Boxed Writable ptrl), Present),
      (b, TPrim (Num U32), Present), (c, t, Present)] Unboxed) r w; upd_wa_put2_0 (\<sigma>, au) (\<sigma>', v)\<rbrakk>
    \<Longrightarrow> (val_wa_put2 av v' \<longrightarrow>
        (\<exists>r' w'. upd_val_rel \<Xi>' \<sigma>' v v' (TCon ''WordArray'' [t] (Boxed Writable ptrl)) r' w' \<and>
         r' \<subseteq> r \<and> frame \<sigma> w \<sigma>' w')) \<and>
      Ex (val_wa_put2 av)"
 apply (clarsimp simp: upd_wa_put2_0_def)
  apply (erule u_v_recE'; clarsimp)
  apply (erule u_v_r_consE'; clarsimp)
  apply (erule u_v_p_absE'[where s = "Boxed Writable _", simplified])
  apply (drule_tac t = "type_repr _" in sym)+
  apply clarsimp
  apply (erule u_v_r_consE'; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)+
  apply clarsimp
  apply (erule u_v_r_consE'; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)+
  apply clarsimp
  apply (erule u_v_r_emptyE')
  apply (erule u_v_primE')+
  apply (subst (asm) lit_type.simps)+
  apply clarsimp
  apply (erule type_repr.elims[where y = " RPrim _", simplified]; clarsimp)
  apply (erule u_v_t_primtE)
  apply (rule conjI)
   apply clarsimp
   apply (clarsimp simp: val_wa_put2_def)
   apply (rule_tac x = r in exI)
   apply (rule_tac x = "insert p wa" in exI)
   apply clarsimp
   apply (rule conjI)
    apply (rule_tac a = "UWA (TPrim (Num ta)) len arr" and ptrl = ptrl
      in u_v_p_abs_w[where ts = "[TPrim _]", simplified]; simp?)
     apply (clarsimp simp: wa_abs_upd_val_def)
     apply (rule conjI)
      apply (clarsimp simp: wa_abs_typing_u_def split: if_split_asm)
     apply (rule conjI)
      apply (clarsimp simp: wa_abs_typing_v_def)
      apply (erule_tac x = i in allE; clarsimp)+
      apply (case_tac "i = unat idx"; clarsimp)
     apply (clarsimp split: if_splits)
     apply (rule conjI; clarsimp)
      apply (drule distinct_indices)
      apply (erule_tac x = i in allE)+
      apply clarsimp
      apply (erule_tac x = idx in allE)
      apply (clarsimp simp: word_less_nat_alt)
     apply (erule_tac x = i in allE)
     apply clarsimp
     apply (case_tac "unat i = unat idx"; clarsimp simp: wa_abs_typing_u_def)
    apply (clarsimp split: if_splits)
    apply (clarsimp simp: wa_abs_upd_val_def)
    apply (erule_tac x = idx in allE)
    apply clarsimp
   apply (clarsimp simp: frame_def wa_abs_upd_val_def wa_abs_typing_u_def split: if_splits)
   apply (rule conjI; clarsimp)
    apply (rule conjI)
     apply clarsimp
    apply (rule conjI; clarsimp)
    apply (rule conjI; clarsimp)
   apply (rule conjI; clarsimp)
  apply clarsimp
  apply (frule wa_abs_upd_val_elims(2))
  apply (drule wa_abs_typing_v_elims(1))
  apply clarsimp
  apply (rule_tac x = "VAbstract (VWA t (xs[unat idx := VPrim l]))" in exI)
  apply (clarsimp simp: val_wa_put2_def)
  done

lemma proc_env_u_v_matches_\<xi>0_\<xi>m_\<Xi>:
  "proc_env_u_v_matches \<xi>0 \<xi>m \<Xi>"
  apply (clarsimp simp: proc_env_u_v_matches_def)
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) assoc_lookup.simps)+
  apply (clarsimp split: if_split_asm)
    apply (clarsimp simp: wordarray_get_0_type_def abbreviated_type_defs)
    apply (drule wa_get_upd_val; simp)
   apply (clarsimp simp: wordarray_length_0_type_def)
   apply (drule wa_length_upd_val; simp)
  apply (clarsimp simp: wordarray_put2_0_type_def abbreviated_type_defs)
  apply (drule wa_put2_upd_val; simp)
  done

subsection "Type preservation and frame constraint satisfaction in the Update semantics"

lemma upd_proc_env_matches_ptrs_\<xi>0_\<Xi>:
  "upd.proc_env_matches_ptrs \<xi>0 \<Xi>"
  apply (unfold upd.proc_env_matches_ptrs_def)
  apply clarsimp
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) assoc_lookup.simps)+
  apply (clarsimp split: if_split_asm)
    apply (clarsimp simp: wordarray_get_0_type_def abbreviated_type_defs)
    apply (drule upd_wa_get_preservation; simp?)
   apply (clarsimp simp: wordarray_length_0_type_def)
  apply (drule upd_wa_length_preservation; simp)
  apply (clarsimp simp: wordarray_put2_0_type_def abbreviated_type_defs)
  apply (drule upd_wa_put2_preservation; simp)
  done

section "Second Order Abstract Function Assumptions"

lemma lit_type_ex:
  "lit_type l = Bool \<Longrightarrow> \<exists>v. l = LBool v"
  "lit_type l = Num U8 \<Longrightarrow> \<exists>v. l = LU8 v"
  "lit_type l = Num U16 \<Longrightarrow> \<exists>v. l = LU16 v"
  "lit_type l = Num U32 \<Longrightarrow> \<exists>v. l = LU32 v"
  "lit_type l = Num U64 \<Longrightarrow> \<exists>v. l = LU64 v"
  apply (induct l; clarsimp)+
  done

subsection "Monomorphisation"

lemma value_sem_rename_mono_prog_rename_\<Xi>_\<xi>m1_\<xi>p1:
  "value_sem.rename_mono_prog wa_abs_typing_v rename \<Xi> \<xi>m1 \<xi>p1"
  apply (clarsimp simp: val.rename_mono_prog_def)
  apply (rule conjI; clarsimp)
   apply (rule_tac x = v' in exI)
   apply (subst (asm) rename_def)
   apply (subst (asm) assoc_lookup.simps)+
   apply (clarsimp split: if_split_asm)
  apply (clarsimp simp: val_wa_length_rename_monoexpr_correct)
  apply (rule conjI)
   apply clarsimp
   apply (rule_tac x = v' in exI)
   apply (subst (asm) rename_def)
   apply (subst (asm) assoc_lookup.simps)+
   apply (clarsimp split: if_split_asm)
  apply (clarsimp simp: val_wa_get_rename_monoexpr_correct)
  apply clarsimp
  apply (rule conjI; clarsimp)
   apply (rule_tac x = v' in exI)
   apply (subst (asm) rename_def)
   apply (subst (asm) assoc_lookup.simps)+
   apply (clarsimp split: if_split_asm)
   apply (clarsimp simp: val_wa_put2_rename_monoexpr_correct)
  apply (subst (asm) rename_def)+
  apply (subst (asm) assoc_lookup.simps)+
  apply (clarsimp split: if_split_asm)
    apply (rule conjI; clarsimp; subst (asm) rename_def; clarsimp)
    apply (clarsimp simp: val_wa_foldnb_def val_wa_foldnbp_def)
    apply (case_tac v; clarsimp)
    apply (case_tac z; clarsimp)
    apply (case_tac za; clarsimp)
    apply (case_tac zb; clarsimp)
    apply (rotate_tac 4)
    apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_fold_no_break_0_type_def abbreviated_type_defs)
    apply (drule_tac xs = xs and frm = "unat frm" and to = "unat to" and acc = zd and obsv = ze and
      r = v' and \<xi>\<^sub>p = \<xi>p in
      val_wa_foldnb_bod_rename_monoexpr_correct[OF val_proc_env_matches_\<xi>m_\<Xi>] ; simp?; clarsimp?)
    apply (rule value_sem_rename_mono_prog_rename_\<Xi>_\<xi>m_\<xi>p)
   apply (rule conjI; clarsimp; subst (asm) rename_def; clarsimp)
   apply (clarsimp simp: val_wa_mapAccumnb_def val_wa_mapAccumnbp_def)
   apply (case_tac v; clarsimp)
   apply (case_tac z; clarsimp)
   apply (case_tac za; clarsimp)
   apply (case_tac zb; clarsimp)
   apply (rotate_tac 4)
   apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_map_no_break_0_type_def abbreviated_type_defs)
   apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_map_no_break_0_type_def abbreviated_type_defs)
    apply (drule_tac xs = xs and frm = "unat frm" and to = "unat to" and acc = zd and obsv = ze and
      r = v' and \<xi>\<^sub>p = \<xi>p in
      val_wa_mapAccumnb_bod_rename_monoexpr_correct[OF val_proc_env_matches_\<xi>m_\<Xi>] ; simp?; clarsimp?)
   apply (rule value_sem_rename_mono_prog_rename_\<Xi>_\<xi>m_\<xi>p)
  apply (rule conjI; clarsimp; subst (asm) rename_def; clarsimp)
  done

subsection "Type preservation in the Value semantics"

lemma val_proc_env_matches_\<xi>m1_\<Xi>:
  "val.proc_env_matches \<xi>m1 \<Xi>"
 apply (clarsimp simp: val.proc_env_matches_def)
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) assoc_lookup.simps)+
  apply (clarsimp split: if_split_asm)
      apply (clarsimp simp: wordarray_get_0_type_def abbreviated_type_defs)
      apply (drule val_wa_get_preservation; simp?)
     apply (clarsimp simp: wordarray_length_0_type_def)
     apply (drule val_wa_length_preservation; simp?)
    apply (clarsimp simp: wordarray_put2_0_type_def abbreviated_type_defs)
    apply (drule val_wa_put2_preservation; simp?)
   apply (clarsimp simp: wordarray_fold_no_break_0_type_def val_wa_foldnb_def)
   apply (erule val.v_t_recordE)
   apply (erule val.v_t_r_consE; clarsimp)+
   apply (erule val.v_t_abstractE; clarsimp)
   apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_fold_no_break_0_type_def abbreviated_type_defs)
   apply (drule val_wa_foldnb_bod_preservation[OF proc_ctx_wellformed_\<Xi> val_proc_env_matches_\<xi>m_\<Xi>]; simp?; clarsimp)
  apply (clarsimp simp: wordarray_map_no_break_0_type_def val_wa_mapAccumnb_def)
  apply (erule val.v_t_recordE)
  apply (erule val.v_t_r_consE; clarsimp)+
  apply (erule val.v_t_abstractE; clarsimp)
  apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (drule_tac ptrl = undefined in val_wa_mapAccumnb_bod_preservation[OF proc_ctx_wellformed_\<Xi> val_proc_env_matches_\<xi>m_\<Xi>]; simp?)
  apply clarsimp+
  done

subsection "Type preservation and frame constraint satisfaction in the Update semantics"

lemma upd_wa_foldnb_preservation:
  "\<And>K a b \<sigma> \<sigma>' \<tau>s v v' r w.
   \<lbrakk>list_all2 (kinding []) \<tau>s K; wordarray_fold_no_break_0_type = (K, a, b);
    upd.uval_typing \<Xi> \<sigma> v (instantiate \<tau>s a) r w;
    upd_wa_foldnb \<Xi> \<xi>0 (foldmap_funarg_type ''wordarray_fold_no_break_0'') (\<sigma>, v) (\<sigma>', v')\<rbrakk>
    \<Longrightarrow> \<exists>r' w'. upd.uval_typing \<Xi> \<sigma>' v' (instantiate \<tau>s b) r' w' \<and> r' \<subseteq> r \<and> frame \<sigma> w \<sigma>' w'"
  apply (clarsimp simp: wordarray_fold_no_break_0_type_def upd_wa_foldnb_def)
  apply (rename_tac rb wb rc)
  apply (erule upd.u_t_recE; clarsimp)
  apply (erule upd.u_t_r_consE; clarsimp)
  apply (erule upd.u_t_r_consE; simp)
  apply (erule upd.u_t_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym; clarsimp)+
  apply (erule upd.u_t_r_consE; clarsimp)+
  apply (erule upd.u_t_r_emptyE; clarsimp)
  apply (erule upd.u_t_p_absE; clarsimp)
  apply (rotate_tac 4)
  apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_fold_no_break_0_type_def abbreviated_type_defs)
  apply (erule upd.u_t_primE)+
  apply (drule_tac t = "lit_type _" in sym)+
  apply clarsimp
  apply (frule upd.tfun_no_pointers(1))
  apply (frule upd.tfun_no_pointers(2))
  apply clarsimp
  apply (rename_tac f acc r_a w_a obsv r_o w_o ra)
  apply (drule_tac x = acc in upd.uval_typing_unique_ptrs(1); simp?)
  apply (drule_tac x = obsv in upd.uval_typing_unique_ptrs(1); simp?)
  apply clarsimp
  apply (drule_tac ra = ra and rb = rb and rc = rc and wb = wb in
      upd_wa_foldnb_bod_preservation[OF proc_ctx_wellformed_\<Xi> upd_proc_env_matches_ptrs_\<xi>0_\<Xi>,
        where ptrl = undefined and wa = "{}", simplified]; simp?; clarsimp?)
  apply (case_tac f; clarsimp)
  apply (elim upd.u_t_functionE upd.u_t_afunE; clarsimp; blast)+
  done

lemma upd_wa_mapAccumnb_preservation:
  "\<And>K a b \<sigma> \<sigma>' \<tau>s v v' r w.
       \<lbrakk>list_all2 (kinding []) \<tau>s K; wordarray_map_no_break_0_type = (K, a, b); upd.uval_typing \<Xi> \<sigma> v (instantiate \<tau>s a) r w;
        upd_wa_mapAccumnb \<Xi> \<xi>0
         (funarg_type (present_type (rec_type_list (prod.fst (prod.snd (\<Xi> ''wordarray_map_no_break_0''))) ! 3)))
         (funret_type (present_type (rec_type_list (prod.fst (prod.snd (\<Xi> ''wordarray_map_no_break_0''))) ! 3))) (\<sigma>, v) (\<sigma>', v')\<rbrakk>
       \<Longrightarrow> \<exists>r' w'. upd.uval_typing \<Xi> \<sigma>' v' (instantiate \<tau>s b) r' w' \<and> r' \<subseteq> r \<and> frame \<sigma> w \<sigma>' w'"
  apply (clarsimp simp: wordarray_map_no_break_0_type_def upd_wa_mapAccumnb_def)
  apply (rotate_tac 6)
  apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (rename_tac rb wb rc)
  apply (erule upd.u_t_recE; clarsimp)
  apply (erule upd.u_t_r_consE; clarsimp)
  apply (erule upd.u_t_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym; clarsimp)
  apply (erule upd.u_t_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym; clarsimp)
  apply (erule upd.u_t_r_consE; clarsimp)
  apply (frule upd.tfun_no_pointers(1))
  apply (frule upd.tfun_no_pointers(2))
  apply clarsimp
  apply (rename_tac f r' w')
  apply (erule upd.u_t_r_consE; clarsimp)
  apply (rename_tac acc r_a w_a r' w')
  apply (erule upd.u_t_r_consE; clarsimp)
  apply (erule upd.u_t_r_emptyE; clarsimp)
  apply (rename_tac obsv r_o w_o)
  apply (erule upd.u_t_primE)+
  apply (drule_tac t = "lit_type _" in sym)+
  apply clarsimp
  apply (drule upd.uval_typing_unique_ptrs(1); simp?)
  apply (drule upd.uval_typing_unique_ptrs(1); simp?)
  apply (erule upd.u_t_p_absE; clarsimp)
  apply (rename_tac wa)
  apply (cut_tac ra = ra and rb = r_a and rc = r_o  and wa = wa and wb = w_a in
      upd_wa_mapAccumnb_bod_preservation[OF proc_ctx_wellformed_\<Xi> upd_proc_env_matches_ptrs_\<xi>0_\<Xi>,
        where ptrl = undefined, simplified]; simp?; clarsimp?)
    apply (subst Int_Un_distrib2; clarsimp)
    apply (cut_tac A = wa and B = r_a and C = r_o in Int_Un_distrib; simp?)
   apply (cut_tac A = wa and B = r_a and C = r_o in Int_Un_distrib; simp?)
  apply (erule_tac x = r' in allE)
  apply (clarsimp simp: Un_assoc)
  apply (erule_tac x = "insert p w'" in allE)
  apply clarsimp
  apply (drule_tac p = p in frame_expand(1); simp?)
  done

lemma upd_proc_env_matches_ptrs_\<xi>1_\<Xi>:
  "upd.proc_env_matches_ptrs \<xi>1 \<Xi>"
  apply (unfold upd.proc_env_matches_ptrs_def)
  apply clarsimp
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) assoc_lookup.simps)+
  apply (clarsimp split: if_split_asm)
     apply (clarsimp simp: wordarray_get_0_type_def abbreviated_type_defs)
     apply (drule upd_wa_get_preservation; simp?)
    apply (clarsimp simp: wordarray_length_0_type_def)
    apply (drule upd_wa_length_preservation; simp)
   apply (clarsimp simp: wordarray_put2_0_type_def abbreviated_type_defs)
   apply (drule upd_wa_put2_preservation; simp)
  apply (clarsimp simp: upd_wa_foldnb_preservation)
  apply (clarsimp simp: upd_wa_mapAccumnb_preservation)
  done

subsection "Correspondence and upward propagation from Update to the Value semantics"

lemma upd_val_wa_foldnb_bod_corres:
  "\<lbrakk>proc_ctx_wellformed \<Xi>'; proc_env_u_v_matches \<xi>\<^sub>u \<xi>\<^sub>v \<Xi>';
    upd_wa_foldnb_bod \<xi>\<^sub>u \<sigma> p frm to f acc obsv (ra \<union> s) (\<sigma>', res);
    val_wa_foldnb_bod \<xi>\<^sub>v v xs (unat frm) (unat to) f acc' obsv' res';
    \<sigma> p = option.Some (UAbstract (UWA v len arr));
    wa_abs_upd_val (UWA v len arr) (VWA v xs) ''WordArray'' [v] (Boxed ReadOnly ptrl) r w \<sigma>;
    upd_val_rel \<Xi>' \<sigma> acc acc' u ra wa; upd_val_rel \<Xi>' \<sigma> obsv obsv' t s {}; wa \<inter> s = {};
    \<tau> = TRecord [(a0, (v, Present)), (a1, (u, Present)), (a2, (t, Present))] Unboxed;
     \<Xi>', [], [option.Some \<tau>] \<turnstile> App f (Var 0) : u; distinct [a0, a1, a2]\<rbrakk>
    \<Longrightarrow> \<exists>ra' wa'.  upd_val_rel \<Xi>' \<sigma>' res res' u ra' wa' \<and> ra' \<subseteq> ({p} \<union> ra \<union> s \<union> r)\<and> frame \<sigma> wa \<sigma>' wa'"
  apply (induct to arbitrary: res res' \<sigma>')
   apply (erule upd_wa_foldnb_bod.elims; clarsimp)
   apply (erule val_wa_foldnb_bod.elims; clarsimp)
   apply (rule_tac x = ra in exI)
   apply (rule_tac x = wa in exI)
   apply (clarsimp simp: frame_def)
  apply (case_tac "len < 1 + to")
   apply (drule upd_wa_foldnb_bod_back_step'; simp?)
   apply (drule unatSuc; clarsimp)
   apply (drule val_wa_foldnb_bod_back_step'; clarsimp simp: wa_abs_upd_val_def word_less_nat_alt)
   apply (case_tac v; clarsimp)
   apply (case_tac x5; clarsimp)
  apply (case_tac "1 + to \<le> frm")
   apply (frule_tac y = "1 + to" and x = frm in leD)
   apply (erule upd_wa_foldnb_bod.elims; clarsimp)
   apply (drule unatSuc; clarsimp simp: word_less_nat_alt word_le_nat_alt)
   apply (erule val_wa_foldnb_bod.elims; clarsimp)
   apply (rule_tac x = ra in exI)
   apply (rule_tac x = wa in exI)
   apply (clarsimp simp: frame_def)
  apply (clarsimp simp: wa_abs_upd_val_def)
  apply (case_tac v; clarsimp)
  apply (case_tac x5; clarsimp)
  apply (drule upd_wa_foldnb_bod_back_step; simp?)
  apply (drule unatSuc; clarsimp simp: word_less_nat_alt word_le_nat_alt)
  apply (drule_tac val_wa_foldnb_bod_back_step; simp?)
  apply clarsimp
  apply (drule_tac x = r'' in meta_spec)
  apply (drule_tac x = r' in meta_spec)
  apply (drule_tac x = \<sigma>'' in meta_spec)
  apply clarsimp
  apply (frule_tac \<gamma> = "[URecord [(va, upd.uval_repr va), (r'', upd.uval_repr r''),
      (obsv, upd.uval_repr obsv)]]" and
      \<gamma>' = "[VRecord [xs ! unat to, r', obsv']]" and
      r = "ra' \<union> s" and w = wa' in mono_correspondence(1); simp?; clarsimp?)
   apply (rule u_v_matches_some[where r' = "{}" and w' = "{}", simplified])
    apply (rule u_v_struct; simp?)
    apply (rule u_v_r_cons1[where r = "{}" and w = "{}", simplified]; simp?)
      apply (erule_tac x = to in allE)
      apply (clarsimp simp: not_less word_less_nat_alt)
      apply (rule u_v_prim'; clarsimp)
     apply (rule u_v_r_cons1[where r' = s and w' = "{}", simplified]; simp?)
       apply (rule u_v_r_cons1[where r' = "{}" and w' = "{}", simplified]; simp?)
         apply (rule upd_val_rel_frame(1); simp?)
         apply (rule disjointI)
         apply (thin_tac "frame _ _ _ _")
         apply (clarsimp simp: frame_def)
         apply (erule_tac x = y in allE)
         apply (drule_tac x = y in orthD2; simp)
        apply (rule u_v_r_empty)
       apply (drule_tac u = obsv in upd_val_rel_to_uval_typing(1))
       apply (drule upd.type_repr_uval_repr(1); simp)
      apply (drule upd_val_rel_to_uval_typing(1))
      apply (thin_tac "frame _ _ _ _")
      apply (rule disjointI)
      apply (clarsimp simp: frame_def)
      apply (erule_tac x = y in allE)+
      apply clarsimp
      apply (drule_tac x = y in orthD2; simp)
      apply (drule_tac p = y and u = obsv in upd_val_rel_valid(1)[rotated 1]; simp?)
     apply (drule_tac u = r'' in upd_val_rel_to_uval_typing(1))
     apply (drule upd.type_repr_uval_repr(1); simp)
    apply (erule_tac x = to in allE; clarsimp)
   apply (rule u_v_matches_empty[where \<tau>s = "[]", simplified])
  apply (rule_tac x = r'a in exI)
  apply (rule_tac x = w' in exI)
  apply clarsimp
  apply (rule conjI)
   apply blast
  apply (rule upd.frame_trans; simp)
  done

lemma val_executes_from_upd_wa_foldnb_bod:
  "\<lbrakk>proc_ctx_wellformed \<Xi>'; proc_env_u_v_matches \<xi>\<^sub>u \<xi>\<^sub>v \<Xi>';
    upd_wa_foldnb_bod \<xi>\<^sub>u \<sigma> p frm to f acc obsv (ra \<union> s) (\<sigma>', res);
    \<sigma> p = option.Some (UAbstract (UWA v len arr));
    wa_abs_upd_val (UWA v len arr) (VWA v xs) ''WordArray'' [v] (Boxed ReadOnly ptrl) r w \<sigma>;
    upd_val_rel \<Xi>' \<sigma> acc acc' u ra wa; upd_val_rel \<Xi>' \<sigma> obsv obsv' t s {}; wa \<inter> s = {};
    \<tau> = TRecord [(a0, (v, Present)), (a1, (u, Present)), (a2, (t, Present))] Unboxed;
     \<Xi>', [], [option.Some \<tau>] \<turnstile> App f (Var 0) : u; distinct [a0, a1, a2]\<rbrakk>
    \<Longrightarrow> \<exists>res'. val_wa_foldnb_bod \<xi>\<^sub>v v xs (unat frm) (unat to) f acc' obsv' res'"
  apply (induct to arbitrary: \<sigma>' res)
   apply (rule_tac x = acc' in exI)
   apply (subst val_wa_foldnb_bod.simps; clarsimp)
   apply clarsimp
  apply (case_tac "len < 1 + to")
   apply (drule upd_wa_foldnb_bod_back_step'; simp?)
   apply (erule_tac x = \<sigma>' in meta_allE)
   apply (erule_tac x = res in meta_allE)
   apply clarsimp
   apply (rule_tac x = x in exI)
   apply (drule val_wa_foldnb_bod_to_geq_lenD)
    apply (drule wa_abs_upd_val_elims(3); clarsimp simp: unatSuc word_less_nat_alt)
   apply (drule unatSuc; clarsimp)
   apply (rule val_wa_foldnb_bod_to_geq_len; simp?)
   apply (drule wa_abs_upd_val_elims(3); clarsimp simp: unatSuc word_less_nat_alt)
  apply (case_tac "1 + to \<le> frm")
   apply (rule_tac x = acc' in exI)
   apply (drule unatSuc; clarsimp simp: word_less_nat_alt word_le_nat_alt)
   apply (subst val_wa_foldnb_bod.simps; clarsimp)
  apply (frule wa_abs_upd_val_elims(2))
  apply (drule wa_abs_typing_v_elims(1); clarsimp)
  apply (drule_tac upd_wa_foldnb_bod_back_step; simp?)
  apply clarsimp
  apply (drule_tac x = \<sigma>'' in meta_spec)
  apply (drule_tac x = r'' in meta_spec)
  apply clarsimp
  apply (frule_tac r = r and w = w and ptrl = ptrl in upd_val_wa_foldnb_bod_corres; simp?)
  apply clarsimp
  apply (drule unatSuc; clarsimp simp: word_less_nat_alt word_le_nat_alt)
  apply (frule_tac \<gamma> = "[URecord [(va, upd.uval_repr va), (r'', upd.uval_repr r''),
      (obsv, upd.uval_repr obsv)]]" and
      \<gamma>' = "[VRecord [xs ! unat to, x, obsv']]" and
      r = "ra' \<union> s" and w = wa' in val_executes_from_upd_executes(1); simp?; clarsimp?)
   apply (rule u_v_matches_some[where r' = "{}" and w' = "{}", simplified])
    apply (rule u_v_struct; simp?)
    apply (rule u_v_r_cons1[where r = "{}" and w = "{}", simplified]; simp?)
      apply (drule wa_abs_upd_val_elims(4))
      apply (erule_tac x = to in allE; clarsimp simp: word_less_nat_alt)+
      apply (rule u_v_prim'; clarsimp)
     apply (rule u_v_r_cons1[where r' = s and w' = "{}", simplified]; simp?)
       apply (rule u_v_r_cons1[where r' = "{}" and w' = "{}", simplified]; simp?)
         apply (rule upd_val_rel_frame(1); simp add: Int_commute)
        apply (rule u_v_r_empty)
       apply (drule_tac u = obsv in  upd_val_rel_to_uval_typing(1))
       apply (drule upd.type_repr_uval_repr(1); simp)
      apply (rule disjointI)
      apply (drule_tac u = obsv and p = y in upd_val_rel_valid(1)[rotated 1]; simp?)
      apply clarsimp
      apply (drule_tac p = y and \<sigma> = \<sigma> in readonly_not_in_frame; simp?)
      apply blast
     apply (drule_tac u = r'' in  upd_val_rel_to_uval_typing(1))
     apply (drule upd.type_repr_uval_repr(1); simp)
    apply (drule wa_abs_upd_val_elims(4))
    apply (erule_tac x = to in allE; clarsimp simp: word_less_nat_alt)+
   apply (rule u_v_matches_empty[where \<tau>s = "[]", simplified])
  apply (drule_tac r' = v' in  val_wa_foldnb_bod_step; simp?)
   apply (drule wa_abs_upd_val_elims(3); simp)
  apply (rule_tac x = v' in exI)
  apply clarsimp
  done

lemma upd_val_wa_mapAccumnb_bod_corres:
  "\<lbrakk>proc_ctx_wellformed \<Xi>'; proc_env_u_v_matches \<xi>\<^sub>u \<xi>\<^sub>v \<Xi>';
    upd_wa_mapAccumnb_bod \<xi>\<^sub>u \<sigma> p frm to f acc obsv (rb \<union> rc) (\<sigma>', res);
    val_wa_mapAccumnb_bod \<xi>\<^sub>v t xs (unat frm) (unat to) f acc' obsv' res';
    \<sigma> p = option.Some (UAbstract (UWA t len arr));
    wa_abs_upd_val (UWA t len arr) (VWA t xs) ''WordArray'' [t] (Boxed Writable ptrl) ra wa \<sigma>;
    upd_val_rel \<Xi>' \<sigma> acc acc' u rb wb; upd_val_rel \<Xi>' \<sigma> obsv obsv' v rc {};
    (wa \<union> wb) \<inter> rc = {}; wa \<inter> wb = {}; wa \<inter> rb = {}; p \<notin> wa \<union> rb \<union> wb \<union> rc;
    \<Xi>', [], [option.Some (TRecord [(a0, t, Present), (a1, u, Present), (a2, v, Present)] Unboxed)]
      \<turnstile> (App f (Var 0)) : TRecord [(b0, t, Present), (b1, u, Present)] Unboxed;
    distinct [a0, a1, a2]; distinct [b0, b1]\<rbrakk>
    \<Longrightarrow> \<exists>r' w'. upd_val_rel \<Xi>' \<sigma>' res res' (TRecord [
        (b0, TCon ''WordArray'' [t] (Boxed Writable ptrl), Present),
        (b1, u, Present)] Unboxed) r'(insert p w') \<and>
      r' \<subseteq> (ra \<union> rb \<union> rc)\<and> frame \<sigma> (wa \<union> wb) \<sigma>' w'"
  apply (induct to arbitrary:  \<sigma>' res' res)
   apply (erule upd_wa_mapAccumnb_bod.elims; clarsimp)
   apply (erule val_wa_mapAccumnb_bod.elims; clarsimp)
   apply (rule_tac x = "ra \<union> rb" in exI)
   apply (rule_tac x = "wa \<union> wb" in exI)
   apply (clarsimp simp: upd.frame_id)
   apply (rule u_v_struct; simp?)
   apply (subst Set.Un_insert_left[symmetric])
   apply (rule u_v_r_cons1; simp?)
     apply (rule_tac ptrl = ptrl in u_v_p_abs_w[where ts = "[TPrim _]", simplified]; simp?)
     apply (drule wa_abs_upd_val_elims(1))
     apply (drule wa_abs_typing_u_elims(3); clarsimp)
    apply (rule u_v_r_cons1[where r' = "{}" and w' = "{}", simplified]; simp?)
     apply (rule u_v_r_empty)
    apply (drule upd_val_rel_to_uval_typing)
    apply (drule upd.type_repr_uval_repr(1); simp)
   apply (drule wa_abs_upd_val_elims(1))
   apply (drule wa_abs_typing_u_elims(3); clarsimp)
  apply (case_tac "len < 1 + to")
   apply (drule upd_wa_mapAccumnb_bod_back_step'; simp?)
   apply (drule unatSuc; clarsimp)
   apply (drule val_wa_mapAccumnb_bod_back_step'; simp?)
   apply (drule wa_abs_upd_val_elims(3); clarsimp simp: word_less_nat_alt)
  apply (case_tac "1 + to \<le> frm")
   apply (frule_tac y = "1 + to" and x = frm in leD)
   apply (erule upd_wa_mapAccumnb_bod.elims; clarsimp)
   apply (drule unatSuc; clarsimp simp: word_less_nat_alt word_le_nat_alt)
   apply (erule val_wa_mapAccumnb_bod.elims; clarsimp)
   apply (rule_tac x = "ra \<union> rb" in exI)
   apply (rule_tac x = "wa \<union> wb" in exI)
   apply (clarsimp simp: upd.frame_id)
   apply (rule u_v_struct; simp?)
   apply (subst Set.Un_insert_left[symmetric])
   apply (rule u_v_r_cons1; simp?)
     apply (rule_tac ptrl = ptrl in u_v_p_abs_w[where ts = "[TPrim _]", simplified]; simp?)
     apply (drule wa_abs_upd_val_elims(1))
     apply (drule wa_abs_typing_u_elims(3); clarsimp)
    apply (rule u_v_r_cons1[where r' = "{}" and w' = "{}", simplified]; simp?)
     apply (rule u_v_r_empty)
    apply (drule upd_val_rel_to_uval_typing)
    apply (drule upd.type_repr_uval_repr(1); simp)
   apply (drule wa_abs_upd_val_elims(1))
   apply (drule wa_abs_typing_u_elims(3); clarsimp)
  apply (frule wa_abs_upd_val_elims(2))
  apply (drule wa_abs_typing_v_elims(1); clarsimp)
  apply (frule upd_wa_mapAccumnb_bod_preservation'; simp?; clarsimp)
  apply (drule upd_wa_mapAccumnb_bod_back_step; simp?)
   apply (drule wa_abs_upd_val_elims(1))
   apply (drule wa_abs_typing_u_elims(6); clarsimp)
  apply (drule unatSuc; clarsimp simp: word_less_nat_alt word_le_nat_alt)
  apply (frule val_wa_mapAccumnb_bod_preservation'; clarsimp)
  apply (drule val_wa_mapAccumnb_bod_back_step; simp?)
   apply (drule wa_abs_upd_val_elims(3); clarsimp)
  apply clarsimp
  apply (drule_tac x = \<sigma>a in meta_spec)
  apply (erule meta_allE; erule meta_allE; erule meta_impE; simp?; erule meta_impE; simp?)
  apply clarsimp
  apply (erule u_v_recE; clarsimp)
  apply (erule u_v_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)
  apply clarsimp
  apply (erule u_v_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)
  apply clarsimp
  apply (erule u_v_r_emptyE; clarsimp)
  apply (frule_tac \<gamma> = "[URecord [(va, upd.uval_repr va), (x, upd.uval_repr x),
      (obsv, upd.uval_repr obsv)]]" and
      \<gamma>' = "[VRecord [xs ! unat to, racc', obsv']]" and
      r = "raa \<union> rc" and w = waa in mono_correspondence(1); simp?; clarsimp?)
   apply (rule u_v_matches_some[where r' = "{}" and w' = "{}", simplified])
    apply (rule u_v_struct; simp?)
    apply (rule u_v_r_cons1[where r = "{}" and w = "{}", simplified]; simp?)
      apply (drule wa_abs_upd_val_elims(4))
      apply (erule_tac x = to in allE; clarsimp simp: word_less_nat_alt)
      apply (rule u_v_prim'; clarsimp)
     apply (rule u_v_r_cons1[where r' = rc and w' = "{}", simplified]; simp?)
      apply (rule u_v_r_cons1[where r' = "{}" and w' = "{}", simplified]; simp?)
        apply (rule upd_val_rel_frame; simp?; simp add: Int_commute)
       apply (rule u_v_r_empty)
      apply (drule_tac u = obsv in upd_val_rel_to_uval_typing(1))
      apply (drule_tac v = obsv in upd.type_repr_uval_repr(1); simp)
     apply (rule disjointI)
     apply (drule_tac u = obsv in upd_val_rel_to_uval_typing(1))
     apply (frule_tac p = y and u = obsv in upd.uval_typing_valid(1)[rotated 1]; simp)
     apply clarsimp
     apply (drule_tac x = y in orthD2; simp)
     apply clarsimp
     apply (drule_tac p = y and  \<sigma> = \<sigma> in readonly_not_in_frame; simp?)
     apply (subgoal_tac "y \<notin> w \<union> waa")
      apply blast
     apply (drule_tac t = "w \<union> waa" in sym)
     apply simp
     apply blast
    apply (drule wa_abs_upd_val_elims(4))
    apply (erule_tac x = to in allE; clarsimp simp: word_less_nat_alt)
   apply (rule u_v_matches_empty[where \<tau>s = "[]", simplified])
  apply (erule u_v_recE; clarsimp)
  apply (erule u_v_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)
  apply clarsimp
  apply (erule u_v_r_consE; simp)
  apply (erule conjE)+
  apply clarsimp
  apply (erule u_v_r_emptyE; clarsimp)
  apply (erule u_v_t_primtE)
  apply clarsimp
  apply (drule_tac t = "lit_type _" in sym)+
  apply clarsimp
  apply (thin_tac "frame _ _ _ _")
  apply (erule u_v_p_absE[where s = "Boxed Writable _" and ts = "[_]", simplified])
  apply (drule_tac t = "RCon _ _" in sym; clarsimp)
  apply (frule_tac p = p in valid_ptr_not_in_frame_same; simp?)
  apply clarsimp
  apply (frule_tac \<sigma> = \<sigma>a in wa_abs_upd_val_elims(4))
  apply (erule_tac x = to in allE; clarsimp simp: word_less_nat_alt)
  apply (frule_tac \<sigma> = \<sigma>a in wa_abs_upd_val_elims(3))
  apply (subst (asm) nth_list_update_eq; simp)
  apply (frule_tac \<sigma> = \<sigma>a and p = "arr + size_of_num_type ta * to" in readonly_not_in_frame; simp?)
   apply (drule_tac w = wba in wa_abs_upd_val_elims(1))
   apply (drule wa_abs_typing_u_elims(3); clarsimp simp: word_less_nat_alt not_le not_less)
   apply (drule Suc_le_lessD)
   apply (drule_tac x = "arr + size_of_num_type ta * to" and S' = waa in orthD1; simp?)
   apply (rule_tac x = to in exI; simp)
  apply (frule_tac r = r in wa_abs_upd_val_elims(1))
  apply (drule_tac r = r in abs_upd_val_frame; simp?)
   apply (drule_tac wa_abs_typing_u_elims(3); simp)
  apply (cut_tac \<sigma> = \<sigma>b and l = "arr + size_of_num_type ta * to" and v = "UPrim l" in upd.frame_single_update)
  apply (drule_tac r = rca in upd_val_rel_frame(1)[rotated 3]; simp?)
    apply clarsimp
   apply (drule_tac x = "arr + size_of_num_type ta * to" and S = wba and S' = raa in orthD1; simp?)
    apply (drule_tac w = wba in wa_abs_upd_val_elims(1))
    apply (drule_tac w = wba in wa_abs_typing_u_elims(3); clarsimp)
    apply (rule_tac x = to in exI; simp add: word_less_nat_alt)
   apply (drule_tac x = "arr + size_of_num_type ta * to" and S' = rc in orthD1; simp?)
    apply (rule disjI1)
    apply (drule wa_abs_upd_val_elims(1))
    apply (drule_tac \<sigma> = \<sigma> in wa_abs_typing_u_elims(3); clarsimp)
    apply (rule_tac x = to in exI; clarsimp simp: word_less_nat_alt)
   apply clarsimp
   apply (drule_tac A = rca and B = "raa \<union> rc" and x = "arr + size_of_num_type ta * to" in in_mono)
   apply blast
  apply (rule_tac x = "r \<union> rca" in exI)
  apply (rule_tac x = "wba \<union> wc" in exI)
  apply (rule conjI)
   apply (rule u_v_struct; simp?)
   apply (subst Set.Un_insert_left[symmetric])
   apply (rule u_v_r_cons1; simp?)
       apply (rule_tac a = "UWA (TPrim (Num ta)) len arr" and
      ptrl = ptrl in u_v_p_abs_w[where ts = "[TPrim _]", simplified]; simp?)
        apply (drule_tac \<sigma> = \<sigma>b and  i = to in wa_abs_upd_val_update; simp?)
         apply (clarsimp simp: word_less_nat_alt)
        apply (drule_tac s = "rxs ! unat to" in sym; clarsimp)
       apply (drule wa_abs_upd_val_elims(1))
       apply (drule_tac \<sigma> = \<sigma> in wa_abs_typing_u_elims(3); clarsimp)
       apply (rule conjI; clarsimp)
       apply (drule_tac p = p and \<sigma> = \<sigma>a in valid_ptr_not_in_frame_same; simp?)
      apply (rule u_v_r_cons1[where r' = "{}" and w' = "{}", simplified]; simp?)
      apply (rule u_v_r_empty)
     apply (frule_tac p = p and \<sigma> = \<sigma>a in readonly_not_in_frame; simp?)
     apply (rule disjointI)
     apply (drule wa_abs_typing_u_elims(5))
     apply (drule_tac w = wba in wa_abs_upd_val_elims(1))
     apply (drule wa_abs_typing_u_elims(3); clarsimp)
     apply (erule_tac x = i in allE; clarsimp)+
     apply (drule_tac p = "arr + size_of_num_type ta * i" and \<sigma> = \<sigma>a in readonly_not_in_frame; simp?)
     apply clarsimp
     apply (drule_tac x = "arr + size_of_num_type ta * i" and S' = waa in orthD1; simp?)
     apply (rule_tac x = i in exI; simp)
    apply (frule_tac A = rca and B = "raa \<union> rc" and x = p in in_mono; clarsimp)
    apply (rule disjointI; clarsimp)
    apply (drule_tac x = y and S' = raa in orthD1; simp?)
    apply (drule_tac x = y and S' = rc in orthD1; simp?)
     apply (rule disjI1)
     apply (drule wa_abs_upd_val_elims(1))
     apply (drule_tac w = wa in wa_abs_typing_u_elims(3); clarsimp)
     apply (drule wa_abs_typing_u_elims(3); clarsimp)
    apply (drule_tac A = rca and B = "raa \<union> rc" and x = y in in_mono; clarsimp)
   apply (drule wa_abs_typing_u_elims(3); clarsimp)
  apply clarsimp
  apply (rule conjI)
   apply (rule_tac B = "raa \<union> rc" in subset_trans; simp?)
  apply (subst (asm) insert_ident; simp?)
   apply (drule_tac p = p and \<sigma> = \<sigma> in readonly_not_in_frame; simp?)
  apply (drule_tac s = wba and \<sigma> = \<sigma>a in frame_expand(2); simp?)
   apply (frule wa_abs_typing_u_elims(5))
   apply (drule wa_abs_typing_u_elims(3); clarsimp)
   apply (erule_tac x = i in allE; clarsimp)+
  apply (drule wa_abs_typing_u_elims(3); clarsimp)
  apply (drule wa_abs_upd_val_elims(1))
  apply (drule wa_abs_typing_u_elims(3); clarsimp)
  apply (drule_tac \<sigma> = \<sigma>a and \<sigma>' = \<sigma>b in upd.frame_app; simp?)
  apply (rule upd.frame_trans; simp?)
  apply (subst (asm) insert_absorb[where A = "_ \<union> _", simplified]; simp?)
   apply (rule disjI1)
   apply (rule_tac x = to in exI; simp add: word_less_nat_alt)
  apply (subst (asm) insert_absorb[where A = "_ \<union> _", simplified]; simp?)
  apply (rule_tac x = to in exI; simp add: word_less_nat_alt)
  done

lemma val_executes_fron_upd_wa_mapAccumnb_bod:
  "\<lbrakk>proc_ctx_wellformed \<Xi>'; proc_env_u_v_matches \<xi>\<^sub>u \<xi>\<^sub>v \<Xi>';
    upd_wa_mapAccumnb_bod \<xi>\<^sub>u \<sigma> p frm to f acc obsv (rb \<union> rc) (\<sigma>', res);
    \<sigma> p = option.Some (UAbstract (UWA t len arr));
    wa_abs_upd_val (UWA t len arr) (VWA t xs) ''WordArray'' [t] (Boxed Writable ptrl) ra wa \<sigma>;
    upd_val_rel \<Xi>' \<sigma> acc acc' u rb wb; upd_val_rel \<Xi>' \<sigma> obsv obsv' v rc {};
    (wa \<union> wb) \<inter> rc = {}; wa \<inter> wb = {}; wa \<inter> rb = {}; p \<notin> wa \<union> rb \<union> wb \<union> rc;
    \<Xi>', [], [option.Some (TRecord [(a0, t, Present), (a1, u, Present), (a2, v, Present)] Unboxed)]
      \<turnstile> (App f (Var 0)) : TRecord [(b0, t, Present), (b1, u, Present)] Unboxed;
    distinct [a0, a1, a2]; distinct [b0, b1]\<rbrakk>
    \<Longrightarrow> Ex (val_wa_mapAccumnb_bod \<xi>\<^sub>v t xs (unat frm) (unat to) f acc' obsv')"
  apply (induct to arbitrary: \<sigma>' res)
   apply (rule_tac x = "VRecord [VAbstract (VWA t xs), acc']" in exI)
   apply (subst val_wa_mapAccumnb_bod.simps; clarsimp)
  apply (case_tac "len < 1 + to")
   apply (drule upd_wa_mapAccumnb_bod_back_step'; simp?)
   apply (erule meta_allE, erule meta_allE, erule meta_impE, simp?)
   apply (drule unatSuc; clarsimp simp: word_less_nat_alt not_less)
   apply (rule_tac x = x in exI)
   apply (clarsimp simp: less_Suc_eq_le)
   apply (drule wa_abs_upd_val_elims(3))
   apply (drule val_wa_mapAccumnb_bod_to_geq_lenD; simp?)
   apply (rule val_wa_mapAccumnb_bod_to_geq_len; simp)
  apply (case_tac "1 + to \<le> frm")
   apply (drule unatSuc; clarsimp simp: word_less_nat_alt not_less word_le_nat_alt)
   apply (rule_tac x = "VRecord [VAbstract (VWA t xs), acc']" in exI)
   apply (subst val_wa_mapAccumnb_bod.simps; clarsimp)
  apply (frule upd_wa_mapAccumnb_bod_preservation'; simp?)
  apply clarsimp
  apply (frule wa_abs_upd_val_elims(2))
  apply (drule wa_abs_typing_v_elims(1); clarsimp)
  apply (drule upd_wa_mapAccumnb_bod_back_step; simp?)
   apply (drule wa_abs_upd_val_elims(1))
   apply (drule wa_abs_typing_u_elims(6); simp)
  apply clarsimp
  apply (erule meta_allE; erule meta_allE; erule meta_impE; simp?)
  apply clarsimp
  apply (frule_tac rb = rb and wb = wb and rc = rc in upd_val_wa_mapAccumnb_bod_corres; simp?)
  apply clarsimp
  apply (frule val_wa_mapAccumnb_bod_preservation'; simp?)
  apply clarsimp
  apply (erule u_v_recE; clarsimp)
  apply (erule u_v_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym; clarsimp)
  apply (erule u_v_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym; clarsimp)
  apply (erule u_v_r_emptyE; clarsimp)
  apply (drule unatSuc; clarsimp simp: word_less_nat_alt word_le_nat_alt)
  apply (subgoal_tac "u_v_matches \<Xi>' \<sigma>a
    [URecord [(va, upd.uval_repr va), (x, upd.uval_repr x), (obsv, upd.uval_repr obsv)]]
    [VRecord [xs ! unat to, racca, obsv']]
    [option.Some (TRecord [(a0, TPrim (Num ta), Present), (a1, u, Present), (a2, v, Present)] Unboxed)]
    (raa \<union> rc) waa")
   apply (frule_tac \<gamma> = "[URecord [(va, upd.uval_repr va), (x, upd.uval_repr x),
      (obsv, upd.uval_repr obsv)]]" and
      \<gamma>' = "[VRecord [xs ! unat to, racca, obsv']]" and
      r = "raa \<union> rc" and w = waa in val_executes_from_upd_executes(1); simp?; clarsimp?)
  apply (frule_tac \<gamma> = "[URecord [(va, upd.uval_repr va), (x, upd.uval_repr x),
      (obsv, upd.uval_repr obsv)]]" and
      \<gamma>' = "[VRecord [xs ! unat to, racca, obsv']]" and
      r = "raa \<union> rc" and w = waa in mono_correspondence(1); simp?; clarsimp?)
   apply (erule u_v_recE'; clarsimp)
   apply (erule u_v_r_consE'; simp?)
   apply (erule conjE)+
   apply (drule_tac t = "type_repr _" in sym; clarsimp)
   apply (erule u_v_r_consE'; simp?)
   apply (erule conjE)+
   apply clarsimp
   apply (erule u_v_r_emptyE'; clarsimp)
   apply (drule val_wa_mapAccumnb_bod_step; simp?)
    apply (drule wa_abs_upd_val_elims(3); simp)
   apply (rule exI; simp?)
  apply (rule u_v_matches_some[where r' = "{}" and w' = "{}", simplified])
   apply (rule u_v_struct; simp?)
   apply (rule u_v_r_cons1[where r = "{}" and w = "{}", simplified]; simp?)
     apply (frule wa_abs_upd_val_elims(4))
     apply (drule wa_abs_upd_val_elims(3))
     apply (erule_tac x = to in allE; clarsimp simp: word_less_nat_alt)
     apply (rule u_v_prim'; clarsimp)
    apply (rule u_v_r_cons1[where r' = rc and w' = "{}", simplified]; simp?)
     apply (rule u_v_r_cons1[where r' = "{}" and w' = "{}", simplified]; simp?)
       apply (rule upd_val_rel_frame(1); simp add: Int_commute)
      apply (rule u_v_r_empty)
     apply (drule_tac u = obsv in upd_val_rel_to_uval_typing(1))
     apply (drule upd.type_repr_uval_repr; simp?)
    apply (drule_tac u = obsv in upd_val_rel_to_uval_typing(1))
    apply (rule disjointI)
    apply (drule_tac p = y in upd.uval_typing_valid(1)[rotated 1]; simp?)
    apply clarsimp
    apply (drule_tac p = y and \<sigma> = \<sigma> in readonly_not_in_frame; simp?)
     apply (drule_tac x = y and S' = rc in orthD2; simp?)
    apply (drule equalityD2[where A = "insert _ _", simplified])
    apply clarsimp
    apply (drule_tac x = y and A = waa and B = "insert p w'" in  in_mono; simp?)
   apply (drule wa_abs_upd_val_elims(4))
   apply (erule_tac x = to in allE; clarsimp simp: word_less_nat_alt)
  apply (rule u_v_matches_empty[where \<tau>s = "[]", simplified])
  done

lemma wordarray_fold_no_break_upd_val:
  "\<And>K a b \<sigma> \<sigma>' \<tau>s aa a' v v' r w.
   \<lbrakk>list_all2 (kinding []) \<tau>s K; wordarray_fold_no_break_0_type = (K, a, b);
    upd_val_rel \<Xi> \<sigma> aa a' (instantiate \<tau>s a) r w;
    upd_wa_foldnb \<Xi> \<xi>0 (foldmap_funarg_type ''wordarray_fold_no_break_0'') (\<sigma>, aa) (\<sigma>', v)\<rbrakk>
    \<Longrightarrow> (val_wa_foldnb \<Xi> \<xi>m (foldmap_funarg_type ''wordarray_fold_no_break_0'') a' v'
          \<longrightarrow> (\<exists>r' w'. upd_val_rel \<Xi> \<sigma>' v v' (instantiate \<tau>s b) r' w' \<and> r' \<subseteq> r \<and> frame \<sigma> w \<sigma>' w')) \<and>
        Ex (val_wa_foldnb \<Xi> \<xi>m (foldmap_funarg_type ''wordarray_fold_no_break_0'') a')"
  apply (clarsimp simp: wordarray_fold_no_break_0_type_def upd_wa_foldnb_def)
  apply (rotate_tac 6)
  apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_fold_no_break_0_type_def abbreviated_type_defs)
  apply (rename_tac rb wb rc)
  apply (erule u_v_recE'; clarsimp)
  apply (erule u_v_r_consE'; clarsimp)
  apply (erule u_v_p_absE'; clarsimp)
  apply (frule wa_abs_upd_val_elims(2), drule wa_abs_typing_v_elims(1); clarsimp)
  apply (erule u_v_r_consE'; simp)
  apply (erule u_v_r_consE'; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)
  apply clarsimp
  apply (erule u_v_primE')+
  apply (drule_tac t = "lit_type _" in sym)+
  apply clarsimp
  apply (erule u_v_r_consE'; clarsimp)
  apply (rename_tac f f' r_f w_f xs' r' w')
  apply (frule_tac u = f in upd_val_rel_to_uval_typing(1))
  apply (frule upd.tfun_no_pointers(1))
  apply (drule upd.tfun_no_pointers(2))
  apply clarsimp
  apply (erule u_v_r_consE'; clarsimp)
  apply (rename_tac acc acc' r_a w_a xs' r' w')
  apply (erule u_v_r_consE'; clarsimp)
  apply (erule u_v_r_emptyE'; clarsimp)
  apply (rename_tac obsv obsv' r_o w_o)
  apply (frule_tac u = acc in upd_val_rel_to_uval_typing(1))
  apply (drule_tac x = acc in upd.uval_typing_unique_ptrs(1); simp?)
  apply clarsimp
  apply (frule_tac u = obsv in upd_val_rel_to_uval_typing(1))
  apply (drule_tac x = obsv in upd.uval_typing_unique_ptrs(1); simp?)
  apply clarsimp
  apply (clarsimp simp: val_wa_foldnb_def)
  apply (erule impE; simp?)+
   apply (case_tac f; clarsimp; elim u_v_t_funE u_v_t_afunE; clarsimp)
  apply (erule impE, rule upd_val_rel_to_vval_typing(1); simp?)+
  apply (erule impE; simp?)+
   apply (case_tac f; clarsimp; elim u_v_t_funE u_v_t_afunE; clarsimp)
  apply (erule impE, erule wa_abs_upd_val_elims(2); simp?)
  apply (erule disjE; simp?)
  apply clarsimp
   apply (drule_tac xs = xs and r = r and w = "{}" and acc' = acc' and
      obsv' = obsv' and t = "TUnit" and res' = v' and ra = r_a and wa = w_a and ptrl = undefined
      in upd_val_wa_foldnb_bod_corres[OF proc_ctx_wellformed_\<Xi> proc_env_u_v_matches_\<xi>0_\<xi>m_\<Xi>]; simp?)
     apply (case_tac f; clarsimp; elim u_v_t_funE u_v_t_afunE; clarsimp)
    apply clarsimp
   apply clarsimp
   apply (case_tac f; clarsimp; elim u_v_t_funE u_v_t_afunE; clarsimp; blast)
  apply (drule_tac xs = xs and r = r and w = "{}" and acc' = acc' and
      obsv' = obsv' and t = "TUnit" and ra = r_a and wa = w_a and ptrl = undefined
      in val_executes_from_upd_wa_foldnb_bod[OF proc_ctx_wellformed_\<Xi> proc_env_u_v_matches_\<xi>0_\<xi>m_\<Xi>]; simp?)
   apply clarsimp
  apply clarsimp
  apply (rename_tac res)
  apply (erule_tac x = res in allE)
  apply (case_tac f; clarsimp; elim u_v_t_funE u_v_t_afunE; clarsimp)
  done

lemma wordarray_mapAccumnb_abs_upd_val:
  "\<And>K a b \<sigma> \<sigma>' \<tau>s aa a' v v' r w.
       \<lbrakk>list_all2 (kinding []) \<tau>s K; wordarray_map_no_break_0_type = (K, a, b); upd_val_rel \<Xi> \<sigma> aa a' (instantiate \<tau>s a) r w;
        upd_wa_mapAccumnb \<Xi> \<xi>0
         (funarg_type (present_type (rec_type_list (prod.fst (prod.snd (\<Xi> ''wordarray_map_no_break_0''))) ! 3)))
         (funret_type (present_type (rec_type_list (prod.fst (prod.snd (\<Xi> ''wordarray_map_no_break_0''))) ! 3))) (\<sigma>, aa) (\<sigma>', v)\<rbrakk>
       \<Longrightarrow> (val_wa_mapAccumnb \<Xi> \<xi>m
             (funarg_type (present_type (rec_type_list (prod.fst (prod.snd (\<Xi> ''wordarray_map_no_break_0''))) ! 3)))
             (funret_type (present_type (rec_type_list (prod.fst (prod.snd (\<Xi> ''wordarray_map_no_break_0''))) ! 3))) a' v' \<longrightarrow>
            (\<exists>r' w'. upd_val_rel \<Xi> \<sigma>' v v' (instantiate \<tau>s b) r' w' \<and> r' \<subseteq> r \<and> frame \<sigma> w \<sigma>' w')) \<and>
           Ex (val_wa_mapAccumnb \<Xi> \<xi>m
                (funarg_type (present_type (rec_type_list (prod.fst (prod.snd (\<Xi> ''wordarray_map_no_break_0''))) ! 3)))
                (funret_type (present_type (rec_type_list (prod.fst (prod.snd (\<Xi> ''wordarray_map_no_break_0''))) ! 3))) a')"
  apply (clarsimp simp: wordarray_map_no_break_0_type_def upd_wa_mapAccumnb_def)
  apply (rename_tac rb wb rc)
  apply (rotate_tac 6)
  apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (subst (asm) \<Xi>_def; clarsimp simp: wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (erule u_v_recE'; clarsimp)
  apply (erule u_v_r_consE'; clarsimp)
  apply (erule u_v_r_consE'; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)
  apply clarsimp
  apply (erule u_v_r_consE'; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)
  apply clarsimp
  apply (erule u_v_r_consE'; clarsimp)
  apply (rename_tac f f' r_f w_f xs r' w')
  apply (erule u_v_r_consE'; clarsimp)
  apply (rename_tac acc acc' r_a w_a xs r' w')
  apply (erule u_v_r_consE'; clarsimp)
  apply (rename_tac obsv obsv' r_o w_o xs r' w')
  apply (erule u_v_r_emptyE'; clarsimp)
  apply (erule u_v_primE')+
  apply (drule_tac t = "lit_type _" in sym)+
  apply clarsimp
  apply (erule u_v_p_absE'; clarsimp)
  apply (rename_tac wa)
  apply (frule wa_abs_upd_val_elims(2))
  apply (drule wa_abs_typing_v_elims(1); clarsimp)
  apply (frule_tac u = acc in upd_val_rel_to_uval_typing(1))
  apply (drule upd.uval_typing_unique_ptrs(1); simp?)
  apply clarsimp
  apply (frule_tac u = obsv in upd_val_rel_to_uval_typing(1))
  apply (drule upd.uval_typing_unique_ptrs(1); simp?)
  apply (frule_tac u = f in upd_val_rel_to_uval_typing(1))
  apply (frule_tac v= f in upd.tfun_no_pointers(1))
  apply (drule_tac v= f in upd.tfun_no_pointers(2))
  apply (clarsimp simp: val_wa_mapAccumnb_def)
  apply (erule impE; simp?)
   apply (case_tac f; simp; elim u_v_t_funE u_v_t_afunE; simp)
  apply (erule impE, rule upd_val_rel_to_vval_typing(1), simp?)+
  apply (erule impE; simp?)
   apply (case_tac f; simp; elim u_v_t_funE u_v_t_afunE; simp)
  apply (erule impE, erule wa_abs_upd_val_elims(2), simp?)
  apply (erule disjE)
   apply (drule_tac xs = xs and ra = ra and wa = wa and acc' = acc' and
      obsv' = obsv' and  ptrl = undefined and res' = v' and rb = r_a and wb = w_a and rc = r_o
      in upd_val_wa_mapAccumnb_bod_corres[OF proc_ctx_wellformed_\<Xi> proc_env_u_v_matches_\<xi>0_\<xi>m_\<Xi>]; simp?; clarsimp?)
      apply (case_tac f; clarsimp; elim u_v_t_funE u_v_t_afunE; clarsimp)
     apply (subst Int_Un_distrib2; clarsimp)
     apply (cut_tac A = wa and B = r_a and C = r_o in Int_Un_distrib; simp?; clarsimp)
    apply (cut_tac A = wa and B = r_a and C = r_o in Int_Un_distrib; simp?; clarsimp)
   apply (erule_tac x = r' in allE)
   apply (clarsimp simp: Un_assoc)
   apply (erule_tac x = "insert p w'" in allE)
   apply clarsimp
   apply (drule_tac p = p in frame_expand(1); simp?)
  apply (drule_tac xs = xs and ra = ra and wa = wa  and  ptrl = undefined and rb = r_a and wb = w_a and rc = r_o
      in val_executes_fron_upd_wa_mapAccumnb_bod[OF proc_ctx_wellformed_\<Xi> proc_env_u_v_matches_\<xi>0_\<xi>m_\<Xi>]; simp?; clarsimp?)
     apply (subst Int_Un_distrib2; clarsimp)
    apply (cut_tac A = wa and B = r_a and C = r_o in Int_Un_distrib; simp?; clarsimp)
   apply (cut_tac A = wa and B = r_a and C = r_o in Int_Un_distrib; simp?; clarsimp)
  apply (erule_tac x = x in allE)
  apply (case_tac f; simp; elim u_v_t_funE u_v_t_afunE; simp)
  done

lemma proc_env_u_v_matches_\<xi>1_\<xi>m1_\<Xi>:
  "proc_env_u_v_matches \<xi>1 \<xi>m1 \<Xi>"
  apply (clarsimp simp: proc_env_u_v_matches_def)
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) assoc_lookup.simps)+
  apply (clarsimp split: if_split_asm)
      apply (clarsimp simp: wordarray_get_0_type_def abbreviated_type_defs)
      apply (drule wa_get_upd_val; simp)
     apply (clarsimp simp: wordarray_length_0_type_def)
     apply (drule wa_length_upd_val; simp)
    apply (clarsimp simp: wordarray_put2_0_type_def abbreviated_type_defs)
    apply (drule wa_put2_upd_val; simp)
   apply (drule wordarray_fold_no_break_upd_val; simp?)
  apply (clarsimp simp: wordarray_mapAccumnb_abs_upd_val)
  done

end (* of context *)

end


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

header{*The n_german Protocol Case Study*}

theory n_german_lemma_inv__30_on_rules imports n_german_lemma_on_inv__30
begin
section{*All lemmas on causal relation between inv__30*}
lemma lemma_inv__30_on_rules:
  assumes b1: "r \<in> rules N" and b2: "(\<exists> p__Inv2. p__Inv2\<le>N\<and>f=inv__30  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__30) 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__30) 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__30) 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__30) 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__30) 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__30) 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__30) 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__30) 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__30) 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__30) 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__30) 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__30) 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__30) 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__30) done
    }

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

end


(*******************************************************************************

  Project: IsaNet

  Author:  Tobias Klenze, ETH Zurich <tobias.klenze@inf.ethz.ch>
  Version: JCSPaper.1.0
  Isabelle Version: Isabelle2021-1

  Copyright (c) 2022 Tobias Klenze
  Licence: Mozilla Public License 2.0 (MPL) / BSD-3-Clause (dual license)

*******************************************************************************)
section \<open>Anapaya-SCION\<close>
text\<open>This is the "new" SCION protocol, as specified on the website of Anapaya:
\url{https://scion.docs.anapaya.net/en/latest/protocols/scion-header.html} (Accessed 2021-03-02).
It does not use the next hop field in its MAC computation, but instead refers uses a mutable uinfo
field which acts as an XOR-based accumulator for all upstream MACs.

This protocol instance requires the use of the extensions of our formalization that provide mutable
uinfo field and an XOR abstraction.\<close>
theory "Anapaya_SCION"
  imports
    "../Parametrized_Dataplane_3_directed"
    "../infrastructure/Abstract_XOR"
begin

locale scion_defs = network_assums_direct _ _ _ auth_seg0
  for auth_seg0 :: "(msgterm \<times> ahi list) set"
begin

sublocale comp_fun_commute xor
  by(auto simp add: comp_fun_commute_def xor_def)

(******************************************************************************)
subsection \<open>Hop validation check and extract functions\<close>
(******************************************************************************)
type_synonym SCION_HF = "(unit, unit) HF"

text\<open>The predicate @{term "hf_valid"} is given to the concrete parametrized model as a parameter.
It ensures the authenticity of the hop authenticator in the hop field. The predicate takes an authenticated
info field (in this model always a numeric value, hence the matching on Num ts), the unauthenticated
info field and the hop field to be validated. The next hop field is not used in this instance.\<close>
fun hf_valid :: "msgterm \<Rightarrow> msgterm fset
    \<Rightarrow> SCION_HF
    \<Rightarrow> SCION_HF option \<Rightarrow> bool" where
  "hf_valid (Num ts) uinfo \<lparr>AHI = ahi, UHI = _, HVF = x\<rparr> nxt \<longleftrightarrow>
    (\<exists>upif downif. x = Mac[macKey (ASID ahi)] (L [Num ts, upif, downif, FS uinfo]) \<and>
          ASIF (DownIF ahi) downif \<and> ASIF (UpIF ahi) upif)"
| "hf_valid _ _ _ _ = False"

text\<open>Updating the uinfo field involves XORin the current hop validation field onto it. Note that in all
authorized segments, the hvf will already have been contained in segid, hence this operation only
removes terms from the fset in the forwarding of honestly created packets.\<close>
definition upd_uinfo :: "msgterm fset \<Rightarrow> SCION_HF \<Rightarrow> msgterm fset" where
  "upd_uinfo segid hf = xor segid {| HVF hf |}"

declare upd_uinfo_def[simp]

(*What can uinfo be?
hfs = [], uinfo = FS {||}
hfs = [x], uinfo = FS {||}
hfs = [y, x], uinfo = FS {| MAC-of-x |}
hfs = [z, y, x], uinfo = FS {| MAC-of-x, MAC-of-y |}
*)

text\<open>The following lemma is needed to show the termination of extr, defined below.\<close>
lemma extr_helper:
"\<lbrakk>x = Mac[macKey asid'a] (L [ts, upif'a, downif'a, FS segid']);
  fcard segid' = fcard (xor segid {|x|}); x |\<in>| segid\<rbrakk>
       \<Longrightarrow> (case x of Hash \<langle>Key (macK asid), L []\<rangle> \<Rightarrow> 0 | Hash \<langle>Key (macK asid), L [ts]\<rangle> \<Rightarrow> 0
| Hash \<langle>Key (macK asid), L [ts, upif]\<rangle> \<Rightarrow> 0 | Hash \<langle>Key (macK asid), L [ts, upif, downif]\<rangle> \<Rightarrow> 0
            | Hash \<langle>Key (macK asid), L [ts, upif, downif, FS segid]\<rangle> \<Rightarrow> Suc (fcard segid)
| Hash \<langle>Key (macK asid), L (ts # upif # downif # FS segid # ac # lista)\<rangle> \<Rightarrow> 0
            | Hash \<langle>Key (macK asid), L (ts # upif # downif # _ # list)\<rangle> \<Rightarrow> 0
| Hash \<langle>Key (macK asid), _\<rangle> \<Rightarrow> 0 | Hash \<langle>Key _, msgterm2\<rangle> \<Rightarrow> 0 | Hash \<langle>_, msgterm2\<rangle> \<Rightarrow> 0
| Hash _ \<Rightarrow> 0 | _ \<Rightarrow> 0)
           < Suc (fcard segid)"
  apply auto
  using fcard_fminus1_less notin_fset xor_singleton(1) by (metis)

text\<open>We can extract the entire path from the hvf field, which includes the local forwarding
information as well as, recursively, all upstream hvf fields and their hop information.\<close>
function (sequential) extr :: "msgterm \<Rightarrow> ahi list" where
  "extr (Mac[macKey asid] (L [ts, upif, downif, FS segid]))
 = \<lparr>UpIF = term2if upif, DownIF = term2if downif, ASID = asid\<rparr> # (if (\<exists>nextmac asid' upif' downif' segid'.
         segid' = xor segid {| nextmac |} \<and>
         nextmac = Mac[macKey asid'] (L [ts, upif', downif', FS segid']))
    then extr (THE nextmac. (\<exists>asid' upif' downif' segid'.
                             segid' = xor segid {| nextmac |} \<and>
                             nextmac = Mac[macKey asid'] (L [ts, upif', downif', FS segid'])))
    else [])"
| "extr _ = []"
  by pat_completeness auto
termination
  apply (relation "measure (\<lambda>x. (case x of Mac[macKey asid] (L [ts, upif, downif, FS segid])
                    \<Rightarrow> Suc (fcard segid)
                | _ \<Rightarrow> 0))")
  apply auto
  apply(rule theI2)
  by(auto elim: FS_update_eq elim!: FS_contains_elem intro!: extr_helper)

text\<open>Extract the authenticated info field from a hop validation field.\<close>
fun extr_ainfo :: "msgterm \<Rightarrow> msgterm" where
  "extr_ainfo (Mac[macKey asid] (L (Num ts # xs))) = Num ts"
| "extr_ainfo _ = \<epsilon>"

abbreviation term_ainfo :: "msgterm \<Rightarrow> msgterm" where
  "term_ainfo \<equiv> id"

text\<open>The ainfo field must be a Num, since it represents the timestamp (this is only needed for
authorized segments (ainfo, []), since for all other segments, @{text "hf_valid"} enforces this.

Furthermore, we require that the last hop field on l has a MAC that is computed with the empty uinfo
field. This restriction cannot be introduced via @{text "hf_valid"}, since it is not a check
performed by the on-path routers, but rather results from the way that authorized paths are set up
on the control plane. We need this restriction to ensure that the uinfo field of the top node does
not contain extra terms (e.g. secret keys).\<close>
definition auth_restrict where
  "auth_restrict ainfo uinfo l \<equiv>
    (\<exists>ts. ainfo = Num ts)
    \<and> (case l of [] \<Rightarrow> (uinfo = {||}) |
    _ \<Rightarrow> hf_valid ainfo {||} (last l) None)"

text\<open>When observing a hop field, an attacker learns the HVF. UHI is empty and the AHI only contains
public information that are not terms.\<close>
fun terms_hf :: "SCION_HF \<Rightarrow> msgterm set" where
  "terms_hf hf = {HVF hf}"

text\<open>When analyzing a uinfo field (which is an fset of message terms), the attacker learns all
elements of the fset.\<close>
abbreviation terms_uinfo :: "msgterm fset \<Rightarrow> msgterm set" where
  "terms_uinfo \<equiv> fset"

abbreviation no_oracle :: "'ainfo \<Rightarrow> msgterm fset \<Rightarrow> bool" where "no_oracle \<equiv> (\<lambda> _ _. True)"

subsubsection\<open>Properties following from definitions\<close>
text\<open>We now define useful properties of the above definition.\<close>
lemma hf_valid_invert:
  "hf_valid tsn uinfo hf nxt \<longleftrightarrow>
   ((\<exists>ahi ts upif downif asid x.
     hf = \<lparr>AHI = ahi, UHI = (), HVF = x\<rparr> \<and>
     ASID ahi = asid \<and> ASIF (DownIF ahi) downif \<and> ASIF (UpIF ahi) upif \<and>
     x = Mac[macKey asid] (L [tsn, upif, downif, FS uinfo]) \<and>
     tsn = Num ts)
    )"
  by(auto elim!: hf_valid.elims)

lemma info_hvf:
  assumes "hf_valid ainfo uinfo m z" "hf_valid ainfo' uinfo' m' z'" "HVF m = HVF m'"
  shows "ainfo' = ainfo" "m' = m"
  using assms by(auto simp add: hf_valid_invert intro: ahi_eq)

(******************************************************************************)
subsection\<open>Definitions and properties of the added intruder knowledge\<close>
(******************************************************************************)
text\<open>Here we define @{text "ik_add"} and @{text "ik_oracle"} as being empty, as these features are
not used in this instance model.\<close>

print_locale dataplane_3_directed_defs
sublocale dataplane_3_directed_defs _ _ _ auth_seg0 hf_valid auth_restrict extr extr_ainfo term_ainfo
                 terms_hf terms_uinfo upd_uinfo no_oracle
  by unfold_locales
declare TWu.holds_set_list[dest]
declare TWu.holds_takeW_is_identity[simp]
declare parts_singleton[dest]

abbreviation ik_add :: "msgterm set" where "ik_add \<equiv> {}"

abbreviation ik_oracle :: "msgterm set" where "ik_oracle \<equiv> {}"

(******************************************************************************)
subsection\<open>Properties of the intruder knowledge, including @{term "terms_uinfo"}.\<close>
(******************************************************************************)
text\<open>We now instantiate the parametrized model's definition of the intruder knowledge, using the
definitions of @{term "terms_uinfo"} and  @{text "ik_oracle"} from above. We then prove the properties
that we need to instantiate the @{text "dataplane_3_directed"} locale.\<close>
print_locale dataplane_3_directed_ik_defs
sublocale
  dataplane_3_directed_ik_defs _ _ _ auth_seg0 terms_uinfo no_oracle hf_valid auth_restrict extr extr_ainfo term_ainfo
                  terms_hf upd_uinfo ik_add ik_oracle
  by unfold_locales

text\<open>For this instance model, the neighboring hop field is irrelevant. Hence, if we are interested
in establishing the first hop field's validity given @{text "hfs_valid"}, we do not need to make
a case distinction on the rest of the hop fields (which would normally be required by @{text "TWu"}.\<close>
lemma hfs_valid_first[elim]: "hfs_valid ainfo uinfo (hf # post) nxt \<Longrightarrow> hf_valid ainfo uinfo hf nxt'"
  by(cases post, auto simp add: hf_valid_invert TWu.holds.simps)

text\<open>Properties of HVF of valid hop fields that fulfill the restriction.\<close>
lemma auth_properties:
  assumes "hf \<in> set hfs" "hfs_valid ainfo uinfo hfs nxt" "auth_restrict ainfo uinfo hfs"
          "t = HVF hf"
  shows "(\<exists>t' . t = Hash t')
       \<and> (\<exists>uinfo'. auth_restrict ainfo uinfo' hfs
       \<and> (\<exists>nxt. hf_valid ainfo uinfo' hf nxt))"
using assms
proof(induction uinfo hfs nxt arbitrary: hf rule: TWu.holds.induct[where ?upd=upd_uinfo])
  case (1 info x y ys nxt)
  then show ?case
  proof(cases "hf = x")
    case True
    then show ?thesis

      using 1(2-5) by (auto simp add: TWu.holds.simps(1) hf_valid_invert)
  next
    case False
    then have "hf \<in> set (y # ys)" using 1 by auto
    then show ?thesis
      apply- apply(drule 1)
      subgoal using assms 1(2-5) by (simp add: TWu.holds.simps(1))
      using assms(3) 1(2-5) False
      by(auto simp add: auth_restrict_def hf_valid_invert)
  qed
qed(auto simp add: auth_restrict_def hf_valid_invert intro!: exI)

lemma ik_hfs_form: "t \<in> parts ik_hfs \<Longrightarrow> \<exists> t' . t = Hash t'"
  by(auto 3 4 simp add: auth_seg2_def dest: auth_properties)

declare ik_hfs_def[simp del]

lemma parts_ik_hfs[simp]: "parts ik_hfs = ik_hfs"
  by (auto intro!: parts_Hash ik_hfs_form)

text\<open>This lemma allows us not only to expand the definition of @{term "ik_hfs"}, but also
to obtain useful properties, such as a term being a Hash, and it being part of a valid hop field.\<close>
lemma ik_hfs_simp:
  "t \<in> ik_hfs \<longleftrightarrow> (\<exists>t' . t = Hash t') \<and> (\<exists>hf . t = HVF hf
                    \<and> (\<exists>hfs uinfo. hf \<in> set hfs \<and> (\<exists>ainfo . (ainfo, hfs) \<in> (auth_seg2 uinfo)
                    \<and> (\<exists> nxt uinfo'. hf_valid ainfo uinfo' hf nxt))))" (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume asm: "?lhs"
  then obtain ainfo uinfo hf hfs where
    dfs: "hf \<in> set hfs" "(ainfo, hfs) \<in> (auth_seg2 uinfo)" "t = HVF hf"
    by(auto simp add: ik_hfs_def)
  then have "hfs_valid_None ainfo uinfo hfs" "(ainfo, AHIS hfs) \<in> auth_seg0"
    by(auto simp add: auth_seg2_def)
  then show "?rhs" using asm dfs by(fast intro: ik_hfs_form)
qed(auto simp add: ik_hfs_def)

text\<open>The following lemma is one of the conditions. We already prove it here, since it is helpful
elsewhere. \<close>
lemma auth_restrict_upd:
      "auth_restrict ainfo uinfo (x#y#hfs)
   \<Longrightarrow> auth_restrict ainfo (upd_uinfo uinfo y) (y#hfs)"
  by (auto simp add: auth_restrict_def)

text\<open>We now show that @{text "ik_uinfo"} is redundant, since all of its terms are already contained in
@{text "ik_hfs"}. To this end, we first show that a term contained in the uinfo field of an authorized
paths is also contained in the HVF of the same path.\<close>
lemma uinfo_contained_in_HVF:
  assumes "t \<in> fset uinfo" "(ainfo, hfs) \<in> (auth_seg2 uinfo)"
  shows "\<exists>hf. t = HVF hf \<and> hf \<in> set hfs"
proof-
  from assms(2) have hfs_defs: "hfs_valid_None ainfo uinfo hfs" "auth_restrict ainfo uinfo hfs"
    by(auto simp add: auth_seg2_def)
  obtain nxt::"SCION_HF option" where nxt_None[intro]: "nxt = None" by simp
  then show ?thesis using hfs_defs assms(1)
  proof(induction uinfo hfs nxt rule: TWu.holds.induct[where ?upd=upd_uinfo])
    case (1 info x y ys nxt)
    then have hf_valid_x: "hf_valid ainfo info x (Some y)" by(auto simp only: TWu.holds.simps)
    from 1(2-3,5) show ?case
    proof(cases "t = HVF y")
      case False
      then have "t \<in> fset (upd_uinfo info y)" using 1(2,5) by (simp add: xor_singleton(1))
      moreover have "hfs_valid_None ainfo (upd_uinfo info y) (y # ys)"
                    "auth_restrict ainfo (upd_uinfo info y) (y # ys)"
        using 1(3-4) by(auto simp only: TWu.holds.simps elim: auth_restrict_upd)
      ultimately have "\<exists>hf. t = HVF hf \<and> hf \<in> set (y # ys)" using 1(1) "1.prems"(1) by blast
      then show ?thesis by auto
    qed(auto)
  next
    case (2 info x nxt)
    then show ?case
      apply(auto simp only: TWu.holds.simps auth_restrict_def)
      by (auto simp add: hf_valid_invert)
  next
    case (3 info nxt)
    then show ?case by(auto simp add: auth_restrict_def)
  qed
qed

text\<open>The following lemma allows us to ignore @{text "ik_uinfo"} when we unfold @{text "ik"}.\<close>
lemma ik_uinfo_in_ik_hfs: "t \<in> ik_uinfo \<Longrightarrow> t \<in> ik_hfs"
  by(auto simp add: ik_hfs_def dest!: uinfo_contained_in_HVF)

(******************************************************************************)
subsubsection \<open>Properties of Intruder Knowledge\<close>
(******************************************************************************)
lemma auth_ainfo[dest]: "\<lbrakk>(ainfo, hfs) \<in> (auth_seg2 uinfo)\<rbrakk> \<Longrightarrow> \<exists> ts . ainfo = Num ts"
  by(auto simp add: auth_seg2_def auth_restrict_def)

text\<open>This lemma unfolds the definition of the intruder knowledge but also already applies some
simplifications, such as ignoring @{text "ik_uinfo"}.\<close>
lemma ik_simpler:
  "ik = ik_hfs
      \<union> {term_ainfo ainfo | ainfo hfs uinfo. (ainfo, hfs) \<in> (auth_seg2 uinfo)}
      \<union> Key`(macK`bad)"
  by(auto simp add: ik_def simp del: ik_uinfo_def dest: ik_uinfo_in_ik_hfs)

  text \<open>There are no ciphertexts (or signatures) in @{term "parts ik"}. Thus, @{term "analz ik"}
and @{term "parts ik"} are identical.\<close>
lemma analz_parts_ik[simp]: "analz ik = parts ik"
  by(rule no_crypt_analz_is_parts)
    (auto simp add: ik_simpler auth_seg2_def ik_hfs_simp auth_restrict_def)

lemma parts_ik[simp]: "parts ik = ik"
  by(auto 3 4 simp add: ik_simpler auth_seg2_def auth_restrict_def)

lemma key_ik_bad: "Key (macK asid) \<in> ik \<Longrightarrow> asid \<in> bad"
  by(auto simp add: ik_simpler)
    (auto 3 4 simp add: auth_seg2_def ik_hfs_simp hf_valid_invert)

lemma MAC_synth_helper:
  assumes "hf_valid ainfo uinfo m z" "HVF m = Mac[Key (macK asid)] j" "HVF m \<in> ik"
  shows "\<exists>hfs. m \<in> set hfs \<and> (\<exists>uinfo'. (ainfo, hfs) \<in> auth_seg2 uinfo')"
proof-
  from assms(2-3) obtain ainfo' uinfo' uinfo'' m' hfs' nxt' where dfs:
    "m' \<in> set hfs'" "(ainfo', hfs') \<in> auth_seg2 uinfo''" "hf_valid ainfo' uinfo' m' nxt'"
    "HVF m = HVF m'"
    by(auto simp add: ik_simpler ik_hfs_simp)
  then have eqs[simp]: "ainfo' = ainfo" "m' = m" using assms(1) by(auto elim!: info_hvf)
  have "auth_restrict ainfo' uinfo'' hfs'" using dfs by(auto simp add: auth_seg2_def)
  then show ?thesis using dfs assms by auto
qed

text\<open>This definition helps with the limiting the number of cases generated. We don't require it,
but it is convenient. Given a hop validation field and an asid, return if the hvf has the expected
format.\<close>
definition mac_format :: "msgterm \<Rightarrow> as \<Rightarrow> bool" where
  "mac_format m asid \<equiv> \<exists> j . m = Mac[macKey asid] j"

text\<open>If a valid hop field is derivable by the attacker, but does not belong to the attacker, then
the hop field is already contained in the set of authorized segments.\<close>
lemma MAC_synth:
  assumes "hf_valid ainfo uinfo m z" "HVF m \<in> synth ik" "mac_format (HVF m) asid" "asid \<notin> bad"
  shows "\<exists>hfs. m \<in> set hfs \<and>
        (\<exists>uinfo'. (ainfo, hfs) \<in> auth_seg2 uinfo')"
  using assms
  by(auto simp add: mac_format_def ik_simpler ik_hfs_simp elim!: MAC_synth_helper dest!: key_ik_bad)

(******************************************************************************)
subsection\<open>Lemmas helping with conditions relating to extract\<close>
(******************************************************************************)
text\<open>Resolve the definite descriptor operator THE.\<close>
lemma THE_nextmac:
  assumes "hvf = Mac[macKey askey] (L [Num ts, upif, downif, FS (xor info {|hvf|})])"
    shows "(THE nextmac. \<exists>asid' upif' downif'.
                nextmac = Mac[macKey asid'] (L [Num ts, upif', downif', FS (xor info {|nextmac|})]))
          = hvf"
  apply(rule theI2[of _ hvf])
  using assms
  by(auto elim!: FS_update_eq[of _ _ info "hvf"])

lemma hf_valid_uinfo:
  assumes "hf_valid ainfo (upd_uinfo uinfo y) y nxt" "hvfy = HVF y"
  shows "hvfy \<in> fset uinfo"
  apply (cases y)
  using assms by(auto simp add: hf_valid_invert elim!: FS_contains_elem)

text\<open>A single step of extract. Extract on a single valid hop field is equivalent to that hop field's
hop info field concat extract on the next hop field, where the next hop field has to be valid
with uinfo updated.\<close>
lemma extr_hf_valid:
  assumes "hf_valid ainfo uinfo x nxt" "hf_valid ainfo (upd_uinfo uinfo y) y nxt'"
  shows "extr (HVF x) = AHI x # extr (HVF y)"
proof-
  obtain uinfo' where info'_def: "uinfo' = xor uinfo {|HVF y|}" by simp
  obtain ts ahi upif downif hvfx ahi' upif' downif' hvfy where unfolded_defs:
    "x = \<lparr>AHI = ahi, UHI = (), HVF = hvfx\<rparr>"
    "ASIF (UpIF ahi) upif"
    "ASIF (DownIF ahi) downif"
    "hvfx = Mac[macKey (ASID ahi)] (L [Num ts, upif, downif, FS uinfo])"
    "y = \<lparr>AHI = ahi', UHI = (), HVF = hvfy\<rparr>"
    "ASIF (UpIF ahi') upif'"
    "ASIF (DownIF ahi') downif'"
    "hvfy = Mac[macKey (ASID ahi')] (L [Num ts, upif', downif', FS (uinfo')])"
    using assms apply(auto simp only: hf_valid_invert) by (auto simp add: info'_def)
  have hvfy_in_uinfo: "hvfy \<in> fset uinfo"
    using assms(2) apply(auto intro!: hf_valid_uinfo) using unfolded_defs by simp
  then obtain fcard_uinfo_minus1 where "fcard uinfo = Suc fcard_uinfo_minus1"
    by (metis fcard_Suc_fminus1 notin_fset)
  then show ?thesis
    apply(cases y)
    using unfolded_defs(1-7) apply (auto intro!: ahi_eq)
    subgoal for nextmac (*difficult case*)
      apply(auto simp add: THE_nextmac dest!: FS_update_eq[of "nextmac" _
             _ "hvfy" "(\<lambda>x. Mac[macKey (ASID ahi')] (L [Num ts, upif', downif', x]))"])
      using unfolded_defs(8) info'_def by fastforce+
    using hvfy_in_uinfo unfolded_defs(8) info'_def
    by (fastforce dest!: fcard_Suc_fminus1[simplified] elim!: allE[of _ "HVF y"])
qed

(******************************************************************************)
subsection\<open>Direct proof goals for interpretation of @{text "dataplane_3_directed"}\<close>
(******************************************************************************)
lemma COND_honest_hf_analz:
  assumes "ASID (AHI hf) \<notin> bad" "hf_valid ainfo uinfo hf nxt" "terms_hf hf \<subseteq> synth (analz ik)"
    "no_oracle ainfo uinfo"
    shows "terms_hf hf \<subseteq> analz ik"
proof-
  let ?asid = "ASID (AHI hf)"
  from assms(3) have hf_synth_ik: "HVF hf \<in> synth ik" by auto
  from assms(2) have "mac_format (HVF hf) ?asid"
    by(auto simp add: mac_format_def hf_valid_invert)
  then obtain hfs uinfo' where
    "hf \<in> set hfs" "(ainfo, hfs) \<in> auth_seg2 uinfo'"
    using assms(1,2) hf_synth_ik by(auto dest!: MAC_synth)
  then have "HVF hf \<in> ik"
    using assms(2)
    by(auto simp add: ik_hfs_def intro!: ik_ik_hfs intro!: exI)
  then show ?thesis by auto
qed

lemma COND_terms_hf:
  assumes "hf_valid ainfo uinfo hf nxt" "terms_hf hf \<subseteq> analz ik"
      "no_oracle ainfo uinfo"
  shows "\<exists>hfs. hf \<in> set hfs \<and> (\<exists>uinfo' . (ainfo, hfs) \<in> (auth_seg2 uinfo'))"
proof-
  obtain hfs ainfo uinfo where hfs_def: "hf \<in> set hfs" "(ainfo, hfs) \<in> auth_seg2 uinfo"
    using assms
    by(simp only: analz_parts_ik parts_ik)
      (auto 3 4 simp add: hf_valid_invert ik_hfs_simp ik_simpler dest: ahi_eq)
  show ?thesis
    using hfs_def apply (auto simp add: auth_seg2_def dest!: TWu.holds_set_list)
    using hfs_def assms(1) by (auto simp add: auth_seg2_def dest: info_hvf)
qed

lemmas COND_auth_restrict_upd = auth_restrict_upd

lemma COND_extr_prefix_path:
  "\<lbrakk>hfs_valid ainfo uinfo l nxt; auth_restrict ainfo uinfo l\<rbrakk> \<Longrightarrow> prefix (extr_from_hd l) (AHIS l)"
proof(induction l nxt rule: TWu.holds.induct[where ?upd=upd_uinfo])
  case (1 info x y ys nxt)
  from 1(2-3) have hfs_valid:
                   "hfs_valid ainfo (upd_uinfo info y) (y # ys) nxt"
                   "auth_restrict ainfo (upd_uinfo info y) (y # ys)"
    by(auto simp only: TWu.holds.simps intro!: auth_restrict_upd)
  then have prefix_y: "prefix (extr_from_hd (y # ys)) (AHIS (y # ys))" by(rule 1(1))
  have "extr_from_hd (x # y # ys) = AHI x # extr_from_hd (y # ys)"
    apply(cases ys)
    using 1(2) by(auto simp only: extr_from_hd.simps TWu.holds.simps intro!: extr_hf_valid)
  then show ?case
    using prefix_y by (auto)
qed(auto simp only: TWu.holds.simps hf_valid_invert,
    auto simp add: fcard_fempty auth_restrict_def intro!: ahi_eq dest!: FS_contr)

lemma COND_path_prefix_extr:
  "prefix (AHIS (hfs_valid_prefix ainfo uinfo l nxt))
          (extr_from_hd l)"
proof(induction l nxt rule: TWu.takeW.induct[where ?Pa="hf_valid ainfo", where ?upd=upd_uinfo])
  case (2 info x xo)
  then show ?case
    apply(cases "fcard info")
    by(auto 3 4 intro!: ahi_eq simp add: fcard_fempty TWu.takeW_split_tail TWu.takeW.simps(1) hf_valid_invert)
next
  case (4 info x y xs xo)
 from 4(1) show ?case
  proof (cases "hf_valid ainfo (upd_uinfo info y) y (head xs)")
    case hf_valid_y: True
    obtain info' where info'_def: "info' = xor info {|HVF y|}" by simp
    show ?thesis
    proof(rule prefix_cons[where ?ys="extr_from_hd (y # xs)", where ?x = "AHI x"])
      show "extr_from_hd (x # y # xs) = AHI x # extr_from_hd (y # xs)"
        using hf_valid_y 4(1)
        by(auto simp del: upd_uinfo_def elim!: extr_hf_valid[rotated])
    next
      have "prefix (map AHI (hfs_valid_prefix ainfo (upd_uinfo info y) (y # xs) xo)) (extr (HVF y))"
        using 4(2) by (auto simp del: upd_uinfo_def)
      then show "prefix (AHIS (hfs_valid_prefix ainfo info (x # y # xs) xo)) (AHI x # extr (HVF y))"
        by (auto simp add: TWu.takeW_split_tail[where ?x = x] TWu.takeW.simps(1) simp del: upd_uinfo_def)
    qed(auto)
  next
    case False
    then show ?thesis
      by(auto simp add: TWu.takeW_split_tail hf_valid_invert)
        (auto simp add: fcard_fempty intro!: ahi_eq)
  qed
qed(auto simp add: TWu.takeW_split_tail TWu.takeW.simps(1))

lemma COND_hf_valid_uinfo:
  "\<lbrakk>hf_valid ainfo uinfo hf nxt; hf_valid ainfo' uinfo' hf nxt'\<rbrakk> \<Longrightarrow> uinfo' = uinfo"
  by(auto simp add: hf_valid_invert)

lemma COND_upd_uinfo_ik:
    "\<lbrakk>terms_uinfo uinfo \<subseteq> synth (analz ik); terms_hf hf \<subseteq> synth (analz ik)\<rbrakk>
    \<Longrightarrow> terms_uinfo (upd_uinfo uinfo hf) \<subseteq> synth (analz ik)"
  by fastforce

lemma COND_upd_uinfo_no_oracle:
  "no_oracle ainfo uinfo \<Longrightarrow> no_oracle ainfo (upd_uinfo uinfo fld)"
  by (auto)

(******************************************************************************)
subsection\<open>Instantiation of @{text "dataplane_3_directed"} locale\<close>
(******************************************************************************)
print_locale dataplane_3_directed
sublocale
  dataplane_3_directed _ _ _ auth_seg0 terms_uinfo terms_hf hf_valid auth_restrict extr extr_ainfo term_ainfo
            upd_uinfo ik_add
            ik_oracle no_oracle
  apply unfold_locales
  using COND_terms_hf COND_honest_hf_analz COND_extr_prefix_path
  COND_path_prefix_extr COND_hf_valid_uinfo COND_upd_uinfo_ik COND_upd_uinfo_no_oracle
  COND_auth_restrict_upd by auto

(******************************************************************************)
subsection\<open>Normalization of terms\<close>
(******************************************************************************)
text\<open>We now show that all terms that occur in reachable states are normalized, meaning that they
do not have directly nested FSets. For instance, a term @{term "FS {| FS {| Num 0 |}, Num 0 |}"} is
not normalized, whereas @{term "FS {| Hash (FS {| Num 0 |}), Num 0 |}"} is normalized.\<close>

lemma normalized_upd:
  "\<lbrakk>normalized (FS (upd_uinfo info y)); normalized (FS {| HVF y |})\<rbrakk>
  \<Longrightarrow> normalized (FS info)"
  by(auto simp add: xor_singleton)

declare normalized.Lst[intro!] normalized.FSt[intro!] normalized.Hash[intro!] normalized.MPair[intro!]

lemma auth_uinfo_normalized:
  "\<lbrakk>hfs_valid ainfo uinfo hfs nxt; auth_restrict ainfo uinfo hfs\<rbrakk> \<Longrightarrow> normalized (FS uinfo)"
proof(induction hfs nxt arbitrary: rule: TWu.holds.induct[where ?upd=upd_uinfo])
  case (1 info x y ys nxt)
  from 1 have hfs_valid: "hf_valid ainfo info x (Some y)"
                   "hfs_valid ainfo (upd_uinfo info y) (y # ys) nxt"
                   "auth_restrict ainfo (upd_uinfo info y) (y # ys)"
    by(auto simp only: TWu.holds.simps intro!: auth_restrict_upd)
  then have normalized_upd_y: "normalized (FS (upd_uinfo info y))" by (elim 1(1))
  obtain z where hfy_valid: "hf_valid ainfo (upd_uinfo info y) y z"
    using hfs_valid(2) by(auto dest: hfs_valid_first)
  obtain info_s where info_s_def[simp]: "xor info {|HVF y|} = info_s" by simp
  from normalized_upd_y show ?case
    apply(auto elim!: normalized_upd simp only:)
    using hfy_valid info_s_def normalized_upd_y
    by (auto 3 4 simp add: hf_valid_invert elim: ASIF.elims(2))
qed(auto simp only: TWu.holds.simps auth_restrict_def,
    auto simp add: hf_valid_invert)

lemma auth_normalized_hf:
  assumes "auth_restrict ainfo uinfo (pre @ hf # post)"
          "hfs_valid ainfo (upds_uinfo_shifted uinfo pre hf) (hf # post) nxt"
          "upds_uinfo_shifted uinfo pre hf = hf_uinfo"
  shows "normalized (HVF hf)"
  using assms(1-2)
  apply(auto dest!: hfs_valid_first simp add: hf_valid_invert assms(3))
  using assms(2-3)
  by(auto dest!: auth_uinfo_normalized dest: auth_restrict_app elim: ASIF.elims(2))

lemma auth_normalized:
  "\<lbrakk>hf \<in> set hfs; hfs_valid ainfo uinfo hfs nxt; auth_restrict ainfo uinfo hfs\<rbrakk>
    \<Longrightarrow> normalized (HVF hf)"
  by(auto dest: TWu.holds_intermediate_ex intro: auth_normalized_hf)

text\<open>All terms derivable by the intruder are normalized. Note that (i) the dynamic intruder knowledge
@{text "ik_dyn"} contains all terms of messages contained in the state and (ii) the dynamic intruder
knowledge remains constant. Hence this lemma suffices to show that all terms contained in @{text "int"}
and @{text "ext"} channels of reachable states are normalized as well.\<close>
lemma ik_synth_normalized: "t \<in> synth (analz ik) \<Longrightarrow> normalized t"
  by (auto, auto simp add: ik_simpler)
     (auto simp add: ik_hfs_def auth_seg2_def hfs_valid_prefix_generic_def
              elim!: auth_normalized)

end
end