(*
  This file contains the update semantics to C correspondence lemmas for word array functions
*)
theory WordArray_UpdCCorres
  imports WordArray_UAbsFun
begin

context update_sem_init begin

definition
  "abs_fun_rel \<Xi>' srel afun_name \<xi>' afun_mon \<sigma> st x x'
    = (proc_ctx_wellformed \<Xi>' \<longrightarrow> (\<xi>' matches-u \<Xi>') \<longrightarrow> (\<sigma>,st) \<in> srel \<longrightarrow>
      (\<forall>r' w'. val_rel x x'
        \<and> (\<Xi>', \<sigma> \<turnstile> x :u prod.fst (prod.snd (prod.snd (prod.snd (\<Xi>' afun_name)))) \<langle>r', w'\<rangle>)
        \<longrightarrow> \<not> prod.snd (afun_mon x' st)
            \<and> (\<forall>st' y'. (y', st') \<in> prod.fst (afun_mon x' st)
                \<longrightarrow> (\<exists>\<sigma>' y. \<xi>' afun_name (\<sigma>, x) (\<sigma>', y)
                    \<and> val_rel y y' \<and> (\<sigma>', st') \<in> srel))))"

lemma absfun_corres:
  "abs_fun_rel \<Xi>' srel s \<xi>' afun' \<sigma> st (\<gamma> ! i) v'
  \<Longrightarrow> i < length \<gamma> \<Longrightarrow> val_rel (\<gamma> ! i) v'
  \<Longrightarrow> \<Gamma>' ! i = option.Some (prod.fst (prod.snd (prod.snd (prod.snd (\<Xi>' s)))))
  \<Longrightarrow> corres srel
     (App (AFun s [] ls) (Var i))
     (do x \<leftarrow> afun' v'; gets (\<lambda>s. x) od)
     \<xi>' \<gamma> \<Xi>' \<Gamma>' \<sigma> st"
  apply (clarsimp simp: corres_def abs_fun_rel_def)
  apply (frule matches_ptrs_length, simp)
  apply (frule(2) matches_ptrs_proj_single')
  apply clarsimp
  apply (erule impE, blast)
  apply clarsimp
  apply (elim allE, drule mp, blast)
  apply clarsimp
  apply (intro exI conjI[rotated], assumption+)
  apply (rule u_sem_abs_app)
    apply (rule u_sem_afun)
   apply (rule u_sem_var)
  apply simp
  done

lemma abs_fun_rel_def':
  "abs_fun_rel \<Xi>' srel afun_name \<xi>' afun_mon \<sigma> st x x'
    = (proc_ctx_wellformed \<Xi>' \<longrightarrow> \<xi>' matches-u \<Xi>' \<longrightarrow> (\<sigma>,st) \<in> srel \<longrightarrow>
        (\<forall>r' w'. val_rel x x' \<and>
            \<Xi>', \<sigma> \<turnstile> x :u prod.fst (prod.snd (prod.snd (prod.snd (\<Xi>' afun_name)))) \<langle>r', w'\<rangle>
        \<longrightarrow> \<lbrace>\<lambda>s0. s0 = st\<rbrace>
              afun_mon x'
            \<lbrace>\<lambda>y' s'. \<exists>\<sigma>' y. \<xi>' afun_name (\<sigma>, x) (\<sigma>', y) \<and> (\<sigma>',s') \<in> srel \<and> val_rel y y'\<rbrace>!))"
  by (fastforce  simp: abs_fun_rel_def validNF_def valid_def no_fail_def)

end (* of context *)

sublocale WordArray \<subseteq> Generated _ wa_abs_typing_u wa_abs_repr
  by (unfold_locales)

context WordArray begin

section "Correspondence Lemmas Between Update Semantics and C"

lemma upd_C_wordarray_put2_corres_gen:
  "\<And>i \<gamma> v' \<Gamma>' \<sigma> st.
    \<lbrakk>i < length \<gamma>; val_rel (\<gamma> ! i) v';
    \<Gamma>' ! i = option.Some (prod.fst (prod.snd (prod.snd (prod.snd (\<Xi> ''wordarray_put2_0'')))));
     \<xi>0' ''wordarray_put2_0'' = upd_wa_put2_0\<rbrakk>
    \<Longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr
        (Generated.state_rel wa_abs_repr) (App (AFun ''wordarray_put2_0'' [] ls) (Var i))
         (do x <- main_pp_inferred.wordarray_put2_0' v';
             gets (\<lambda>s. x)
          od)
         \<xi>0' \<gamma> \<Xi> \<Gamma>' \<sigma> st"
  apply (rule absfun_corres; simp?)
  apply (thin_tac "\<Gamma>' ! i = _")
  apply (clarsimp simp: abs_fun_rel_def; rename_tac r w)
  apply (rotate_tac -1)
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) \<Xi>_def)
  apply (clarsimp simp: val_rel_simp wordarray_put2_0_type_def abbreviated_type_defs)
  apply (erule u_t_recE)
  apply (erule u_t_r_consE; clarsimp)+
  apply (erule u_t_primE)+
  apply (subst (asm) lit_type.simps)+
  apply clarsimp
  apply (erule u_t_r_emptyE)
  apply (erule u_t_ptrE; clarsimp)
  apply (frule wa_abs_typing_u_elims(1); clarsimp; rename_tac len arr)
  apply (rule conjI)
   apply (monad_eq simp: wordarray_put2_0'_def)
   apply (clarsimp simp: state_rel_def heap_rel_def)
   apply (erule_tac x = "t2_C.arr_C v'" in allE)
   apply (erule_tac x = "values_C (heap_WordArray_u32_C st (t2_C.arr_C v')) +\<^sub>p uint (t2_C.idx_C v')" in allE)
   apply (clarsimp simp: heap_rel_ptr_def heap_rel_meta_def wa_abs_repr_def is_valid_simp type_rel_simp)
   apply (frule wa_abs_typing_u_elims(5))
   apply (erule_tac x = "t2_C.idx_C v'" in allE)+
   apply (clarsimp simp: val_rel_simp heap_simp type_rel_simp)
  apply clarsimp
  apply (monad_eq simp: upd_wa_put2_0_def)
  apply (case_tac "idx_C v' < len"; clarsimp)
  apply (rule conjI)
    apply (monad_eq simp: wordarray_put2_0'_def)
   apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta)
   apply (monad_eq simp: wordarray_put2_0'_def)
   apply (frule_tac p = "t2_C.arr_C v'" in all_heap_rel_ptrD; simp?)
    apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
   apply (clarsimp simp: val_rel_simp heap_simp is_valid_simp)
   apply (drule wa_abs_typing_u_elims(5))
   apply (erule_tac x = "t2_C.idx_C v'" in allE; clarsimp)
   apply (drule_tac upd_h = "(heap_w32_update
      (\<lambda>x. x(values_C (heap_WordArray_u32_C st (t2_C.arr_C v')) +\<^sub>p uint (idx_C v') := val_C v')) st)" and
      x = "(values_C (heap_WordArray_u32_C st (t2_C.arr_C v'))) +\<^sub>p uint (idx_C v')" and
      uv' = "UPrim (LU32 (val_C v'))" and uv = "UPrim x"
      in all_heap_rel_updE; simp?; clarsimp?)
    apply (clarsimp simp: type_rel_simp)
   apply (drule_tac upd_h = "(heap_w32_update
      (\<lambda>x. x(values_C (heap_WordArray_u32_C st (t2_C.arr_C v')) +\<^sub>p uint (idx_C v') := val_C v')) st)" and
      x = "(values_C (heap_WordArray_u32_C st (t2_C.arr_C v'))) +\<^sub>p uint (idx_C v')" and
      uv' = "UPrim (LU32 (val_C v'))" and uv = "UPrim x"
      in all_heap_rel_updE; simp?; clarsimp?)
   apply (rule conjI, clarsimp simp: val_rel_simp)
   apply clarsimp
   apply (rule FalseE)
   apply (cut_tac p = p and q = "((values_C (heap_WordArray_u32_C st (t2_C.arr_C v'))) +\<^sub>p uint (idx_C v'))" in ptr_val_inj)
   apply (clarsimp simp: ptr_add_def)
  apply (monad_eq simp: wordarray_put2_0'_def)
  apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta)
  apply (frule_tac p = "t2_C.arr_C v'" in all_heap_rel_ptrD; simp?)
   apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
  apply (clarsimp simp: val_rel_simp heap_simp is_valid_simp)
  done

lemmas upd_C_wordarray_put2_corres = upd_C_wordarray_put2_corres_gen[rotated -1, of \<xi>0, simplified fun_eq_iff]

lemma upd_C_wordarray_length_corres_gen:
"\<And>i \<gamma> v' \<Gamma>' \<sigma> st.
    \<lbrakk>i < length \<gamma>; val_rel (\<gamma> ! i) v';
    \<Gamma>' ! i = option.Some (prod.fst (prod.snd (prod.snd (prod.snd (\<Xi> ''wordarray_length_0'')))));
     \<xi>0' ''wordarray_length_0''= upd_wa_length_0\<rbrakk>
    \<Longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr
         (Generated.state_rel wa_abs_repr) (App (AFun ''wordarray_length_0'' [] ls) (Var i))
         (do x <- main_pp_inferred.wordarray_length_0' v';
             gets (\<lambda>s. x)
          od)
         \<xi>0' \<gamma> \<Xi> \<Gamma>' \<sigma> st"
  apply (rule absfun_corres; simp?)
  apply (clarsimp simp: abs_fun_rel_def; rename_tac r w)
  apply (thin_tac "\<Gamma>' ! i = _")
  apply (rotate_tac -1)
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) \<Xi>_def)
  apply (clarsimp simp: val_rel_simp wordarray_length_0_type_def)
  apply (erule u_t_ptrE; clarsimp)
  apply (frule wa_abs_typing_u_elims(1); clarsimp; rename_tac len arr)
  apply (rule conjI)
   apply (monad_eq simp: wordarray_length_0'_def)
   apply (clarsimp simp: state_rel_def heap_rel_def)
   apply (erule_tac x = v' in allE)
   apply (clarsimp simp: heap_rel_ptr_def type_rel_simp wa_abs_repr_def is_valid_simp)
  apply clarsimp
  apply (rule_tac x = \<sigma> in exI)
  apply (rule conjI)
   apply (clarsimp simp: upd_wa_length_0_def)
   apply (monad_eq simp: wordarray_length_0'_def)
   apply (clarsimp simp: state_rel_def heap_rel_def)
   apply (erule_tac x = v' in allE)
   apply (clarsimp simp: heap_rel_ptr_def type_rel_simp wa_abs_repr_def heap_simp val_rel_simp)
  apply (monad_eq simp: wordarray_length_0'_def)
  done

lemmas upd_C_wordarray_length_corres = upd_C_wordarray_length_corres_gen[rotated -1, of \<xi>0, simplified fun_eq_iff]

lemma upd_C_wordarray_get_corres_gen:
"\<And>i \<gamma> v' \<Gamma>' \<sigma> st.
    \<lbrakk>i < length \<gamma>; val_rel (\<gamma> ! i) v';
     \<Gamma>' ! i = option.Some (prod.fst (prod.snd (prod.snd (prod.snd (\<Xi> ''wordarray_get_0'')))));
     \<xi>0' ''wordarray_get_0'' = upd_wa_get_0\<rbrakk>
    \<Longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr
         (Generated.state_rel wa_abs_repr) (App (AFun ''wordarray_get_0'' [] ls) (Var i))
         (do x <- main_pp_inferred.wordarray_get_0' v';
             gets (\<lambda>s. x)
          od)
         \<xi>0' \<gamma> \<Xi> \<Gamma>' \<sigma> st"
  apply (rule absfun_corres; simp?)
  apply (clarsimp simp: abs_fun_rel_def; rename_tac r w)
  apply (thin_tac "\<Gamma>' ! i = _")
  apply (rotate_tac -1)
  apply (subst (asm) \<Xi>_def)
  apply (subst (asm) \<Xi>_def)
  apply (clarsimp simp: val_rel_simp wordarray_get_0_type_def abbreviated_type_defs)
  apply (erule u_t_recE)
  apply (erule u_t_r_consE; clarsimp)+
  apply (erule u_t_r_emptyE)
  apply (erule u_t_primE; subst (asm) lit_type.simps; clarsimp)
  apply (erule u_t_ptrE; clarsimp)
  apply (frule wa_abs_typing_u_elims(1); clarsimp; rename_tac len arr)
  apply (rule conjI)
   apply (monad_eq simp: wordarray_get_0'_def)
   apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta)
   apply (drule_tac p = "t1_C.p1_C v'" and uv = "UAbstract (UWA (TPrim (Num U32)) len arr)" in all_heap_rel_ptrD;
          clarsimp simp: type_rel_simp wa_abs_repr_def val_rel_simp is_valid_simp heap_simp)
   apply (drule not_le_imp_less)
   apply (frule wa_abs_typing_u_elims(5))
   apply (erule_tac x = "t1_C.p2_C v'" in allE; clarsimp)
   apply (drule_tac p = "values_C (heap_WordArray_u32_C st (t1_C.p1_C v')) +\<^sub>p uint (t1_C.p2_C v')" and
                   uv = "UPrim x" in all_heap_rel_ptrD; simp add: type_rel_simp)
  apply clarsimp
  apply (rule_tac x = \<sigma> in exI)
  apply (rule conjI)
   apply (clarsimp simp: upd_wa_get_0_def)
   apply (frule wa_abs_typing_u_elims(5))
   apply (erule_tac x = "t1_C.p2_C v'" in allE)
   apply (monad_eq simp: wordarray_get_0'_def word_less_nat_alt word_le_nat_alt)
   apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta)
   apply (drule_tac p = "t1_C.p1_C v'" and uv = "UAbstract (UWA (TPrim (Num U32)) len arr)" in all_heap_rel_ptrD;
          clarsimp simp: type_rel_simp wa_abs_repr_def val_rel_simp is_valid_simp heap_simp)
   apply (drule_tac p = "values_C (heap_WordArray_u32_C st (t1_C.p1_C v')) +\<^sub>p uint (t1_C.p2_C v')" and
                   uv = "UPrim x" in all_heap_rel_ptrD;
          clarsimp simp: type_rel_simp val_rel_simp)
  apply (monad_eq simp: wordarray_get_0'_def)
  apply blast
  done

lemmas upd_C_wordarray_get_corres = upd_C_wordarray_get_corres_gen[rotated -1, of \<xi>0, simplified fun_eq_iff]

abbreviation "mk_urecord xs \<equiv> URecord (map (\<lambda>x. (x, uval_repr x)) xs) None"
definition "foldmap_measure i end \<equiv> unat end - unat i"
definition "foldmap_bounds frm to len i e
  \<equiv> frm \<le> i \<and> e = min to len \<and> (frm < e \<longrightarrow> i \<le> e) \<and> ((\<not>(frm < e)) \<longrightarrow> frm = i)"
definition "foldmap_inv foldmap n \<xi>' \<sigma> p frm i f acc obsv \<sigma>' res s' res'
  \<equiv> foldmap \<xi>' \<sigma> p frm i f (foldmap_acc_type n) acc (foldmap_obsv_type n) obsv (\<sigma>', res) \<and>
      val_rel res res' \<and> (\<sigma>', s') \<in> state_rel"
definition "foldmap_inv_stat obsv obsv' \<equiv> val_rel obsv obsv'"

lemma whileLoop_add_invI:
  assumes "\<lbrace> P \<rbrace> whileLoop_inv c b init I (measure M) \<lbrace> Q \<rbrace>!"
  shows "\<lbrace> P \<rbrace> whileLoop c b init \<lbrace> Q \<rbrace>!"
  by (metis assms whileLoop_inv_def)

lemma validNF_select_UNIV:
  "\<lbrace>\<lambda>s. \<forall>x. Q x s\<rbrace> select UNIV \<lbrace>Q\<rbrace>!"
  apply (subst select_UNIV_unknown)
  apply (rule validNF_unknown)
  done

lemma \<Xi>_wordarray_fold_no_break_0:
  "\<Xi> ''wordarray_fold_no_break_0'' = wordarray_fold_no_break_0_type"
  by (clarsimp simp: \<Xi>_def)

abbreviation "elem_type x \<equiv> (present_type \<circ> (\<lambda>xs. xs ! 0) \<circ> rec_type_list) x"

lemma fold_dispatch_wp:
  "\<lbrakk>proc_ctx_wellformed \<Xi>; proc_env_matches_ptrs \<xi>0' \<Xi>;
    wa_abs_typing_u \<Xi> (UWA (TPrim (Num num)) len arr) ''WordArray'' [TPrim (Num num)] (Boxed ReadOnly ptrl) r w \<sigma>;
    \<sigma> p = option.Some (UAbstract (UWA (TPrim (Num num)) len arr));
    uval_typing \<Xi> \<sigma> acc (foldmap_acc_type ''wordarray_fold_no_break_0'') ra wa;
    uval_typing \<Xi> \<sigma> obsv (foldmap_obsv_type ''wordarray_fold_no_break_0'') ro {};
    wa \<inter> r = {}; wa \<inter> ro = {}; p \<notin> wa;
    (\<Xi>, 0, [], {}, [option.Some (foldmap_funarg_type ''wordarray_fold_no_break_0'')] \<turnstile>
    (App f (Var 0)) : (foldmap_funret_type ''wordarray_fold_no_break_0''));
    \<forall>x x' \<sigma> s. val_rel x x' \<longrightarrow>
      update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
        (App f (Var 0)) (do ret <- dispatch f_num x'; gets (\<lambda>s. ret) od)
        \<xi>0' [x] \<Xi> [option.Some (foldmap_funarg_type ''wordarray_fold_no_break_0'')] \<sigma> s;
    elem_type (foldmap_funarg_type ''wordarray_fold_no_break_0'') = TPrim (Num num)\<rbrakk> \<Longrightarrow>
    \<lbrace>\<lambda>sa. (a', n') = (a, n) \<and> n < e \<and>
      (\<exists>\<sigma>' res x v. args = t3_C.elem_C_update (\<lambda>_. v) a \<and>
        \<sigma>' (arr + size_of_num_type num * n) = option.Some x \<and> val_rel x v \<and>
      foldmap_inv upd_wa_foldnb_bod ''wordarray_fold_no_break_0'' \<xi>0' \<sigma> p frm n f acc obsv \<sigma>' res sa (t3_C.acc_C args)) \<and>
      foldmap_bounds frm to len n e \<and> foldmap_inv_stat obsv (t3_C.obsv_C args)\<rbrace>
      dispatch f_num args
    \<lbrace>\<lambda>ret sb. (\<exists>\<sigma>' res.
        foldmap_inv upd_wa_foldnb_bod ''wordarray_fold_no_break_0'' \<xi>0' \<sigma> p frm (n + 1) f acc obsv \<sigma>' res sb ret) \<and>
      foldmap_inv_stat obsv (t3_C.obsv_C args) \<and> foldmap_bounds frm to len (n + 1) e \<and>
      foldmap_measure (n + 1) to < foldmap_measure n' to\<rbrace>!"
  apply (subst validNF_def)
  apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)
  apply (subst valid_def)
  apply (subst no_fail_def)
  apply clarsimp
  apply (subst all_imp_conj_distrib[symmetric])
  apply (clarsimp simp: foldmap_inv_def)
  apply (rename_tac sa \<sigma>' res x v)
  apply (erule_tac x = "mk_urecord [x, res, obsv]" in allE)
  apply (erule_tac x = args in allE)
  apply (erule impE)
   apply (subst val_rel_simp; simp add: foldmap_inv_stat_def)
  apply (erule_tac x = \<sigma>' in allE)
  apply (erule_tac x = sa in allE)
  apply (clarsimp simp: corres_def)
  apply (frule_tac t = "TPrim (Num num)" and
      ptrl = ptrl and
      ra = r and
      wa = w and
      rb = ra and
      wb = wa and
      rc = ro in upd_wa_foldnb_bod_preservation[rotated -1];
      (simp add: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)?;
      (clarsimp simp: Int_commute)?)
      apply (frule wa_abs_typing_u_elims(2); clarsimp)
     apply (frule wa_abs_typing_u_elims(2); clarsimp)
    apply (frule wa_abs_typing_u_elims(2); clarsimp)
   apply (frule wa_abs_typing_u_elims(2); clarsimp)
  apply (rename_tac r' w')
  apply (subgoal_tac "matches_ptrs \<Xi> \<sigma>' [(mk_urecord [x, res, obsv])]
      [option.Some (foldmap_funarg_type ''wordarray_fold_no_break_0'')] (r' \<union> ro) w'")
   apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)
   apply (erule impE, blast)
   apply clarsimp
   apply (rename_tac ret sb)
   apply (erule_tac x = ret in allE)
   apply (erule_tac x = sb in allE)
   apply clarsimp
   apply (frule update_sem.preservation
                  [OF update_sem_axioms, where \<tau>s = "[]" and \<epsilon>="[]"and K = "[]" and L=0 and C="{}",
                   simplified subst_wellformed_nothing, simplified]; simp?)
    apply clarsimp
   apply (rename_tac \<sigma>'' res' rb wb)
   apply (clarsimp simp: foldmap_bounds_def)
   apply (case_tac "frm < to \<and> frm < len"; clarsimp)
   apply (frule wa_abs_typing_u_elims(5))
   apply (erule_tac x = n in allE; clarsimp)
   apply (frule_tac p = "arr + (size_of_num_type num) * n" in valid_ptr_not_in_frame_same; simp?)
    apply (drule_tac x = "arr + 4 * n" and S = r in orthD1; simp?)
    apply (drule_tac wa_abs_typing_u_elims(2)[where \<tau>s = "[_]", simplified]; simp)
    apply blast
   apply clarsimp
   apply (drule_tac ta = num and
      arr = arr and
      len = len and
      res' = res' and
      \<sigma>' = \<sigma>' and
      \<sigma>'' = \<sigma>'' and
      ptrl = ptrl and
      ra = r and
      wa = w and
      rc = ro in upd_wa_foldnb_bod_step[rotated -5]; simp?; clarsimp?)
        apply (drule_tac v = obsv in type_repr_uval_repr(1); simp)
        apply (drule_tac v = res in type_repr_uval_repr(1); simp)
       apply (drule wa_abs_typing_u_elims(2); clarsimp)
      apply (drule wa_abs_typing_u_elims(2); clarsimp)
     apply (drule wa_abs_typing_u_elims(2); clarsimp)
    apply (drule wa_abs_typing_u_elims(2); clarsimp)
   apply (rule conjI)
    apply (intro exI conjI; simp)
   apply (frule_tac a = n and k = to in less_is_non_zero_p1)
   apply (drule unatSuc2; clarsimp simp: word_less_nat_alt word_le_nat_alt foldmap_measure_def)
   apply linarith
  apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)
  apply (rule matches_ptrs_some[where r' = "{}" and w' = "{}", simplified])
   apply (rule u_t_struct; simp?)
   apply (rule u_t_r_cons1[where r = "{}" and w = "{}", simplified]; simp?)
     apply (subst (asm) val_rel_word; clarsimp)
     apply (rule u_t_prim'; clarsimp)
    apply (rule u_t_r_cons1[where r' = ro and w' = "{}", simplified]; simp?)
      apply (drule_tac u = obsv in uval_typing_frame(1); simp?)
      apply (rule u_t_r_cons1[where r' = "{}" and w' = "{}", simplified]; simp?)
       apply (rule u_t_r_empty)
      apply (drule_tac v = obsv in type_repr_uval_repr(1); simp)
     apply (drule_tac v = obsv in frame_noalias_uval_typing(2)[rotated 1]; simp?)
     apply blast
    apply (drule_tac v = res in type_repr_uval_repr(1); simp)
  apply (subst (asm) val_rel_word; clarsimp)
  apply (rule matches_ptrs_empty[where \<tau>s = "[]" and \<epsilon> = "[]", simplified])
  done

lemma upd_C_wordarray_fold_no_break_corres_gen:
  "\<lbrakk>proc_env_matches_ptrs \<xi>0' \<Xi>; i < length \<gamma>; val_rel (\<gamma> ! i) v';
    \<Gamma>' ! i = option.Some (prod.fst (prod.snd (prod.snd(prod.snd (\<Xi> ''wordarray_fold_no_break_0'')))));
    D \<in> k \<or> S \<in> k; 0, K',{} \<turnstile> (foldmap_obsv_type ''wordarray_fold_no_break_0'') :\<kappa> k;
    \<gamma> ! i = URecord fs None; f = prod.fst (fs ! 3);
    (\<Xi>, 0, [], {}, [option.Some (foldmap_funarg_type ''wordarray_fold_no_break_0'')] \<turnstile>
    (App (uvalfun_to_exprfun f) (Var 0)) : (foldmap_funret_type ''wordarray_fold_no_break_0''));
    \<forall>x x' \<sigma> s. val_rel x x' \<longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
      (App (uvalfun_to_exprfun f) (Var 0)) (do ret <- dispatch_t4' (t5_C.f_C v') x'; gets (\<lambda>s. ret) od)
      \<xi>0' [x] \<Xi> [option.Some (foldmap_funarg_type ''wordarray_fold_no_break_0'')] \<sigma> s;
    \<xi>1' ''wordarray_fold_no_break_0'' = upd_wa_foldnb \<Xi> \<xi>0' (foldmap_funarg_type ''wordarray_fold_no_break_0'');
    elem_type (foldmap_funarg_type ''wordarray_fold_no_break_0'') = TPrim (Num num)\<rbrakk>
    \<Longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
         (App (AFun ''wordarray_fold_no_break_0'' [] []) (Var i)) (do x <- main_pp_inferred.wordarray_fold_no_break_0' v';
gets (\<lambda>s. x)
                                                                od)
         \<xi>1' \<gamma> \<Xi>  \<Gamma>' \<sigma> s"
  apply (rule absfun_corres; simp)
  apply (clarsimp simp: abs_fun_rel_def'; rename_tac r w)
  apply (thin_tac "\<Gamma>' ! i = _")
  apply (subst (asm) val_rel_simp; clarsimp)
  apply (subst (asm) val_rel_ptr_def; clarsimp)
  apply (subst (asm) val_rel_fun_tag)
  apply (subst (asm) val_rel_word)
  apply (subst (asm) val_rel_word)
  apply (clarsimp simp: upd_wa_foldnb_def wordarray_fold_no_break_0'_def)
  apply (rename_tac pwa_rep frm_rep to_rep f_rep acc a_rep obsv o_rep wa_rep)
  apply (erule u_t_recE; clarsimp)
  apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)
  apply (erule u_t_r_consE; clarsimp)
  apply (erule u_t_ptrE; clarsimp)
  apply (frule wa_abs_typing_u_elims(1); clarsimp)
  apply (rename_tac r len arr)
  apply (erule u_t_r_consE; simp)
  apply (erule u_t_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)+
  apply clarsimp
  apply (erule u_t_primE)+
  apply (drule_tac t = "lit_type _" in sym)+
  apply clarsimp
  apply (erule u_t_r_consE; clarsimp)+
  apply (erule u_t_r_emptyE; clarsimp)
  apply (frule tfun_no_pointers(1))
  apply (frule tfun_no_pointers(2))
  apply clarsimp
  apply (rename_tac acc ra wa obsv ro wo)
  apply (drule discardable_or_shareable_not_writable; simp?)
  apply clarsimp
  apply (subst unknown_bind_ignore)+
  apply (clarsimp simp: join_guards)
  apply wp
      apply (clarsimp simp: unknown_bind_ignore split: prod.split)
      apply (rename_tac var e)
      apply (rule_tac M = "\<lambda>((_, i), _). foldmap_measure i (t5_C.to_C v')" and
      I = "\<lambda>(a, b) s. (\<exists>\<sigma>' res.
          foldmap_inv upd_wa_foldnb_bod ''wordarray_fold_no_break_0'' \<xi>0' \<sigma> (ptr_val (t5_C.arr_C v'))
          (t5_C.frm_C v') b (uvalfun_to_exprfun f) acc obsv \<sigma>' res s (t3_C.acc_C a)) \<and>
          foldmap_inv_stat obsv (t3_C.obsv_C a) \<and>
          foldmap_bounds (t5_C.frm_C v') (t5_C.to_C v') len b e" in whileLoop_add_invI; simp?)
      apply (wp; clarsimp simp: unknown_bind_ignore split: prod.splits)
          apply (rename_tac sa a n args a' n')
          apply (rule_tac a = a and wa = wa and ra = ra and ro = ro and w = "{}" and r = r and
            ptrl = None in fold_dispatch_wp[rotated 2]; simp?)
             apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)+
         apply wp
        apply wp
       apply clarsimp
       apply (rename_tac args j \<sigma>' res)
       apply (clarsimp simp: foldmap_bounds_def foldmap_inv_def)
       apply (frule wa_abs_typing_u_elims(5))
       apply (erule_tac x = j in allE; clarsimp)
       apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)
       apply (drule_tac acc = acc and
      obsv = obsv and
      rb = ra and
      wb = wa and
      rc = ro and
      ptrl = None and
      ra = r and
      wa = "{}" in upd_wa_foldnb_bod_preservation; simp?; (clarsimp simp: Int_commute)?)
       apply (frule_tac p = "ptr_val (t5_C.arr_C v')" in valid_ptr_not_in_frame_same; simp?)
       apply (drule_tac p = "arr + (size_of_num_type num) * j" in valid_ptr_not_in_frame_same; simp?)
        apply (drule_tac x = "arr + (size_of_num_type num) * j" and S' = wa and S = r in orthD1; simp?)
        apply (drule wa_abs_typing_u_elims(2); clarsimp)
        apply blast
       apply (thin_tac "_ \<in> state_rel")
       apply (rule conjI)
        apply (rule_tac x = \<sigma>' in exI)
        apply (rule_tac x = res in exI)
        apply (rule_tac x = "UPrim x" in exI)
        apply clarsimp
        apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta)
        apply (rotate_tac -1)
        apply (drule_tac p = "Ptr(arr + (size_of_num_type num) * j)" in all_heap_rel_ptrD; simp?)
         apply (clarsimp simp: type_rel_simp)
        apply (rule_tac x = "heap_w32 s (PTR(32 word) (arr + (size_of_num_type num) * j))" in exI)
        apply (drule_tac p = "t5_C.arr_C v'" in all_heap_rel_ptrD; simp?)
         apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
        apply (clarsimp simp: val_rel_WordArray_u32_C_def ptr_add_def heap_simp mult.commute)
       apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta)
       apply (rotate_tac -1)
       apply (drule_tac p = "Ptr(arr + (size_of_num_type num) * j)" in all_heap_rel_ptrD; simp?)
        apply (clarsimp simp: type_rel_simp)
       apply (drule_tac p = "t5_C.arr_C v'" in all_heap_rel_ptrD; simp?)
        apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
       apply (clarsimp simp: is_valid_simp heap_simp val_rel_WordArray_u32_C_def ptr_add_def mult.commute)
      apply (rule conjI)
       apply (erule u_t_funafuntE; clarsimp)
      apply (rename_tac x' j \<sigma>' res)
      apply (rule_tac x = \<sigma>' in exI)
      apply (rule_tac x = res in exI)
      apply (clarsimp simp: foldmap_inv_def)
      apply (clarsimp simp: \<Xi>_wordarray_fold_no_break_0 wordarray_fold_no_break_0_type_def abbreviated_type_defs)
      apply (unfold foldmap_bounds_def)
      apply (erule conjE)+
      apply (case_tac "t5_C.frm_C v' < e")
       apply (erule impE, assumption)
       apply (thin_tac "_ \<longrightarrow> _")
       apply clarsimp
       apply (case_tac "j < t5_C.to_C v'"; clarsimp)
       apply (rule_tac ptrl = None and
      ra = r and
      wa = "{}" and
      rb = ra and
      wb = wa and
      rc = ro in upd_wa_foldnb_bod_to_geq_len; (simp add: Int_commute)?; clarsimp?)
      apply (erule impE, assumption)
      apply (thin_tac "_ \<longrightarrow> _")
      apply clarsimp
      apply (erule upd_wa_foldnb_bod.elims; clarsimp)
      apply (case_tac "t5_C.frm_C v' < t5_C.to_C v'"; subst upd_wa_foldnb_bod.simps; clarsimp)
     apply wp
    apply wp
   apply (rule validNF_select_UNIV)
  apply (clarsimp simp: foldmap_inv_stat_def)
  apply (clarsimp simp: order.strict_implies_order)
  apply (clarsimp simp: foldmap_inv_def state_rel_def heap_rel_def heap_rel_ptr_meta)
  apply (frule_tac p = "t5_C.arr_C v'" in all_heap_rel_ptrD; simp?)
   apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
  apply (clarsimp simp: is_valid_simp val_rel_WordArray_u32_C_def heap_simp)
  apply (subst upd_wa_foldnb_bod.simps; clarsimp)+
  apply (rule conjI; clarsimp)
   apply (subst min_def)
   apply (subst (asm) not_le[symmetric])+
   apply (subst if_not_P; simp?)
  apply (subst min_def)
  apply (clarsimp simp: not_le)
  done

lemma \<Xi>_wordarray_map_no_break_0:
  "\<Xi> ''wordarray_map_no_break_0'' = wordarray_map_no_break_0_type"
  by (clarsimp simp: \<Xi>_def)

lemma map_dispatch_wp:
  "\<lbrakk>proc_ctx_wellformed \<Xi>; proc_env_matches_ptrs \<xi>0' \<Xi>;
    wa_abs_typing_u \<Xi> (UWA (TPrim (Num num)) len arr) ''WordArray'' [TPrim (Num num)] (Boxed Writable ptrl) r w \<sigma>;
    \<sigma> p = option.Some (UAbstract (UWA (TPrim (Num num)) len arr));
    uval_typing \<Xi> \<sigma> acc (foldmap_acc_type ''wordarray_map_no_break_0'') ra wa;
    uval_typing \<Xi> \<sigma> obsv (foldmap_obsv_type ''wordarray_map_no_break_0'') ro {}; wa \<inter> r = {}; p \<notin> w;
    p \<notin> r; w \<inter> wa = {}; w \<inter> (ra \<union> ro) = {}; wa \<inter> ro = {}; p \<notin> wa; p \<notin> ra; p \<notin> ro; p = ptr_val p';
    (\<Xi>, 0, [], {}, [option.Some (foldmap_funarg_type ''wordarray_map_no_break_0'')] \<turnstile>
    (App f (Var 0)) : (foldmap_funret_type ''wordarray_map_no_break_0''));
    \<forall>x x' \<sigma> s. val_rel x x' \<longrightarrow>
      update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
        (App f (Var 0)) (do ret <- dispatch f_num x'; gets (\<lambda>s. ret) od)
        \<xi>0' [x] \<Xi> [option.Some (foldmap_funarg_type ''wordarray_map_no_break_0'')] \<sigma> s;
     elem_type (foldmap_funarg_type ''wordarray_map_no_break_0'') = TPrim (Num num)\<rbrakk> \<Longrightarrow>
    \<lbrace>\<lambda>sa. (a', n') = (a, n) \<and> n < e \<and>
      (\<exists>\<sigma>' res x v. args = t6_C.elem_C_update (\<lambda>_. v) a \<and>
        \<sigma>' (arr + size_of_num_type U32 * n) = option.Some x \<and> val_rel x v \<and>
      foldmap_inv upd_wa_mapAccumnb_bod ''wordarray_map_no_break_0'' \<xi>0' \<sigma> p frm n f acc obsv \<sigma>'
        res sa (t10_C p' (t6_C.acc_C args))) \<and>
      foldmap_bounds frm to len n e \<and> foldmap_inv_stat obsv (t6_C.obsv_C args)\<rbrace>
      dispatch f_num args
     \<lbrace>\<lambda>ret sb. (\<exists>\<sigma>' res.
        foldmap_inv upd_wa_mapAccumnb_bod ''wordarray_map_no_break_0'' \<xi>0' \<sigma> p frm (n + 1) f acc obsv \<sigma>' res
          (heap_w32_update (\<lambda>x a. if a = values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n
            then t7_C.p1_C ret else x a) sb) (t10_C p' (t7_C.p2_C ret))) \<and>
        foldmap_inv_stat obsv (t6_C.obsv_C args) \<and>
        foldmap_bounds frm to len (n + 1) e \<and>
        foldmap_measure (n + 1) to < foldmap_measure n' to \<and>
        is_valid_WordArray_u32_C sb p' \<and>
        is_valid_w32 sb (values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n)\<rbrace>!"
  apply (subst validNF_def)
  apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (subst valid_def)
  apply (subst no_fail_def)
  apply clarsimp
  apply (subst all_imp_conj_distrib[symmetric])
  apply (clarsimp simp: foldmap_inv_def)
  apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (rename_tac sa \<sigma>' res x v)
  apply (subst (asm) Int_Un_distrib; clarsimp)
  apply (frule_tac t = "TPrim (Num num)" and
      ra = r and
      wa = w and
      rb = ra and
      wb = wa and
      rc = ro in upd_wa_mapAccumnb_bod_preservation; simp?; (clarsimp simp: Int_commute)?)
  apply (rename_tac sa \<sigma>' x v racc r' w')
  apply (erule_tac x = "mk_urecord [x, racc, obsv]" in allE)
  apply (erule_tac x = args in allE)
  apply clarsimp
  apply (erule impE)
   apply (clarsimp simp: val_rel_simp foldmap_inv_stat_def)
  apply (erule_tac x = \<sigma>' in allE)
  apply (erule_tac x = sa in allE)
  apply (clarsimp simp: corres_def)
  apply (subgoal_tac "matches_ptrs \<Xi> \<sigma>' [(mk_urecord [x, racc, obsv])]
      [option.Some (foldmap_funarg_type ''wordarray_map_no_break_0'')] (r' \<union> ro) w'")
   apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
   apply (erule impE, blast)
   apply clarsimp
   apply (rename_tac ret sb)
   apply (erule_tac x = ret in allE)
   apply (erule_tac x = sb in allE)
   apply clarsimp
   apply (frule update_sem.preservation[OF update_sem_axioms,
                   where \<tau>s = "[]" and \<epsilon>="[]"and K = "[]" and L=0 and C="{}",
                   simplified subst_wellformed_nothing, simplified]; simp?)
   apply clarsimp
   apply (rename_tac \<sigma>'' res' r'a w'a)
   apply (erule u_t_rectE; clarsimp)
   apply (erule u_t_r_contE; clarsimp)
   apply (erule u_t_r_contE; clarsimp)
   apply (erule u_t_r_contE; clarsimp)
   apply (rename_tac x' rd wd racc' r'a w'a)
   apply (frule_tac v = x' in tprim_no_pointers(1); clarsimp)
   apply (frule_tac v = x' in tprim_no_pointers(2); clarsimp)
   apply (clarsimp simp: foldmap_bounds_def)
   apply (case_tac "frm < to \<and> frm < len"; clarsimp)
   apply (drule_tac ta = num and
      arr = arr and
      len = len and
      va = x and
      racc' = racc' and
      va' = x' and
      ra = r and
      wa = w and
      ptrl = ptrl and
      \<sigma>' = \<sigma>' and
      \<sigma>'' = \<sigma>'' and
      racc = racc and
      rc = ro in upd_wa_mapAccumnb_bod_step; simp?; clarsimp?)
    apply (drule_tac v = obsv in type_repr_uval_repr(1))
    apply (drule_tac v = racc in type_repr_uval_repr(1))
    apply (clarsimp simp: val_rel_word)
   apply (thin_tac "_ \<in> state_rel")
   apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta)
   apply (frule_tac p = p and \<sigma> = \<sigma> in valid_ptr_not_in_frame_same; simp?)
    apply (drule wa_abs_typing_u_elims(3); clarsimp)
   apply (drule_tac p = "ptr_val p'" and \<sigma> = \<sigma>' and \<sigma>' = \<sigma>'' and w = w' in valid_ptr_not_in_frame_same[rotated -1]; simp?)
   apply (drule_tac p = "arr + (size_of_num_type num) * n" and \<sigma> = \<sigma>' in valid_ptr_not_in_frame_same; simp?)
    apply (drule_tac x = "arr + (size_of_num_type num) * n" and S = w' in orthD2; simp?)
    apply (drule wa_abs_typing_u_elims(3); clarsimp)
    apply (intro exI conjI; simp)
   apply (frule_tac p = p' in all_heap_rel_ptrD; simp?)
    apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
   apply (frule_tac p = "values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n" and uv = x in all_heap_rel_ptrD; simp?)
     apply (clarsimp simp: val_rel_simp heap_simp)
    apply (clarsimp simp: type_rel_simp val_rel_simp)
   apply (clarsimp simp: is_valid_simp heap_simp)
   apply (rule conjI)
    apply (intro exI conjI, assumption, clarsimp simp: val_rel_simp)
     apply (drule_tac upd_h = "(heap_w32_update
      (\<lambda>x a. if a = values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n then t7_C.p1_C ret else x a) sb)" and
      uv = x and uv' = x' and x = "values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n"
      in all_heap_rel_updE; simp?; clarsimp?)
        apply (clarsimp simp: val_rel_simp)
       apply (drule_tac v = x' in type_repr_uval_repr(1); simp add: val_rel_simp)
      apply (clarsimp simp: val_rel_simp type_rel_simp)
     apply (clarsimp simp: val_rel_simp)
     apply (drule_tac upd_h = "(heap_w32_update
      (\<lambda>x a. if a = values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n then t7_C.p1_C ret else x a) sb)" and
      uv = x and uv' = x' and x = "values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n" and
      is_v = is_valid_w32 in all_heap_rel_updE; simp?; clarsimp?)
        apply (clarsimp simp: val_rel_simp)
       apply (drule_tac v = x' in type_repr_uval_repr(1); simp add: val_rel_simp)
      apply (rule conjI)
      apply (clarsimp simp: val_rel_simp)
     apply (rename_tac pa)
      apply (cut_tac p = pa and q = "values_C (heap_WordArray_u32_C sb p') +\<^sub>p uint n" in ptr_val_inj)
      apply clarsimp
     apply (clarsimp simp: ptr_add_def mult.commute val_rel_simp)
   apply (frule_tac a = n and k = to in less_is_non_zero_p1)
   apply (drule unatSuc2; clarsimp simp: word_less_nat_alt word_le_nat_alt foldmap_measure_def)
   apply linarith
  apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (rule matches_ptrs_some[where r' = "{}" and w' = "{}", simplified])
   apply (rule u_t_struct; simp?)
  apply (rule u_t_r_cons1[where r = "{}" and w = "{}", simplified]; simp?)
     apply (subst (asm) val_rel_word; clarsimp)
     apply (rule u_t_prim'; clarsimp)
    apply (rule u_t_r_cons1[where r' = ro and w' = "{}", simplified]; simp?)
      apply (drule_tac u = obsv in uval_typing_frame(1); simp?)
       apply (drule wa_abs_typing_u_elims(3); clarsimp)
       apply blast
      apply (rule u_t_r_cons1[where r' = "{}" and w' = "{}", simplified]; simp?)
       apply (rule u_t_r_empty)
      apply (drule_tac v = obsv in type_repr_uval_repr(1); simp)
     apply (frule_tac v = obsv in frame_noalias_uval_typing'(2); (simp add: Int_Un_distrib)?; clarsimp?)
      apply (drule wa_abs_typing_u_elims(3); clarsimp)
      apply blast
     apply (subst Int_commute; blast)
    apply (drule_tac v = racc in type_repr_uval_repr(1); simp)
   apply (subst (asm) val_rel_word; clarsimp)
  apply (rule matches_ptrs_empty[where \<tau>s = "[]" and \<epsilon>="[]", simplified])
  done

lemma upd_C_wordarray_map_no_break_corres_gen:
  "\<lbrakk>proc_env_matches_ptrs \<xi>0' \<Xi>; i < length \<gamma>; val_rel (\<gamma> ! i) v';
    \<Gamma>' ! i = option.Some (prod.fst (prod.snd (prod.snd (prod.snd (\<Xi> ''wordarray_map_no_break_0'')))));
     D \<in> k \<or> S \<in> k; 0, K' , {} \<turnstile> (foldmap_obsv_type ''wordarray_map_no_break_0'') :\<kappa> k;
    \<gamma> ! i = URecord fs None; f = prod.fst (fs ! 3);
    (\<Xi>, 0, [], {}, [option.Some (foldmap_funarg_type ''wordarray_map_no_break_0'')] \<turnstile>
    (App (uvalfun_to_exprfun f) (Var 0)) : (foldmap_funret_type ''wordarray_map_no_break_0''));
    \<forall>x x' \<sigma> s. val_rel x x' \<longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
      (App (uvalfun_to_exprfun f) (Var 0)) (do ret <- dispatch_t8' (t9_C.f_C v') x'; gets (\<lambda>s. ret) od)
      \<xi>0' [x] \<Xi> [option.Some (foldmap_funarg_type ''wordarray_map_no_break_0'')] \<sigma> s;
    \<xi>1' ''wordarray_map_no_break_0'' = upd_wa_mapAccumnb \<Xi> \<xi>0'
      (foldmap_funarg_type ''wordarray_map_no_break_0'') (foldmap_funret_type ''wordarray_map_no_break_0'');
    elem_type (foldmap_funarg_type ''wordarray_map_no_break_0'') = TPrim (Num num)\<rbrakk>
    \<Longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
         (App (AFun ''wordarray_map_no_break_0'' [] []) (Var i)) (do x <- main_pp_inferred.wordarray_map_no_break_0' v';
gets (\<lambda>s. x)
                                                                od)
         \<xi>1' \<gamma> \<Xi>  \<Gamma>' \<sigma> s"
  apply (rule absfun_corres; simp)
  apply (clarsimp simp: abs_fun_rel_def'; rename_tac r w)
  apply (thin_tac "\<Gamma>' ! i = _")
  apply (subst (asm) val_rel_simp; clarsimp)
  apply (subst (asm) val_rel_ptr_def; clarsimp)
  apply (subst (asm) val_rel_fun_tag)
  apply (subst (asm) val_rel_word)
  apply (subst (asm) val_rel_word)
  apply (clarsimp simp: upd_wa_mapAccumnb_def wordarray_map_no_break_0'_def)
  apply (rename_tac pwa_rep frm_rep to_rep f_rep acc a_rep o_rep wa_rep)
  apply (erule u_t_recE; clarsimp)
  apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
  apply (erule u_t_r_consE; clarsimp)
  apply (rename_tac r w r' w')
  apply (erule u_t_ptrE; clarsimp)
  apply (rename_tac w)
  apply (frule wa_abs_typing_u_elims(1); clarsimp)
  apply (rename_tac len arr)
  apply (erule u_t_r_consE; simp)
  apply (erule u_t_r_consE; simp)
  apply (erule conjE)+
  apply (drule_tac t = "type_repr _" in sym)+
  apply clarsimp
  apply (erule u_t_primE)+
  apply (drule_tac t = "lit_type _" in sym)+
  apply clarsimp
  apply (erule u_t_r_consE; clarsimp)+
  apply (erule u_t_r_emptyE; clarsimp)
  apply (frule tfun_no_pointers(1))
  apply (frule tfun_no_pointers(2))
  apply clarsimp
  apply (rename_tac acc ra wa obsv ro wo)
  apply (drule_tac v = obsv in discardable_or_shareable_not_writable(1); simp?)
  apply (subst unknown_bind_ignore)+
  apply (clarsimp simp: join_guards)
  apply wp
      apply (clarsimp simp: unknown_bind_ignore split: prod.split)
       apply (rename_tac var e)
       apply (rule_tac M = "\<lambda>((_, i), _). foldmap_measure i (t9_C.to_C v')" and
      I = "\<lambda>(a, b) s. (\<exists>\<sigma>' res.
          foldmap_inv upd_wa_mapAccumnb_bod ''wordarray_map_no_break_0'' \<xi>0' \<sigma> (ptr_val (t9_C.arr_C v'))
          (t9_C.frm_C v') b (uvalfun_to_exprfun f) acc obsv  \<sigma>' res s (t10_C (t9_C.arr_C v') (t6_C.acc_C a))) \<and>
          foldmap_inv_stat obsv (t6_C.obsv_C a) \<and>
          foldmap_bounds (t9_C.frm_C v') (t9_C.to_C v') len b e" in whileLoop_add_invI; simp?)
       apply (wp; clarsimp simp: unknown_bind_ignore split: prod.splits)
           apply (rename_tac sa a n args a' n')
           apply (clarsimp simp: conj_left_commute[of "is_valid_w32 _ _", simplified])
           apply (clarsimp simp: conj_commute[of "is_valid_w32 _ _", simplified])
           apply (rule_tac a = a and wa = wa and ra = ra and ro = ro and w = w and r = r and
              ptrl = None in map_dispatch_wp; simp?)
              apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)+
          apply wp
         apply wp
        apply clarsimp
        apply (rename_tac args j \<sigma>' res)
        apply (clarsimp simp: foldmap_inv_def foldmap_bounds_def)
        apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
        apply (subst (asm) Int_Un_distrib; clarsimp)
        apply (drule_tac ptrl = None and
      ra = r and
      wa = w and
      rb = ra and
      wb = wa and
      rc = ro in upd_wa_mapAccumnb_bod_preservation; simp?; (clarsimp simp: Int_commute)?)
        apply (subst conj_commute[of "is_valid_w32 _ _"]; clarsimp)
        apply (subst conj_commute[of "is_valid_w32 _ _"]; clarsimp)
        apply (frule_tac \<sigma> = \<sigma>' in wa_abs_typing_u_elims(5), erule_tac x = j in allE, clarsimp)
        apply (clarsimp simp: state_rel_def heap_rel_def heap_rel_ptr_meta)
        apply (frule_tac p = "ptr_val (t9_C.arr_C v')" in valid_ptr_not_in_frame_same; simp?)
         apply (drule wa_abs_typing_u_elims(3); clarsimp)
        apply (frule_tac p = "t9_C.arr_C v'" and \<sigma> = \<sigma>' in all_heap_rel_ptrD; simp?)
         apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
        apply (clarsimp simp: is_valid_simp heap_simp)
        apply (frule_tac p = "Ptr(arr + (size_of_num_type num) * j)" and
      \<sigma> = \<sigma>' and
      is_v = is_valid_w32 in all_heap_rel_ptrD; simp?)
         apply (clarsimp simp: type_rel_simp)
        apply clarsimp
        apply (intro conjI exI; simp?)
         apply (clarsimp simp: val_rel_simp ptr_add_def mult.commute)
        apply (clarsimp simp: val_rel_simp ptr_add_def mult.commute)
       apply (rule conjI)
        apply (erule u_t_funafuntE; clarsimp)
       apply (rename_tac args j \<sigma>' res)
       apply (rule_tac x = \<sigma>' in exI)
       apply (rule_tac x = res in exI)
       apply (clarsimp simp: foldmap_inv_def)
       apply (clarsimp simp: \<Xi>_wordarray_map_no_break_0 wordarray_map_no_break_0_type_def abbreviated_type_defs)
       apply (unfold foldmap_bounds_def)
       apply (erule conjE)+
       apply (rule conjI)
        apply (case_tac "t9_C.frm_C v' < e")
         apply (erule impE, assumption)
         apply (thin_tac "_ \<longrightarrow> _")
         apply clarsimp
         apply (case_tac "j < t9_C.to_C v'"; clarsimp)
         apply (subst (asm) Int_Un_distrib; clarsimp)
         apply (rule_tac ptrl = None and
      ra = r and
      wa = w and
      rb = ra and
      wb = wa and
      rc = ro in upd_wa_mapAccumnb_bod_to_geq_len; (simp add: Int_commute)?; clarsimp?)
        apply (erule impE, assumption)
        apply (thin_tac "_ \<longrightarrow> _")
        apply clarsimp
        apply (erule upd_wa_mapAccumnb_bod.elims; clarsimp)
        apply (case_tac "t9_C.frm_C v' < t9_C.to_C v'"; subst upd_wa_mapAccumnb_bod.simps; clarsimp)
       apply (clarsimp simp: val_rel_simp)
      apply wp
     apply wp
    apply (rule validNF_select_UNIV)
   apply (rule validNF_select_UNIV)
  apply (clarsimp simp: foldmap_inv_stat_def)
  apply (clarsimp simp: order.strict_implies_order)
  apply (clarsimp simp: foldmap_inv_def state_rel_def heap_rel_def heap_rel_ptr_meta)
  apply (frule_tac p = "t9_C.arr_C v'" in all_heap_rel_ptrD; simp?)
   apply (clarsimp simp: type_rel_simp wa_abs_repr_def)
  apply (clarsimp simp: is_valid_simp val_rel_WordArray_u32_C_def heap_simp)
  apply (subst upd_wa_mapAccumnb_bod.simps; clarsimp)+
  apply (clarsimp simp: val_rel_simp)
  apply (rule conjI; clarsimp)
   apply (subst min_def)
   apply (subst (asm) not_le[symmetric])+
   apply (subst if_not_P; simp?)
  apply (subst min_def)
  apply (clarsimp simp: not_le)
  done

section "Specialised Lemmas for Cogent Functions"

lemma typing_mono_app_cogent_fun:
  "\<Xi>', 0, [], {}, [option.Some a] \<turnstile> f : b \<Longrightarrow> \<Xi>', 0, [], {}, [option.Some a] \<turnstile> App (Fun f [] []) (Var 0) : b"
  apply (frule typing_to_kinding_env(1); simp?)
  apply (rule typing_app[where x = a and y = b and ?\<Gamma>1.0 = "[option.None]" and ?\<Gamma>2.0 = "[option.Some a]"]; simp?)
    apply (clarsimp simp: split_conv_all_nth)
    apply (rule right; simp)
   apply (rule typing_fun[where \<delta> = "[]", OF _ _ _ _]; (simp add: Cogent.empty_def weakening_conv_all_nth)?)
     apply (rule weakening_comp.none)
    apply simp
   apply (rule subst_wellformed_nothing)
  apply (rule typing_var; simp add: Cogent.empty_def weakening_conv_all_nth)
  apply (rule keep; simp)
  done

lemma typing_mono_fun_cogent_fun:
  "\<Xi>', 0, [], {}, [option.Some a] \<turnstile> f : b \<Longrightarrow> \<Xi>', 0, [], {}, [option.None] \<turnstile> Fun f [] [] : TFun a b"
  apply (frule typing_to_kinding_env(1); simp?)
  apply (rule typing_fun[where \<delta>= "[]"];
          (simp add: Cogent.empty_def weakening_conv_all_nth )?)
    apply(rule  weakening_comp.none)
   apply simp
  apply (rule subst_wellformed_nothing)
  done

lemma typing_mono_fun_imp_appfun:
  "\<Xi>', 0, [], {}, [option.None] \<turnstile> Fun f [] []: TFun a b \<Longrightarrow> \<Xi>', 0, [], {}, [option.Some a] \<turnstile> App (Fun f [] []) (Var 0) : b"
  apply (frule typing_to_wellformed(1))
  apply (rule typing_app[where x = a and y = b and ?\<Gamma>1.0 = "[option.None]" and ?\<Gamma>2.0 = "[option.Some a]"]; simp?)
   apply (clarsimp simp: split_conv_all_nth)
   apply (rule right; simp)
  apply (rule typing_var; simp add: Cogent.empty_def weakening_conv_all_nth)
  apply (rule keep; simp)
  done

lemma upd_C_wordarray_fold_no_break_corres_cog:
  "\<lbrakk>i < length \<gamma>; val_rel (\<gamma> ! i) v';
    \<Gamma>' ! i = option.Some (prod.fst (prod.snd(prod.snd(prod.snd (\<Xi> ''wordarray_fold_no_break_0'')))));
    proc_env_matches_ptrs \<xi>0' \<Xi>;
    \<Xi> ''wordarray_fold_no_break_0'' = (0, [],{}, \<tau>, \<tau>acc);
    \<tau> = TRecord [(''arr'', TCon ''WordArray'' [TPrim (Num num)] (Boxed ReadOnly None), Present),
      (''frm'', TPrim (Num U32), Present), (''to'', TPrim (Num U32), Present),
      (''f'', TFun \<tau>f  \<tau>acc, Present), (''acc'', \<tau>acc, Present), (''obsv'', \<tau>obsv, Present)] Unboxed;
    \<tau>f = TRecord [(''elem'', TPrim (Num num), Present), (''acc'', \<tau>acc, Present),
      (''obsv'', \<tau>obsv, Present)] Unboxed;
    D \<in> k \<or> S \<in> k; 0, K', {} \<turnstile> \<tau>obsv :\<kappa> k;
    \<gamma> ! i = URecord fs None; UFunction f [] [] = prod.fst (fs ! 3);
    \<Xi>, 0, [], {}, [option.Some \<tau>f] \<turnstile> f : \<tau>acc;
    \<forall>x x' \<sigma> s. val_rel x x' \<longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
      (App (Fun f [] []) (Var 0)) (do ret <- dispatch_t4' (t5_C.f_C v') x'; gets (\<lambda>s. ret) od)
      \<xi>0' [x] \<Xi> [option.Some \<tau>f] \<sigma> s;
    \<xi>1' ''wordarray_fold_no_break_0'' = upd_wa_foldnb \<Xi> \<xi>0' \<tau>f\<rbrakk>
    \<Longrightarrow> update_sem_init.corres wa_abs_typing_u wa_abs_repr (Generated.state_rel wa_abs_repr)
         (App (AFun ''wordarray_fold_no_break_0'' [] []) (Var i)) (do x <- main_pp_inferred.wordarray_fold_no_break_0' v';
gets (\<lambda>s. x)
                                                                od)
         \<xi>1' \<gamma> \<Xi>  \<Gamma>' \<sigma> s"
  apply (drule typing_mono_app_cogent_fun)
  apply (rule upd_C_wordarray_fold_no_break_corres_gen; simp?)
   apply (clarsimp simp: val_rel_simp)
  apply (clarsimp simp: val_rel_simp)
  done

section "Specialised Lemmas for Abstract Functions"
lemma typing_mono_app_cogent_absfun:
  "\<lbrakk>proc_ctx_wellformed \<Xi>'; \<Xi>' f = (0,[],{}, a, b)\<rbrakk> \<Longrightarrow> \<Xi>', 0, [], {}, [option.Some a] \<turnstile> App (AFun f [] []) (Var 0) : b"
  apply (unfold  proc_ctx_wellformed_def)
  apply (erule_tac x = f in allE; clarsimp)
  apply (rule typing_app[where x = a and y = b and ?\<Gamma>1.0 = "[option.None]" and ?\<Gamma>2.0 = "[option.Some a]"]; simp?)
    apply (clarsimp simp: split_conv_all_nth)
    apply (rule right; simp)
   apply (rule typing_afun[where ts = "[]", OF _ _ _ _]; (simp add: Cogent.empty_def weakening_conv_all_nth)?)
     apply (rule weakening_comp.none)
    apply simp
   apply (rule subst_wellformed_nothing)
  apply (rule typing_var; simp add: Cogent.empty_def weakening_conv_all_nth)
  apply (rule keep; simp)
  done

lemma typing_mono_afun_cogent_absfun:
  "\<lbrakk>proc_ctx_wellformed \<Xi>'; \<Xi>' f = (0, [], {}, a, b)\<rbrakk> \<Longrightarrow> \<Xi>', 0, [], {}, [option.None] \<turnstile> AFun f [] [] : TFun a b"
  apply (unfold  proc_ctx_wellformed_def)
  apply (erule_tac x = f in allE; clarsimp)
  apply (rule typing_afun[where ts = "[]", OF _ _ _ _]; (simp add: Cogent.empty_def weakening_conv_all_nth)?)
    apply (rule weakening_comp.none)
   apply simp
  apply (rule subst_wellformed_nothing)
  done

lemma typing_mono_afun_imp_appafun:
  "\<Xi>', 0, [], {}, [option.None] \<turnstile> AFun f [] []: TFun a b \<Longrightarrow> \<Xi>', 0, [], {}, [option.Some a] \<turnstile> App (AFun f [] []) (Var 0) : b"
  apply (frule typing_to_wellformed(1))
  apply (rule typing_app[where x = a and y = b and ?\<Gamma>1.0 = "[option.None]" and ?\<Gamma>2.0 = "[option.Some a]"]; simp?)
   apply (clarsimp simp: split_conv_all_nth)
   apply (rule right; simp)
  apply (rule typing_var; simp add: Cogent.empty_def weakening_conv_all_nth)
  apply (rule keep; simp)
  done

end (* of context *)

end


(*

Copyright (c) 2017, ETH Zurich
All rights reserved.

Redistribution and use in source and binary forms, with or without
modification, are permitted provided that the following conditions are met:

1. Redistributions of source code must retain the above copyright notice, this
   list of conditions and the following disclaimer.
2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation
   and/or other materials provided with the distribution.

THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR
ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES
(INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES;
LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*)

(*<*)
theory ioapic
  imports Main Set  "../model/Model" "../model/Syntax"
begin
(*>*)

type_synonym PORT = nat

type_synonym VECTOR = nat

type_synonym CONTROLLER_NAME = nat

datatype FORMAT = FINVALID | FEMPTY | FVECTOR | FMEMWRITE

record IRQ =
  format :: FORMAT
  irq :: "PORT \<times> VECTOR"

definition NULL_IRQ :: IRQ
  where "NULL_IRQ = \<lparr>format = FINVALID, irq=(0, 0) \<rparr>"

record CONTROLLER_CLASS =
  in_port_num :: nat
  out_port_num :: nat
  mapValid :: "(IRQ \<Rightarrow> IRQ set) set"

(* Configuration of a controller *)
record CONTROLLER =
  map      :: "IRQ \<Rightarrow> IRQ set"

(* Interconnect of the system + each controller with a class *)
record SYSTEM =
  controller :: "CONTROLLER_NAME \<Rightarrow> (CONTROLLER \<times> CONTROLLER_CLASS) set"
  net :: "CONTROLLER_NAME \<Rightarrow> nat \<Rightarrow> (CONTROLLER_NAME \<Rightarrow> nat) set"

(* valid system = all ports wired, all controller in valid state + ...*)
(* lift to decoding net, assuming valid *)
(* look at decoding net to verify *)
(* assuming system is valid, configuration update \<Rightarrow> system valid *)

(* Arguments that do not produce an empty set, see dom *)
definition
  doms :: "('a \<Rightarrow> 'b set) \<Rightarrow> 'a set" where
  "doms m = {a. m a \<noteq> {}}"

definition ioapic_mapvalid_indiv :: "IRQ \<Rightarrow> IRQ set"
  where "ioapic_mapvalid_indiv x = {}"

definition ioapic_mapvalid_indiv_test :: "(IRQ \<Rightarrow> IRQ set) \<Rightarrow> bool"
  where "ioapic_mapvalid_indiv_test x = True"

definition ioapic_mapvalid_indiv_dom_valid :: "IRQ set \<Rightarrow> bool"
    where "ioapic_mapvalid_indiv_dom_valid xs  \<longleftrightarrow>  (\<forall>x \<in> xs. format x = FEMPTY)"

definition ioapic_mapvalid_indiv_test_2 :: "(IRQ \<Rightarrow> IRQ set) \<Rightarrow> bool"
  where "ioapic_mapvalid_indiv_test_2 x = ioapic_mapvalid_indiv_dom_valid (doms x)"

definition ioapic_mapvalid :: "(IRQ \<Rightarrow> IRQ set) set"
  where "ioapic_mapvalid = {x. ioapic_mapvalid_indiv_test x}"

 (* ( ((format ini)   = FEMPTY   \<and> (fst (irq ini)) < 24) \<and>
                                      ((format outi) = FVECTOR)  \<and> (snd (irq outi)) \<ge> 32 \<and> (snd (irq outi)) < 235 )" *)

definition ioapic :: "CONTROLLER_CLASS"
  where "ioapic  = \<lparr> in_port_num = 24, out_port_num = 4, mapValid = ioapic_mapvalid  \<rparr>"

definition ioapic_add_map :: "IRQ \<Rightarrow> IRQ \<Rightarrow> CONTROLLER \<Rightarrow> CONTROLLER set"
  where "ioapic_add_map iirq oirq c =
    (if (mapValid c iirq oirq) then
       { \<lparr> inPorts = (inPorts c), outPorts = (outPorts c), mapValid = (mapValid c),
           map = (map c)(iirq := oirq) \<rparr>  } else UNIV)"

lemma "(mapValid c) a b \<Longrightarrow> (\<forall>c' \<in> (ioapic_add_map a b c). (map c' a) = b)"
  by(simp add:ioapic_add_map_def)

lemma "\<not>(mapValid c) a b \<Longrightarrow> ((ioapic_add_map a b c) = UNIV)"
  by(simp add:ioapic_add_map_def)

definition irq_to_addr :: "IRQ \<Rightarrow> addr"
  where "irq_to_addr i = ((snd (irq i)) * 1024 + (fst (irq i)))"

definition irq_to_map :: "SYSTEM \<Rightarrow> IRQ \<Rightarrow> IRQ \<Rightarrow> nat \<Rightarrow> (nat \<times> nat ) set"
  where "irq_to_map s i i2 a = (if \<lparr>format = FEMPTY, irq=(a, 0) \<rparr> = i  then
                              { (controllers s (fst (irq i2)), irq_to_addr i2) } else {})"

definition ioapic_to_node :: "SYSTEM \<Rightarrow> CONTROLLER  \<Rightarrow> node" where
  "ioapic_to_node s c =
    \<lparr> accept = {},
      translate = (\<lambda> a. if a < 24 then irq_to_map s \<lparr>format = FEMPTY, irq=(a, 0) \<rparr>
                                        (map c \<lparr>format = FEMPTY, irq=(a, 0) \<rparr>) a else {}) \<rparr>"

definition replace_entry :: "SYSTEM \<Rightarrow> IRQ \<Rightarrow> IRQ \<Rightarrow>  IRQ  \<Rightarrow> node \<Rightarrow> node"
  where
    "replace_entry s i i2 i3 n = n  \<lparr>
      accept := accept n,
      translate := (\<lambda>va. (if \<lparr>format = FEMPTY, irq=(va, 0) \<rparr> = i then (irq_to_map s i i3 va)  else  (translate n va))) \<rparr>"

(* value "ioapic_mapvalid ( out *)
definition test_i :: IRQ
  where  "test_i = \<lparr>format = FEMPTY, irq = (3,2)\<rparr>"

definition test_j :: IRQ
  where  "test_j = \<lparr>format = FVECTOR, irq = (4,33)\<rparr>"

definition "an_ioapic" :: CONTROLLER
  where "an_ioapic = ioapic {1,2,3} {4,5,6}"

value "ioapic_mapvalid test_i test_i"

value "mapValid an_ioapic test_i test_i"

value "(map an_ioapic)(test_i := test_j)"

lemma "(mapValid an_ioapic x y) = False \<Longrightarrow>
        ioapic_add_map x y an_ioapic = UNIV "
  by(simp add:ioapic_add_map_def)

lemma xy: "mapValid an_ioapic test_i test_i = False"
  by(auto simp :ioapic_def ioapic_mapvalid_def an_ioapic_def test_i_def)

lemma "ioapic_add_map test_i test_i an_ioapic = UNIV"
  by(simp add:ioapic_add_map_def xy)

lemma assumes valid: "(mapValid c) a b"
  shows "ioapic_to_node s ` ioapic_add_map a b c = {replace_entry s a (map c a) b (ioapic_to_node s c)}"
  apply(auto)
  sorry

end


theory Proof_2_9
  imports Requirements VCTheoryLemmas
begin

theorem proof_2_9: "VC9 inv2 s0 requestButtonValue"
  apply(simp only: VC9_def inv2_def  R2_def extraInv_def)
proof
  print_state
  assume "  ((toEnvP s0 \<and>
      (\<forall>s1 s2 s3.
          substate s1 s2 \<and>
          substate s2 s3 \<and>
          substate s3 s0 \<and>
          toEnvP s1 \<and>
          toEnvP s2 \<and>
          toEnvP s3 \<and>
          toEnvNum s1 s2 = Ctrl \<and> toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED \<longrightarrow>
          getVarBool s3 minimalRed = PRESSED)) \<and>
     toEnvP s0 \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow> 0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> MINIMAL_RED_TIME_LIMIT) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
           (\<exists>s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and> getPstate s2 Ctrl = green \<and> ltimeEnv s2 Ctrl = T2) \<or>
           (\<forall>s2. toEnvP s2 \<and> substate s2 s1 \<longrightarrow> getPstate s2 Ctrl = minimalRed)) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> getPstate s2 Ctrl = minimalRed \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow>
         getPstate s1 Ctrl = minimalRed) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and>
         toEnvP s2 \<and>
         substate s1 s2 \<and> substate s2 s0 \<and> (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = minimalRed) \<longrightarrow>
         toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
           (\<exists>s2. toEnvP s2 \<and>
                 substate s2 s1 \<and>
                 getPstate s2 Ctrl = minimalRed \<and>
                 ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
                 getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
                 (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                       getPstate s3 Ctrl = redAfterMinimalRed \<and>
                       getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED))) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
           0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> RED_TO_GREEN_TIME_LIMIT) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
           (\<exists>s2. toEnvP s2 \<and>
                 substate s2 s1 \<and>
                 toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and>
                 getPstate s2 Ctrl = redAfterMinimalRed \<and> (getVarBool s2 redAfterMinimalRed = PRESSED \<or> getVarBool s2 Ctrl = PRESSED))) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<and> getPstate s2 Ctrl = redToGreen \<longrightarrow>
         getPstate s1 Ctrl = redToGreen) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and>
         toEnvP s2 \<and>
         substate s1 s2 \<and> substate s2 s0 \<and> (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = redToGreen) \<longrightarrow>
         toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow> 0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> T2) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow>
           (\<exists>s2. toEnvP s2 \<and>
                 substate s2 s1 \<and>
                 toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and> getPstate s2 Ctrl = redToGreen \<and> ltimeEnv s2 Ctrl = RED_TO_GREEN_TIME_LIMIT)) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> getPstate s2 Ctrl = green \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow>
         getPstate s1 Ctrl = green) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and>
         toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = green) \<longrightarrow>
         toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 minimalRed = PRESSED) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl \<noteq> green \<longrightarrow> getVarBool s1 minimalRed = NOT_PRESSED) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<longrightarrow>
           getPstate s1 Ctrl = minimalRed \<or>
           getPstate s1 Ctrl = redAfterMinimalRed \<or> getPstate s1 Ctrl = redToGreen \<or> getPstate s1 Ctrl = green) \<and>
     (\<forall>s1 s2.
         toEnvP s1 \<and>
         toEnvP s2 \<and>
         substate s1 s2 \<and>
         substate s2 s0 \<and>
         toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and> getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
         getVarBool s1 Ctrl = NOT_PRESSED) \<and>
     (\<forall>s2. toEnvP s2 \<and> substate s2 s0 \<and> getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = PRESSED \<longrightarrow>
           (\<exists>s1. toEnvP s1 \<and> substate s1 s2 \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and> getVarBool s1 Ctrl = PRESSED)) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed \<longrightarrow>
           (\<exists>s2. toEnvP s2 \<and>
                 substate s2 s1 \<and>
                 toEnvNum s2 s1 = Ctrl \<and>
                 getPstate s2 Ctrl = minimalRed \<and>
                 ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and> (getVarBool s2 redAfterMinimalRed \<or> getVarBool s1 Ctrl = PRESSED))) \<and>
     (\<forall>s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 redAfterMinimalRed = NOT_PRESSED)) \<and>
    env (setVarAny s0 requestButtonValue) requestButtonValue \<and>
    getPstate (setVarAny s0 requestButtonValue) Ctrl = redToGreen \<and>
    \<not> RED_TO_GREEN_TIME_LIMIT \<le> ltimeEnv (setVarAny s0 requestButtonValue) Ctrl"
  then obtain reqs0: "(toEnvP s0 \<and>
      (\<forall>s1 s2 s3.
          substate s1 s2 \<and>
          substate s2 s3 \<and>
          substate s3 s0 \<and>
          toEnvP s1 \<and>
          toEnvP s2 \<and>
          toEnvP s3 \<and>
          toEnvNum s1 s2 = Ctrl \<and>
          toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED \<longrightarrow>
          getVarBool s3 minimalRed = PRESSED))"
and ei0: "toEnvP s0"
and ei1: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
 0<ltimeEnv s1 Ctrl \<and>  ltimeEnv s1 Ctrl \<le> MINIMAL_RED_TIME_LIMIT) "
and ei2: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
 ((\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl  \<and>
 getPstate s2 Ctrl = green \<and> ltimeEnv s2 Ctrl = GREEN_TIME_LIMIT) \<or>
 (\<forall> s2. toEnvP s2 \<and> substate s2 s1 \<longrightarrow> getPstate s2 Ctrl = minimalRed))) "
and ei3: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> getPstate s2 Ctrl = minimalRed \<and>
 toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow> getPstate s1 Ctrl = minimalRed) "
and ei4: "\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and>
(\<forall> s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = minimalRed ) \<longrightarrow>
toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl"
and ei5: "\<forall> s1 . toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and>
 getVarBool s1 requestButtonPressed = False \<longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> getPstate s2 Ctrl = minimalRed \<and> ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
getVarBool s2 requestButtonPressed = False \<and> (\<forall> s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
 getPstate s3 Ctrl = redAfterMinimalRed \<and>
getVarBool s3 requestButtonPressed = False \<and> getVarBool s3  requestButton = NOT_PRESSED))"
and ei6: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
0< ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> RED_TO_GREEN_TIME_LIMIT) "
and ei7: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
(\<exists> s2. toEnvP s2  \<and> substate s2 s1 \<and>
 toEnvNum s2 s1 = ltimeEnv s1 Ctrl  \<and> getPstate s2 Ctrl = redAfterMinimalRed \<and>
(getVarBool s2 requestButtonPressed = True \<or> getVarBool s2 requestButton = PRESSED)))"
and ei8: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<and>
 getPstate s2 Ctrl = redToGreen \<longrightarrow> getPstate s1 Ctrl = redToGreen) "
and ei9: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and>
(\<forall> s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = redToGreen) \<longrightarrow>
toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) "
and ei10: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow>
0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> GREEN_TIME_LIMIT)"
and ei11: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and>
getPstate s2 Ctrl = redToGreen \<and> ltimeEnv s2 Ctrl = RED_TO_GREEN_TIME_LIMIT)) "
and ei12: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and> getPstate s2 Ctrl = green \<and>
toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow> getPstate s1 Ctrl = green)"
and ei13: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and>
(\<forall> s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = green) \<longrightarrow>
toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) "
and ei14: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 trafficLight = GREEN) "
and ei15: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl \<noteq> green \<longrightarrow> getVarBool s1 trafficLight = RED) "
and ei16: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<longrightarrow>
 getPstate s1 Ctrl = minimalRed \<or> getPstate s1 Ctrl = redAfterMinimalRed \<or>
 getPstate s1 Ctrl = redToGreen \<or> getPstate s1 Ctrl = green)"
and ei17: "(\<forall> s1 s2. toEnvP s1 \<and> toEnvP s2 \<and> substate s1 s2 \<and> substate s2 s0 \<and>
 toEnvNum s1 s2 < ltimeEnv s2 Ctrl - 1 \<and>  getPstate s2 Ctrl = minimalRed \<and>
 getVarBool s2 requestButtonPressed = False \<longrightarrow> getVarBool s1 requestButton = NOT_PRESSED)"
and ei18: "(\<forall> s2. toEnvP s2  \<and> substate s2 s0  \<and>
 getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 requestButtonPressed = True \<longrightarrow>
(\<exists> s1. toEnvP s1 \<and> substate s1 s2 \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl - 1 \<and> getVarBool s1 requestButton = PRESSED))"
and ei19: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 requestButtonPressed \<longrightarrow>
(\<exists> s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 = 1 \<and> getPstate s2 Ctrl = minimalRed \<and>
 ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
 (getVarBool s2 requestButtonPressed \<or> getVarBool s1 requestButton = PRESSED)))"
and ei20: "(\<forall> s1. toEnvP s1 \<and> substate s1 s0 \<and> getPstate s1 Ctrl = green \<longrightarrow> getVarBool s1 requestButtonPressed = False)"
and vc: " env (setVarAny s0 requestButtonValue) requestButtonValue \<and>
    getPstate (setVarAny s0 requestButtonValue) Ctrl = redToGreen \<and>
    \<not> RED_TO_GREEN_TIME_LIMIT \<le> ltimeEnv (setVarAny s0 requestButtonValue) Ctrl"
    by fast
  show "  (toEnvP (toEnv (setVarAny s0 requestButtonValue)) \<and>
     (\<forall>s1 s2 s3.
         substate s1 s2 \<and>
         substate s2 s3 \<and>
         substate s3 (toEnv (setVarAny s0 requestButtonValue)) \<and>
         toEnvP s1 \<and>
         toEnvP s2 \<and>
         toEnvP s3 \<and> toEnvNum s1 s2 = Ctrl \<and> toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED \<longrightarrow>
         getVarBool s3 minimalRed = PRESSED)) \<and>
    toEnvP (toEnv (setVarAny s0 requestButtonValue)) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
          0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> MINIMAL_RED_TIME_LIMIT) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s1 Ctrl = minimalRed \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and> substate s2 s1 \<and> toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and> getPstate s2 Ctrl = green \<and> ltimeEnv s2 Ctrl = T2) \<or>
          (\<forall>s2. toEnvP s2 \<and> substate s2 s1 \<longrightarrow> getPstate s2 Ctrl = minimalRed)) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s2 Ctrl = minimalRed \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow>
        getPstate s1 Ctrl = minimalRed) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setVarAny s0 requestButtonValue)) \<and>
        (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = minimalRed) \<longrightarrow>
        toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
    (\<forall>s1. toEnvP s1 \<and>
          substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<and>
          getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and>
                substate s2 s1 \<and>
                getPstate s2 Ctrl = minimalRed \<and>
                ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
                getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
                (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 s1 \<and> s2 \<noteq> s3 \<longrightarrow>
                      getPstate s3 Ctrl = redAfterMinimalRed \<and>
                      getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED))) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
          0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> RED_TO_GREEN_TIME_LIMIT) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s1 Ctrl = redToGreen \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and>
                substate s2 s1 \<and>
                toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and>
                getPstate s2 Ctrl = redAfterMinimalRed \<and> (getVarBool s2 redAfterMinimalRed = PRESSED \<or> getVarBool s2 Ctrl = PRESSED))) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setVarAny s0 requestButtonValue)) \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<and> getPstate s2 Ctrl = redToGreen \<longrightarrow>
        getPstate s1 Ctrl = redToGreen) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setVarAny s0 requestButtonValue)) \<and>
        (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = redToGreen) \<longrightarrow>
        toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s1 Ctrl = green \<longrightarrow>
          0 < ltimeEnv s1 Ctrl \<and> ltimeEnv s1 Ctrl \<le> T2) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s1 Ctrl = green \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and>
                substate s2 s1 \<and>
                toEnvNum s2 s1 = ltimeEnv s1 Ctrl \<and> getPstate s2 Ctrl = redToGreen \<and> ltimeEnv s2 Ctrl = RED_TO_GREEN_TIME_LIMIT)) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s2 Ctrl = green \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl \<longrightarrow>
        getPstate s1 Ctrl = green) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setVarAny s0 requestButtonValue)) \<and>
        (\<forall>s3. toEnvP s3 \<and> substate s1 s3 \<and> substate s3 s2 \<longrightarrow> getPstate s3 Ctrl = green) \<longrightarrow>
        toEnvNum s1 s2 = ltimeEnv s2 Ctrl - ltimeEnv s1 Ctrl) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s1 Ctrl = green \<longrightarrow>
          getVarBool s1 minimalRed = PRESSED) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s1 Ctrl \<noteq> green \<longrightarrow>
          getVarBool s1 minimalRed = NOT_PRESSED) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<longrightarrow>
          getPstate s1 Ctrl = minimalRed \<or>
          getPstate s1 Ctrl = redAfterMinimalRed \<or> getPstate s1 Ctrl = redToGreen \<or> getPstate s1 Ctrl = green) \<and>
    (\<forall>s1 s2.
        toEnvP s1 \<and>
        toEnvP s2 \<and>
        substate s1 s2 \<and>
        substate s2 (toEnv (setVarAny s0 requestButtonValue)) \<and>
        toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and> getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<longrightarrow>
        getVarBool s1 Ctrl = NOT_PRESSED) \<and>
    (\<forall>s2. toEnvP s2 \<and>
          substate s2 (toEnv (setVarAny s0 requestButtonValue)) \<and>
          getPstate s2 Ctrl = minimalRed \<and> getVarBool s2 redAfterMinimalRed = PRESSED \<longrightarrow>
          (\<exists>s1. toEnvP s1 \<and> substate s1 s2 \<and> toEnvNum s1 s2 < ltimeEnv s2 Ctrl - Ctrl \<and> getVarBool s1 Ctrl = PRESSED)) \<and>
    (\<forall>s1. toEnvP s1 \<and>
          substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s1 Ctrl = redAfterMinimalRed \<and> getVarBool s1 redAfterMinimalRed \<longrightarrow>
          (\<exists>s2. toEnvP s2 \<and>
                substate s2 s1 \<and>
                toEnvNum s2 s1 = Ctrl \<and>
                getPstate s2 Ctrl = minimalRed \<and>
                ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and> (getVarBool s2 redAfterMinimalRed \<or> getVarBool s1 Ctrl = PRESSED))) \<and>
    (\<forall>s1. toEnvP s1 \<and> substate s1 (toEnv (setVarAny s0 requestButtonValue)) \<and> getPstate s1 Ctrl = green \<longrightarrow>
          getVarBool s1 redAfterMinimalRed = NOT_PRESSED)"
    apply(rule conjI)
     apply(rule conjI)
    apply(simp)
  proof(rule allI; rule allI; rule allI)
    fix s1 s2 s3
    show "substate s1 s2 \<and>
         substate s2 s3 \<and>
         substate s3 (toEnv (setVarAny s0 requestButtonValue)) \<and>
         toEnvP s1 \<and>
         toEnvP s2 \<and>
         toEnvP s3 \<and>
         toEnvNum s1 s2 = Ctrl \<and>
         toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED \<longrightarrow>
         getVarBool s3 minimalRed = PRESSED"
    proof cases
      assume 1: "s3 = (toEnv (setVarAny s0 requestButtonValue))"
      show ?thesis
      proof
        assume req_prems: "substate s1 s2 \<and>
    substate s2 s3 \<and>
    substate s3 (toEnv (setVarAny s0 requestButtonValue)) \<and>
    toEnvP s1 \<and>
    toEnvP s2 \<and>
    toEnvP s3 \<and> toEnvNum s1 s2 = Ctrl \<and> toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED"
        from ei0  substate_refl vc ei7  have "\<exists> s2. toEnvP s2  \<and> substate s2 s0 \<and>
 toEnvNum s2 s0 = ltimeEnv s0 Ctrl  \<and> getPstate s2 Ctrl = redAfterMinimalRed \<and>
(getVarBool s2 requestButtonPressed = True \<or> getVarBool s2 requestButton = PRESSED)" by auto
        then obtain ramr where 2: "toEnvP ramr  \<and> substate ramr s0 \<and>
 toEnvNum ramr s0 = ltimeEnv s0 Ctrl  \<and> getPstate ramr Ctrl = redAfterMinimalRed \<and>
(getVarBool ramr requestButtonPressed = True \<or> getVarBool ramr requestButton = PRESSED)" ..
        show "getVarBool s3 trafficLight = GREEN"
        proof cases
          assume 3: "substate s2 ramr"
          show ?thesis
          proof cases
            assume 4: "getVarBool ramr requestButtonPressed"
            with 2  ei19
        have " (\<exists>s2. toEnvP s2 \<and>
           substate s2 ramr \<and>
           toEnvNum s2 ramr = 1 \<and>
           getPstate s2 Ctrl = minimalRed \<and>
           ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and> (getVarBool s2 requestButtonPressed \<or> getVarBool ramr requestButton = PRESSED))"
          by auto
        then obtain mr where 5: "toEnvP mr \<and> substate mr ramr \<and>
           toEnvNum mr ramr = 1 \<and>
           getPstate mr Ctrl = minimalRed \<and>
           ltimeEnv mr Ctrl = MINIMAL_RED_TIME_LIMIT \<and> (getVarBool mr requestButtonPressed \<or> getVarBool ramr requestButton = PRESSED)" ..
        show ?thesis
        proof cases
          assume 6: "substate s2 mr"
          from 2 5 substate_trans have "substate mr s0" by blast
          with 5 ei2 have "((\<exists> s2. toEnvP s2 \<and> substate s2 mr \<and> toEnvNum s2 mr = MINIMAL_RED_TIME_LIMIT  \<and>
 getPstate s2 Ctrl = green \<and> ltimeEnv s2 Ctrl = GREEN_TIME_LIMIT) \<or>
 (\<forall> s2. toEnvP s2 \<and> substate s2 mr \<longrightarrow> getPstate s2 Ctrl = minimalRed))" by auto
          then show ?thesis
          proof
            assume " \<exists>s2. toEnvP s2 \<and> substate s2 mr \<and> toEnvNum s2 mr = MINIMAL_RED_TIME_LIMIT \<and> getPstate s2 Ctrl = green \<and>
 ltimeEnv s2 Ctrl = T2"
            then obtain g where 7: "toEnvP g \<and> substate g mr \<and> toEnvNum g mr = MINIMAL_RED_TIME_LIMIT \<and> getPstate g Ctrl = green \<and>
 ltimeEnv g Ctrl = T2" ..
            show ?thesis
            proof cases
              assume 8: "substate s2 g"
              with 7 toEnvNum3[of s2 g mr] req_prems have 9: "toEnvNum s2 mr \<ge> MINIMAL_RED_TIME_LIMIT" by auto
              from 8 7 substate_trans have "substate s2 mr" by blast
              with 5 9 toEnvNum3 req_prems have 10: "toEnvNum s2 ramr > MINIMAL_RED_TIME_LIMIT" by auto
              from 2 vc have "ramr \<noteq> s0" by auto
              with 2 ei0 gtimeE_inj have "toEnvNum emptyState ramr \<noteq> toEnvNum emptyState s0" by auto
              with emptyState_substate 2 toEnvNum3 have "toEnvNum ramr s0 > 0" by auto
              with 10 2 toEnvNum3 have "toEnvNum s2 s0 > MINIMAL_RED_TIME_LIMIT"
                using "5" "6" "9" \<open>substate mr s0\<close> by force
              with 1 req_prems show ?thesis by ((simp split: if_splits); auto)
            next
              assume 8: "\<not> substate s2 g"
              with 8 6 7  substate_total substate_asym have 9:  "substate g s2 \<and> g \<noteq> s2" by auto
              with req_prems 7 gtimeE_inj have "toEnvNum emptyState g \<noteq> toEnvNum  emptyState s2" by blast
              with 9 toEnvNum3[of emptyState g s2] emptyState_substate  have "toEnvNum g s2 > 0" by auto
              with 6 7 9  toEnvNum3 have "toEnvNum s2 mr < MINIMAL_RED_TIME_LIMIT" by auto
              with 6 5 req_prems ei3 have "getPstate s2 Ctrl = minimalRed"
                by (metis \<open>substate mr s0\<close>)
                with  ei15 req_prems show ?thesis
                by (metis "1" numeral_eq_iff substate.simps(2) substate.simps(6) toEnvP.simps(6) verit_eq_simplify(14))
            qed
          next
            assume 7: "\<forall>s2. toEnvP s2 \<and> substate s2 mr \<longrightarrow> getPstate s2 Ctrl = minimalRed"
            with 6 req_prems show ?thesis
              by (metis "1" ei15 numeral_eq_iff substate.simps(2) substate.simps(6) toEnvP.simps(6) verit_eq_simplify(14))
          qed
        next
          assume 6: "\<not> substate s2 mr"
          show ?thesis
          proof cases
            assume "s2 =  (toEnv (setVarAny s0 requestButtonValue))"
            with 1 req_prems show ?thesis by auto
          next
            assume "s2 \<noteq> (toEnv (setVarAny s0 requestButtonValue))"
            with req_prems 1 have 7: "substate s2 s0"  by (simp  split: if_splits)
            with 5 6 substate_total substate_asym have 8: "substate mr s2 \<and> mr \<noteq> s2"
              using "3" by blast
            from 7 emptyState_substate toEnvNum3  have 9: "toEnvNum emptyState s2 \<le> toEnvNum emptyState s0" by auto
            from 5 8 req_prems gtimeE_inj have "toEnvNum emptyState mr \<noteq> toEnvNum emptyState s2" by blast
            with 8 emptyState_substate toEnvNum3 have 8: "toEnvNum emptyState mr < toEnvNum emptyState s2" by auto
            from 5 emptyState_substate toEnvNum3 have "toEnvNum emptyState ramr = toEnvNum emptyState mr + 1" by auto
            with 8 have 11: "toEnvNum emptyState s2 \<ge> toEnvNum emptyState ramr" by auto
            from 3 emptyState_substate toEnvNum3 have "toEnvNum emptyState s2 \<le> toEnvNum emptyState ramr" by auto
            with 11 have "toEnvNum emptyState s2 = toEnvNum emptyState ramr" by auto
            with 2 3 req_prems gtimeE_inj have "s2 = ramr" by blast
            with 2 req_prems ei15 show ?thesis by auto
          qed
        qed
      next
        assume 4: "\<not>getVarBool ramr requestButtonPressed"
            with 2  ei5
        have " \<exists>s2. toEnvP s2 \<and>
           substate s2 ramr \<and>
           getPstate s2 Ctrl = minimalRed \<and>
           ltimeEnv s2 Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
           getVarBool s2 redAfterMinimalRed = NOT_PRESSED \<and>
           (\<forall>s3. toEnvP s3 \<and> substate s2 s3 \<and> substate s3 ramr \<and> s2 \<noteq> s3 \<longrightarrow>
                 getPstate s3 Ctrl = redAfterMinimalRed \<and> getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED)"
          by auto
        then obtain mr where 5: "toEnvP mr \<and>
           substate mr ramr \<and>
           getPstate mr Ctrl = minimalRed \<and>
           ltimeEnv mr Ctrl = MINIMAL_RED_TIME_LIMIT \<and>
           getVarBool mr redAfterMinimalRed = NOT_PRESSED \<and>
           (\<forall>s3. toEnvP s3 \<and> substate mr s3 \<and> substate s3 ramr \<and> mr \<noteq> s3 \<longrightarrow>
                 getPstate s3 Ctrl = redAfterMinimalRed \<and> getVarBool s3 redAfterMinimalRed = NOT_PRESSED \<and> getVarBool s3 Ctrl = NOT_PRESSED)"
          ..
        show ?thesis
        proof cases
          assume 6: "substate s2 mr"
          from 2 5 substate_trans have "substate mr s0" by blast
          with 5 ei2 have "((\<exists> s2. toEnvP s2 \<and> substate s2 mr \<and> toEnvNum s2 mr = MINIMAL_RED_TIME_LIMIT  \<and>
 getPstate s2 Ctrl = green \<and> ltimeEnv s2 Ctrl = GREEN_TIME_LIMIT) \<or>
 (\<forall> s2. toEnvP s2 \<and> substate s2 mr \<longrightarrow> getPstate s2 Ctrl = minimalRed))" by auto
          then show ?thesis
          proof
            assume " \<exists>s2. toEnvP s2 \<and> substate s2 mr \<and> toEnvNum s2 mr = MINIMAL_RED_TIME_LIMIT \<and> getPstate s2 Ctrl = green \<and>
 ltimeEnv s2 Ctrl = T2"
            then obtain g where 7: "toEnvP g \<and> substate g mr \<and> toEnvNum g mr = MINIMAL_RED_TIME_LIMIT \<and> getPstate g Ctrl = green \<and>
 ltimeEnv g Ctrl = T2" ..
            show ?thesis
            proof cases
              assume 8: "substate s2 g"
              with 7 toEnvNum3[of s2 g mr] req_prems have 9: "toEnvNum s2 mr \<ge> MINIMAL_RED_TIME_LIMIT" by auto
              from 8 7 substate_trans have "substate s2 mr" by blast
              with 5 9 toEnvNum3 req_prems have 10: "toEnvNum s2 ramr \<ge> MINIMAL_RED_TIME_LIMIT" by auto
              from 2 vc have "ramr \<noteq> s0" by auto
              with 2 ei0 gtimeE_inj have "toEnvNum emptyState ramr \<noteq> toEnvNum emptyState s0" by auto
              with emptyState_substate 2 toEnvNum3 have "toEnvNum ramr s0 > 0" by auto
              with 10 2 toEnvNum3 have "toEnvNum s2 s0 > MINIMAL_RED_TIME_LIMIT"
                using "5" "6" "9" \<open>substate mr s0\<close> by force
              with 1 req_prems show ?thesis by ((simp split: if_splits); auto)
            next
              assume 8: "\<not> substate s2 g"
              with 8 6 7  substate_total substate_asym have 9:  "substate g s2 \<and> g \<noteq> s2" by auto
              with req_prems 7 gtimeE_inj have "toEnvNum emptyState g \<noteq> toEnvNum  emptyState s2" by blast
              with 9 toEnvNum3[of emptyState g s2] emptyState_substate  have "toEnvNum g s2 > 0" by auto
              with 6 7 9  toEnvNum3 have "toEnvNum s2 mr < MINIMAL_RED_TIME_LIMIT" by auto
              with 6 5 req_prems ei3 have "getPstate s2 Ctrl = minimalRed"
                by (metis \<open>substate mr s0\<close>)
                with  ei15 req_prems show ?thesis
                by (metis "1" numeral_eq_iff substate.simps(2) substate.simps(6) toEnvP.simps(6) verit_eq_simplify(14))
            qed
          next
            assume 7: "\<forall>s2. toEnvP s2 \<and> substate s2 mr \<longrightarrow> getPstate s2 Ctrl = minimalRed"
            with 6 req_prems show ?thesis
              by (metis "1" ei15 numeral_eq_iff substate.simps(2) substate.simps(6) toEnvP.simps(6) verit_eq_simplify(14))
          qed
        next
          assume 6: "\<not> substate s2 mr"
          show ?thesis
          proof cases
            assume "s2 =  (toEnv (setVarAny s0 requestButtonValue))"
            with 1 req_prems show ?thesis by auto
          next
            assume "s2 \<noteq> (toEnv (setVarAny s0 requestButtonValue))"
            with req_prems 1 have 7: "substate s2 s0"  by (simp  split: if_splits)
            with 5 6 substate_total substate_asym have 8: "substate mr s2 \<and> mr \<noteq> s2"
              using "3" by blast
            from req_prems 3 5 8 have "getPstate s2 Ctrl = redAfterMinimalRed" by auto
            with req_prems ei15 show ?thesis
              using "7" by force
          qed
        qed
      qed
    next
      assume 3: "\<not> substate s2 ramr"
      show ?thesis
        proof cases
            assume "s2 =  (toEnv (setVarAny s0 requestButtonValue))"
            with 1 req_prems show ?thesis by auto
          next
            assume "s2 \<noteq> (toEnv (setVarAny s0 requestButtonValue))"
            with req_prems 1 have 7: "substate s2 s0"  by (simp  split: if_splits)
            with 2 3 substate_total substate_asym have 4: "substate ramr s2 \<and> ramr \<noteq> s2" by auto
            with emptyState_substate toEnvNum3 have 5: "toEnvNum emptyState ramr \<le> toEnvNum emptyState s2" by auto
            from 4 req_prems 2 gtimeE_inj have "toEnvNum emptyState ramr \<noteq> toEnvNum emptyState s2" by blast
            with 5 have "toEnvNum emptyState ramr < toEnvNum emptyState s2" by auto
            with emptyState_substate 7 2 have "toEnvNum s2 s0 < toEnvNum ramr s0"
              by (metis "3" ei0 leI req_prems shift_toEnvNum substate_shift)
            with 2 ei8 have "getPstate s2 Ctrl = redToGreen"
              by (metis "7" ei0 getPstate.simps(6) req_prems substate_refl vc)
            with ei15 req_prems 7 show ?thesis by auto
          qed
        qed
      qed
    next
 assume 1: "s3 \<noteq> (toEnv (setVarAny s0 requestButtonValue))"
    show ?thesis
    proof
      assume req_prems: " substate s1 s2 \<and>
    substate s2 s3 \<and>
    substate s3 (toEnv (setVarAny s0 requestButtonValue)) \<and>
    toEnvP s1 \<and>
    toEnvP s2 \<and>
    toEnvP s3 \<and> toEnvNum s1 s2 = Ctrl \<and> toEnvNum s2 s3 < T2 \<and> getVarBool s1 minimalRed \<noteq> PRESSED \<and> getVarBool s2 minimalRed = PRESSED"
      with 1 have "substate s3 s0" by (simp split: if_splits)
      with req_prems reqs0
      show " getVarBool s3 minimalRed = PRESSED" by blast
    qed
  qed


(*
   Title: The pi-calculus
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Bisim_Subst_SC
  imports Weak_Early_Cong_Subst Strong_Early_Bisim_Subst_SC
begin

(******** Structural Congruence **********)

(******** The \<nu>-operator *****************)

lemma resComm:
  fixes P :: pi

  shows "<\<nu>a><\<nu>b>P \<simeq>\<^sup>s <\<nu>b><\<nu>a>P"
proof -
  have "<\<nu>a><\<nu>b>P \<sim>\<^sup>s\<^sub>e <\<nu>b><\<nu>a>P"
    by(rule Strong_Early_Bisim_Subst_SC.resComm)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** Match *********)

lemma matchId:
  fixes a :: name
  and   P :: pi

  shows "[a\<frown>a]P \<simeq>\<^sup>s P"
proof -
  have "[a\<frown>a]P \<sim>\<^sup>s\<^sub>e P" by(rule Strong_Early_Bisim_Subst_SC.matchId)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** Mismatch *********)

  shows "[a\<noteq>a]P \<simeq>\<^sup>s \<zero>"
proof -
  have "[a\<noteq>a]P \<sim>\<^sup>s\<^sub>e \<zero>" by(rule Strong_Early_Bisim_Subst_SC.mismatchNil)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** The +-operator *********)

lemma sumSym:
  fixes P :: pi
  and   Q :: pi

  shows "P \<oplus> Q \<simeq>\<^sup>s Q \<oplus> P"
proof -
  have "P \<oplus> Q \<sim>\<^sup>s\<^sub>e Q \<oplus> P" by(rule Strong_Early_Bisim_Subst_SC.sumSym)
  thus ?thesis by(rule strongEqWeakCong)
qed

(******** The |-operator *********)

lemma parZero:
  fixes P :: pi

  shows "P \<parallel> \<zero> \<simeq>\<^sup>s P"
proof -
  have "P \<parallel> \<zero> \<sim>\<^sup>s\<^sub>e P" by(rule Strong_Early_Bisim_Subst_SC.parZero)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma parSym:
  fixes P :: pi
  and   Q :: pi

  shows "P \<parallel> Q \<simeq>\<^sup>s Q \<parallel> P"
proof -
  have "P \<parallel> Q \<sim>\<^sup>s\<^sub>e Q \<parallel> P" by(rule Strong_Early_Bisim_Subst_SC.parSym)
  thus ?thesis by(rule strongEqWeakCong)
qed

  assumes "x \<sharp> P"

  shows "<\<nu>x>(P \<parallel> Q) \<simeq>\<^sup>s P \<parallel> <\<nu>x>Q"
proof -
  from `x \<sharp> P` have "<\<nu>x>(P \<parallel> Q) \<sim>\<^sup>s\<^sub>e P \<parallel> <\<nu>x>Q" by(rule Strong_Early_Bisim_Subst_SC.scopeExtPar)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma scopeExtPar':
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x \<sharp> Q"

  shows "<\<nu>x>(P \<parallel> Q) \<simeq>\<^sup>s (<\<nu>x>P) \<parallel> Q"
proof -
  from `x \<sharp> Q` have "<\<nu>x>(P \<parallel> Q) \<sim>\<^sup>s\<^sub>e (<\<nu>x>P) \<parallel> Q" by(rule Strong_Early_Bisim_Subst_SC.scopeExtPar')
  thus ?thesis by(rule strongEqWeakCong)
qed

  shows "(P \<parallel> Q) \<parallel> R \<simeq>\<^sup>s P \<parallel> (Q \<parallel> R)"
proof -
  have "(P \<parallel> Q) \<parallel> R \<sim>\<^sup>s\<^sub>e P \<parallel> (Q \<parallel> R)" by(rule Strong_Early_Bisim_Subst_SC.parAssoc)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma freshRes:
  fixes P :: pi
  and   a :: name

  assumes "a \<sharp> P"

  shows "<\<nu>a>P \<simeq>\<^sup>s P"
proof -
  from `a \<sharp> P` have "<\<nu>a>P \<sim>\<^sup>s\<^sub>e P" by(rule Strong_Early_Bisim_Subst_SC.freshRes)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma scopeExtSum:
  fixes P :: pi
  and   Q :: pi
  and   x :: name

  assumes "x \<sharp> P"

  shows "<\<nu>x>(P \<oplus> Q) \<simeq>\<^sup>s P \<oplus> <\<nu>x>Q"
proof -
  from `x \<sharp> P` have "<\<nu>x>(P \<oplus> Q) \<sim>\<^sup>s\<^sub>e P \<oplus> <\<nu>x>Q" by(rule Strong_Early_Bisim_Subst_SC.scopeExtSum)
  thus ?thesis by(rule strongEqWeakCong)
qed

lemma bangSC:
  fixes P

  shows "!P \<simeq>\<^sup>s P \<parallel> !P"
proof -
  have "!P \<sim>\<^sup>s\<^sub>e P \<parallel> !P" by(rule Strong_Early_Bisim_Subst_SC.bangSC)
  thus ?thesis by(rule strongEqWeakCong)
qed

end