theory RedSafeCV
  imports RedSafeUnpack
begin

    (* ##### array extension case ###### *)

definition ext_arr_abbrev where
  "ext_arr_abbrev v = AppExp (ConstExp ExtArrayConst) (VarExp v)"

definition var_abbrev where
  "var_abbrev v = VarExp v"

definition ext_app_abbrev where
  "ext_app_abbrev a v = AppExp (ext_arr_abbrev a) v"

lemma ext_arr_type: "\<lbrakk> well_typed env r_s1 (ext_arr_abbrev v) tau r_s2 rx; v = LocType x y \<rbrakk> \<Longrightarrow>
  well_typed env r_s1 (ext_arr_abbrev v) tau r_s1 (comp_use_env rx (infl_use_env r_s1 r_s2))"
  apply (rule_tac infl_full_sexp_wp)
   apply (simp)
  apply (simp add: ext_arr_abbrev_def)
  done

lemma ext_var_type: "\<lbrakk> well_typed env r_s1 (ext_arr_abbrev v) (FunTy t1 t2 r a) r_s1 (comp_use_env rx (infl_use_env r_s1 r_s2)) \<rbrakk> \<Longrightarrow>
  well_typed env r_s1 (var_abbrev v) t2 r_s1 (comp_use_env rx (infl_use_env r_s1 r_s2))"
  apply (simp add: var_abbrev_def)
  apply (simp add: ext_arr_abbrev_def)
  apply (auto)
     apply (simp add: pure_fun_def)
    apply (simp add: pure_fun_def)
   apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
    apply (auto)
  apply (rule_tac x="r_ex" in exI)
  apply (auto)
    apply (rule_tac mini_disj_diff_leq_use_env2)
     apply (rule_tac id_leq_use_env)
    apply (rule_tac r_s="diff_use_env r_s2a (comp_use_env (ereq_use_env (owner_name v) tau_x) r_ex)" in mini_disj_leq_use_env2)
     apply (rule_tac mini_disj_diff_use_env)
    apply (rule_tac r_sb="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 ra)) r_exa)" in trans_leq_use_env)
     apply (rule_tac diff_leq_use_env)
     apply (auto)
   apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
    apply (auto)
  apply (simp add: pure_fun_def)
  apply (auto)
  apply (simp add: app_req_def)
  apply (rule_tac r_sb="diff_use_env (comp_use_env rx1 rx2) (comp_use_env (comp_use_env rx1 rx2) r_exa)" in trans_leq_use_env)
   apply (simp)
  apply (rule_tac mini_disj_diff_leq_use_env2)
   apply (rule_tac comp_leq_use_env2)
   apply (simp)
  apply (rule_tac r_s="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 rx2) r_exa)" in mini_disj_leq_use_env2)
   apply (rule_tac mini_disj_diff_use_env)
  apply (rule_tac r_sb="comp_use_env rx1 rx2" in trans_leq_use_env)
   apply (rule_tac r_sb="r_s1" in trans_leq_use_env)
    apply (simp)
   apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
    apply (rule_tac r_sb="diff_use_env r_s2a (comp_use_env (ereq_use_env (owner_name v) tau_x) r_ex)" in trans_leq_use_env)
     apply (rule_tac diff_leq_use_env)
     apply (auto)
  apply (rule_tac comp_leq_use_env2)
  apply (simp)
  done

lemma ext_var_type2: "\<lbrakk> well_typed env r_s1 (ext_arr_abbrev v) (FunTy t1 t2 r a) r_s2 rx \<rbrakk> \<Longrightarrow>
  well_typed env r_s1 (var_abbrev v) t2 r_s2 rx"
  apply (simp add: ext_arr_abbrev_def)
  apply (simp add: var_abbrev_def)
  apply (auto)
     apply (simp add: pure_fun_def)
    apply (simp add: pure_fun_def)
   apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
    apply (auto)
  apply (rule_tac x="comp_use_env r_ex (comp_use_env (comp_use_env rx1 (lift_use_env rx2 ra)) r_exa)" in exI)
  apply (auto)
    apply (rule_tac r_sb="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 ra)) r_exa)" in trans_leq_use_env)
     apply (rule_tac rhs_unroll_dcl_use_env)
     apply (rule_tac rhs_unroll_dcl_use_env)
     apply (rule_tac dist_diff_leq_use_env)
     apply (rule_tac rhs_fold_dcl_use_env)
    apply (rule_tac r_sb="diff_use_env r_s2a (comp_use_env (ereq_use_env (owner_name v) tau_x) r_ex)" in trans_leq_use_env)
     apply (rule_tac dist_diff_leq_use_env)
      apply (auto)
   apply (rule_tac dist_comp_leq_use_env)
    apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
     apply (auto)
   apply (rule_tac dist_comp_leq_use_env)
    apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
     apply (rule_tac r_sb="diff_use_env r_s2a (comp_use_env (ereq_use_env (owner_name v) tau_x) r_ex)" in trans_leq_use_env)
      apply (rule_tac diff_leq_use_env)
      apply (auto)
  apply (simp add: app_req_def)
  apply (simp add: pure_fun_def)
  apply (rule_tac r_sb="diff_use_env (comp_use_env rx1 rx2) (comp_use_env (comp_use_env rx1 rx2) r_exa)" in trans_leq_use_env)
   apply (simp)
  apply (rule_tac lhs_unroll_dcl_use_env)
  apply (rule_tac lhs_unroll_dcl_use_env)
  apply (rule_tac dist_diff_leq_use_env)
  apply (rule_tac lhs_fold_dcl_use_env)
  apply (rule_tac comp_leq_use_env2)
  apply (simp)
  done

lemma spec_disj_diff_perms: "\<lbrakk> well_typed env r_s1 e tau r_s2 rx; is_sexp e;
  disj_use_env rx1 rx2; well_typed env r_s1 e tau r_s1 rx1 \<rbrakk> \<Longrightarrow>
  well_typed env (diff_use_env r_s1 rx2) e tau (diff_use_env r_s2 rx2) (diff_use_env rx rx2)"
  apply (rule_tac well_typed_diff_perms)
   apply (simp)
  apply (auto)
  apply (case_tac "r_s1 x \<noteq> NoPerm")
   apply (cut_tac ?r_s1.0="r_s1" and ?r_s2.0="r_s1" and rx="rx1" in wt_sexp_req_use)
       apply (auto)
   apply (simp add: disj_use_env_def)
   apply (simp add: own_env_vars_def)
   apply (simp add: mini_disj_use_env_def)
  apply (cut_tac x="x" and ?r_s1.0="r_s1" and env="env" and e="e" in well_typed_no_npv_use)
    apply (auto)
  done

lemma sub_sep_nres_map: "\<lbrakk> contain_env rs_map rs_map'; sep_nres_map r_s rs_map \<rbrakk> \<Longrightarrow> sep_nres_map r_s rs_map'"
  apply (simp add: sep_nres_map_def)
  apply (auto)
  apply (simp add: contain_env_def)
  apply (erule_tac x="x" in allE)
  apply (simp add: nres_lookup_def)
  apply (case_tac "rs_map' x")
   apply (auto)
   apply (rule_tac empty_strong_disj_use_env2)
  apply (erule_tac x="x" in allE)
  apply (auto)
  done

lemma simp_sep_nres_map: "\<lbrakk> disj_nres_map rs_map \<rbrakk> \<Longrightarrow> sep_nres_map (nres_lookup rs_map x) (rem_env rs_map x)"
  apply (simp add: disj_nres_map_def)
  apply (simp add: sep_nres_map_def)
  apply (auto)
  apply (case_tac "x = xa")
   apply (simp add: nres_lookup_def)
   apply (simp add: rem_env_def)
   apply (rule_tac empty_strong_disj_use_env2)
  apply (erule_tac x="x" in allE)
  apply (erule_tac x="xa" in allE)
  apply (auto)
  apply (simp add: nres_lookup_def)
  apply (simp add: rem_env_def)
  done

lemma trans_sub_use_env: "\<lbrakk> sub_use_env s r_s; leq_use_env r_x r_s \<rbrakk> \<Longrightarrow> sub_use_env s r_x"
  apply (simp add: sub_use_env_def)
  apply (simp add: leq_use_env_def)
  apply (auto)
  apply (erule_tac x="x" in allE)
  apply (erule_tac x="x" in allE)
  apply (auto)
  apply (case_tac "r_x x")
    apply (auto)
  done

lemma well_typed_ext_array: "\<lbrakk> well_typed_list env rs_list arr n t; well_typed env r_s v t r_s r_s; is_value v \<rbrakk> \<Longrightarrow>
  well_typed_list env (\<lambda>i. if i = int (length arr) + n then Some r_s else rs_list i) (ext_list arr v) n t"
  apply (induction arr arbitrary: n rs_list)
   apply (auto)
  apply (rule_tac t="1 + int (length arr) + n" and s="int (length arr) + (n + 1)" in subst)
   apply (auto)
  done

lemma spec_infl_leq_use_env: "\<lbrakk> leq_use_env r_ex r_s; mini_disj_use_env r_ex r_x; strong_use_env r_ex \<rbrakk> \<Longrightarrow> leq_use_env r_ex (infl_use_env r_s r_x)"
  apply (simp add: leq_use_env_def)
  apply (simp add: infl_use_env_def)
  apply (simp add: strong_use_env_def)
  apply (auto)
   apply (case_tac "r_ex x")
     apply (auto)
   apply (erule_tac x="x" in allE)
   apply (case_tac "r_s x")
     apply (auto)
  apply (case_tac "r_ex x")
    apply (auto)
  apply (simp add: mini_disj_use_env_def)
  done

lemma ext_path_lookup: "path_lookup rs_map x l z \<Longrightarrow> (\<exists> l. path_lookup (add_env rs_map z r_s) x l z)"
  apply (induct l arbitrary: x)
   apply (auto)
   apply (rule_tac x="Nil" in exI)
   apply (auto)
  apply (case_tac "x = z")
   apply (rule_tac x="Nil" in exI)
   apply (auto)
  apply (case_tac "rs_map x")
   apply (auto)
  apply (case_tac "\<exists> l. path_lookup (add_env rs_map z r_s) a l z")
   apply (erule_tac exE)
   apply (rule_tac x="a # la" in exI)
   apply (auto)
  apply (simp add: add_env_def)
  done

lemma ext_proper_exp: "\<lbrakk> proper_exp rs_map (VarExp (LocType x y)) \<rbrakk> \<Longrightarrow> proper_exp (add_env rs_map x r_s) (VarExp (LocType x y))"
  apply (simp add: proper_exp_def)
  apply (auto)
  apply (rule_tac l="l" in ext_path_lookup)
  apply (auto)
  done

lemma ext_proper_list: "\<lbrakk> proper_list rs_map arr; proper_exp rs_map v \<rbrakk> \<Longrightarrow> proper_list rs_map (ext_list arr v)"
  apply (induct arr)
   apply (auto)
  done

lemma scv_ext_array_alt: "
  \<lbrakk>well_typed_state s1 env rs_map; valid_exp_use_env s1 rs_map r_f; leq_use_env r_s1 r_f; are = CVApp;
        proper_exp rs_map (AppExp (AppExp (ConstExp ExtArrayConst) (VarExp (LocType ab b))) v);
        req_type tau = Ref; req_type tau_x = Ref;
        well_typed env r_s1 (ext_app_abbrev (LocType ab b) v) tau r_s2 rx; is_value v;
        s1 ab = Some (ArrValue arr); env (Loc ab) = Some tau \<rbrakk>
       \<Longrightarrow>  \<exists>g_ax. red_env env g_ax (Loc ab) = Some tau \<and>
                  (\<exists>r_ex tau_x.
                      red_env env g_ax (Loc b) = Some tau_x \<and>
                      req_type tau = Ref \<and>
                      req_type tau_x = Ref \<and>
                      leq_use_env (ereq_use_env (Loc b) tau_x) (exp_red_use_env r_s1 g_ax) \<and>
                      leq_use_env (end_red_use_env r_s2 g_ax) (diff_use_env (exp_red_use_env r_s1 g_ax) (comp_use_env (ereq_use_env (Loc b) tau_x) r_ex)) \<and>
                      leq_use_env (end_red_use_env rx g_ax) (end_red_use_env r_s2 g_ax) \<and>
                      leq_use_env r_ex (exp_red_use_env r_s1 g_ax) \<and>
                      leq_use_env (diff_use_env (ereq_use_env (Loc b) tau_x) (comp_use_env (ereq_use_env (Loc b) tau_x) r_ex)) (end_red_use_env rx g_ax)) \<and>
                  proper_exp (red_nres_map rs_map g_ax) (VarExp (LocType ab b)) \<and>
                  well_typed_state (add_env s1 ab (ArrValue (ext_list arr v))) (red_env env g_ax) (red_nres_map rs_map g_ax) \<and>
                  valid_exp_use_env (add_env s1 ab (ArrValue (ext_list arr v))) (red_nres_map rs_map g_ax) (exp_red_use_env r_f g_ax) \<and>
                  safe_act s1 (infl_use_env r_f r_s2) g_ax \<and> corr_act (UseAct b) g_ax"
  apply (simp add: ext_app_abbrev_def)
  apply (auto)
    (* - prelim: req_type tau \<noteq> Prim *)(*
  apply (case_tac "req_type tau = Prim")
   apply (cut_tac v="ab" and tau="tau" in var_value_prim1)
     apply (simp)
    apply (simp add: ext_arr_abbrev_def)
    apply (simp add: pure_fun_def)
   apply (auto)*)
  apply (simp add: app_req_def)
    (* structuring *)
  apply (cut_tac env="env" and ?r_s1.0="r_s1" and ?r_s2.0="r_s2" and v="LocType ab b" and rx="rx" and
      ?t1.0="t1" and ?t2.0="tau" and r="r" and a="a" in ext_var_type2)
   apply (rule_tac ?r_s2.0="diff_use_env r_s2a (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" and
      rx="diff_use_env rx1 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in well_typed_simul_end_perm)
      apply (rule_tac well_typed_diff_end_perm)
       apply (simp)
      apply (rule_tac dist_comp_leq_use_env)
       apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
        apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
         apply (rule_tac well_typed_perm_leq)
         apply (auto)
     apply (rule_tac well_typed_perm_leq)
     apply (auto)
    apply (rule_tac r_sb="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in trans_leq_use_env)
     apply (rule_tac dist_diff_leq_use_env)
     apply (rule_tac well_typed_perm_leq)
     apply (auto)
   apply (rule_tac r_sb="diff_use_env (comp_use_env rx1 rx2) (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in trans_leq_use_env)
    apply (simp)
   apply (rule_tac dist_diff_leq_use_env)
   apply (rule_tac self_comp_leq_use_env1)
    (* - prelim: r = Own *)
  apply (case_tac "\<not> is_own r")
   apply (simp add: ext_arr_abbrev_def)
   apply (simp add: pure_fun_def)
   apply (simp add: is_own_def)
    (* - prelim: proving the greater rx1 + rx2 are disjoint *)
  apply (cut_tac ?r_s1.0="rx1" and ?r_s2.0="infl_use_env r_s1 r_s2a" and r_ex="lift_use_env (comp_use_env rx2 (infl_use_env r_s2a r_s3)) r"in disj_comp_use_env1)
    apply (simp add: lift_comp_use_env)
    apply (rule_tac disj_comp_use_env2)
     apply (simp)
    apply (simp add: infl_lift_use_env)
    apply (rule_tac infl_disj_use_env)
    apply (rule_tac r_sb="comp_use_env rx1 (lift_use_env rx2 r)" in trans_leq_use_env)
     apply (simp)
    apply (rule_tac self_comp_leq_use_env1)
   apply (simp add: lift_comp_use_env)
   apply (rule_tac disj_comp_use_env2)
    apply (rule_tac comm_disj_use_env)
    apply (rule_tac infl_disj_use_env)
    apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
     apply (rule_tac well_typed_perm_leq)
     apply (auto)
    apply (rule_tac r_sb="comp_use_env rx1 (lift_use_env rx2 r)" in trans_leq_use_env)
     apply (simp)
    apply (rule_tac self_comp_leq_use_env2)
   apply (simp add: infl_lift_use_env)
   apply (rule_tac comm_disj_use_env)
   apply (rule_tac infl_disj_use_env)
   apply (rule_tac lhs_infl_leq_use_env)
   apply (rule_tac id_leq_use_env)
    (* showing that rx2 is removable from the var *)
  apply (cut_tac env="env" and ?r_s1.0="r_s1" and e="var_abbrev (LocType ab b)" and ?r_s2.0="r_s2" and rx="rx" and
      ?rx1.0="comp_use_env rx1 (infl_use_env r_s1 r_s2a)" and ?rx2.0="lift_use_env (comp_use_env rx2 (infl_use_env r_s2a r_s3)) r" in spec_disj_diff_perms)
      apply (auto)
    apply (simp add: var_abbrev_def)
   apply (rule_tac ext_var_type)
   apply (rule_tac ext_arr_type)
    apply (auto)
    (* - prelim: rx2 + [r_s2a - r_s3] \<le> r_f (useful inequality) *)
  apply (cut_tac r_sc="lift_use_env (comp_use_env rx2 (infl_use_env r_s2a r_s3)) r" and r_sb="r_s1" and r_sa="r_f" in trans_leq_use_env)
    apply (simp)
   apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
    apply (rule_tac well_typed_perm_leq)
    apply (auto)
   apply (simp add: lift_comp_use_env)
   apply (rule_tac dist_comp_leq_use_env)
    apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
     apply (rule_tac well_typed_perm_leq)
     apply (auto)
    apply (rule_tac r_sb="comp_use_env rx1 (lift_use_env rx2 r)" in trans_leq_use_env)
     apply (simp)
    apply (rule_tac self_comp_leq_use_env2)
   apply (simp add: infl_lift_use_env)
   apply (rule_tac lhs_infl_leq_use_env)
   apply (rule_tac id_leq_use_env)
    (* concretizing t1 *)
  apply (case_tac "ArrayTy t1 \<noteq> tau")
   apply (simp add: ext_arr_abbrev_def)
   apply (simp add: pure_fun_def)
  apply (auto)
    (* existentials *)
  apply (rule_tac x="WriteResAct ab (lift_use_env (comp_use_env rx2 (infl_use_env r_s2a r_s3)) r)" in exI)
  apply (auto)
    (* well-typedness comes easily *)
      apply (simp add: var_abbrev_def)
    (* proving properness *)
     apply (rule_tac ext_proper_exp)
     apply (simp add: proper_exp_def)
    (* proving the state remains well-typed *)
   apply (simp add: well_typed_state_def)
   apply (auto)
    (* environment contained in the state *)
     apply (rule_tac add_sub_env)
     apply (simp)
    (* validity: res_map completeness *)
    apply (simp add: valid_nres_map_def)
    apply (auto)
      apply (rule_tac add_full_nres_map)
      apply (simp)
    (* - res_map self disjointness *)
     apply (rule_tac disj_add_nres_map)
      apply (simp)
     apply (rule_tac comp_sep_nres_map)
      apply (rule_tac simp_sep_nres_map)
      apply (simp)
     apply (rule_tac r_s="r_f" in leq_sep_nres_map)
      apply (simp)
     apply (simp add: valid_exp_use_env_def)
     apply (auto)
     apply (rule_tac rs_map="rs_map" in sub_sep_nres_map)
      apply (rule_tac rem_contain_env)
      apply (rule_tac id_contain_env)
     apply (simp)
    (* - res_map element containment *)
    apply (rule_tac dist_add_sub_nres_map)
     apply (simp)
    apply (rule_tac comp_sub_use_env)
     apply (simp add: sub_nres_map_def)
    apply (rule_tac r_s="r_f" in trans_sub_use_env)
     apply (simp add: valid_exp_use_env_def)
    apply (simp)
    (* proving that the array is still well-typed + proper: xa \<noteq> deref_name x ab case *)
    apply (case_tac "x \<noteq> ab")
     apply (simp add: add_env_def)
     apply (erule_tac x="x" in allE)
     apply (case_tac "s1 x")
      apply (auto)
     apply (case_tac "env (Loc x)")
      apply (auto)
      apply (simp add: nres_lookup_def)
      apply (simp add: add_env_def)
    (* - properness *)
     apply (rule_tac proper_add_mv)
      apply (simp)
     apply (rule_tac self_comp_leq_use_env1)
    (* xa = deref_name x ab case *)
    apply (case_tac "add_env s1 ab (ArrValue (ext_list arr v)) ab = None")
     apply (simp add: add_env_def)
    apply (auto)
     apply (simp add: add_env_def)
   apply (erule_tac x="ab" in allE)
   apply (auto)
   apply (rule_tac x="(\<lambda> i. if i = int (length arr) then Some (lift_use_env (comp_use_env rx2 (infl_use_env r_s2a r_s3)) r) else rs_list i)" in exI)
  apply (auto)
    (* - proving the function used to type the array is valid *)
    apply (simp add: valid_res_list_def)
    apply (auto)
    (* - i = length arr *)
       apply (simp add: nres_lookup_def)
       apply (rule_tac self_comp_leq_use_env2)
      apply (simp add: disj_res_list_def)
      apply (auto)
      apply (erule_tac x="j" in allE)
      apply (auto)
      apply (rule_tac r_s="nres_lookup rs_map ab" in strong_disj_leq_use_env2)
       apply (rule_tac r_s="r_f" in strong_disj_leq_use_env1)
        apply (simp add: valid_exp_use_env_def)
        apply (simp add: sep_nres_map_def)
       apply (simp_all)
    (* - i \<noteq> length arr *)
     apply (simp add: nres_lookup_def)
     apply (rule_tac comp_leq_use_env1)
     apply (erule_tac x="i" in allE)
     apply (auto)
    apply (simp add: disj_res_list_def)
    apply (erule_tac x="i" in allE)
    apply (auto)
    apply (rule_tac r_s="nres_lookup rs_map ab" in strong_disj_leq_use_env1)
     apply (rule_tac r_s="r_f" in strong_disj_leq_use_env2)
      apply (rule_tac comm_strong_disj_use_env)
      apply (simp add: valid_exp_use_env_def)
      apply (simp add: sep_nres_map_def)
     apply (auto)
    (* actual array well-typedness + properness *)
   apply (cut_tac env="env" and arr="arr" and v="v" and n="0" and t="t1" and rs_list="rs_list" in well_typed_ext_array)
      apply (auto)
   apply (rule_tac well_typed_lift_req)
    apply (rule_tac well_typed_lift_perms)
    apply (rule_tac infl_sexp_wp)
     apply (auto)
    apply (rule_tac value_is_sexp)
    apply (simp)
  apply (rule_tac id_leq_use_env)
    (* - properness *)
    apply (rule_tac proper_add_mv)
     apply (erule_tac x="ab" in allE)
     apply (simp add: add_env_def)
     apply (auto)
     apply (rule_tac ext_proper_list)
      apply (auto)
     apply (simp add: proper_exp_def)
    apply (rule_tac self_comp_leq_use_env1)
    (* validity of expression permissions: containment *)
  apply (simp add: valid_exp_use_env_def)
  apply (auto)
   apply (rule_tac r_s="r_f" in trans_sub_use_env)
    apply (rule_tac add_sub_use_env)
    apply (simp)
   apply (rule_tac self_diff_leq_use_env)
    (* - separation of permissions *)
  apply (rule_tac add_sep_nres_map)
   apply (rule_tac r_s="r_f" in leq_sep_nres_map)
    apply (rule_tac self_diff_leq_use_env)
   apply (simp)
  apply (rule_tac strong_disj_comp_use_env1)
   apply (rule_tac r_s="r_f" in strong_disj_leq_use_env1)
    apply (simp add: sep_nres_map_def)
   apply (rule_tac self_diff_leq_use_env)
  apply (rule_tac diff_strong_disj_use_env)
  apply (rule_tac strong_lift_use_env)
   apply (simp)
    (* - action safety *)
  apply (rule_tac spec_infl_leq_use_env)
    apply (simp)
   apply (simp add: lift_comp_use_env)
   apply (rule_tac mini_disj_comp_use_env)
    apply (rule_tac r_s="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in mini_disj_leq_use_env2)
     apply (rule_tac r_s="comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex" in mini_disj_leq_use_env1)
      apply (rule_tac mini_disj_diff_use_env)
     apply (rule_tac comp_leq_use_env1)
     apply (rule_tac self_comp_leq_use_env2)
    apply (simp)
   apply (simp add: infl_lift_use_env)
   apply (rule_tac gen_mini_disj_use_env2)
   apply (rule_tac infl_disj_use_env)
   apply (rule_tac r_sb="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in trans_leq_use_env)
    apply (rule_tac self_diff_leq_use_env)
   apply (simp)
  apply (rule_tac strong_lift_use_env)
  apply (simp add: is_own_def)
  done

    (* ##### array write case ##### *)

definition write_arr_abbrev where
  "write_arr_abbrev v = AppExp (ConstExp WriteConst) (VarExp v)"

definition write_pair_abbrev where
  "write_pair_abbrev i v = PairExp (ConstExp (IConst i)) v"

definition write_app_abbrev where
  "write_app_abbrev a i v = AppExp (write_arr_abbrev a) (write_pair_abbrev i v)"

lemma write_var_type: "\<lbrakk> well_typed env r_s1 (write_pair_abbrev i v) (PairTy t1 t2 r) r_s2 rx; is_own r \<rbrakk> \<Longrightarrow>
  well_typed env r_s1 v t2 r_s2 rx"
  apply (simp add: write_pair_abbrev_def)
  apply (auto)
  apply (case_tac "req_type (PairTy t1 t2 r) = Prim")
   apply (simp add: is_own_def)
  apply (simp add: pair_req_def)
  apply (rule_tac ?r_s2.0="diff_use_env r_s3 r_ex" and rx="diff_use_env rx2 r_ex" in
      well_typed_simul_end_perm)
     apply (rule_tac well_typed_diff_end_perm)
      apply (rule_tac ?r_s1.0="r_s2a" in well_typed_incr_start_perm)
       apply (auto)
  apply (rule_tac r_sb="diff_use_env (comp_use_env (lift_use_env rx1 r) (lift_use_env rx2 r)) r_ex" in trans_leq_use_env)
   apply (simp)
  apply (rule_tac dist_diff_leq_use_env)
  apply (rule_tac comp_leq_use_env2)
  apply (rule_tac self_lift_leq_use_env)
  done

    (* in principle this is true because for each part of the list, the element is either
      "still" well-typed, or it has been replaced with v which is well-typed.
    *)

lemma corr_write_array_zero: "\<lbrakk> Some (a # arr') = write_array arr 0 v \<rbrakk> \<Longrightarrow> (\<exists> b. arr = b # arr' \<and> a = v)"
  apply (case_tac arr)
   apply (auto)
  done

lemma corr_write_array_nz: "\<lbrakk> Some (a # arr') = write_array arr i v; i \<noteq> 0 \<rbrakk> \<Longrightarrow>
  (\<exists> arr_x. arr = a # arr_x \<and> Some arr' = write_array arr_x (i - 1) v)"
  apply (case_tac arr)
   apply (auto)
   apply (case_tac "write_array list (i - 1) v")
    apply (auto)
  apply (case_tac "write_array list (i - 1) v")
   apply (auto)
  done

lemma zero_sum: "\<lbrakk> (n:: int) = (i :: int) + n \<rbrakk> \<Longrightarrow> i = 0"
  apply (auto)
  done

lemma wtwa_add_rev: "\<lbrakk> well_typed_list env rs_list arr (n + i) t; i > 0 \<rbrakk> \<Longrightarrow>
  well_typed_list env (\<lambda>j. if j = n then Some r_s else rs_list j) arr ((n :: int) + i) t"
  apply (induct arr arbitrary: i)
   apply (auto)
  apply (case_tac "n + i + 1 = n + (i + 1)")
   apply (auto)
  apply (rule_tac t="n + i + 1" and s="n + (i + 1)" in subst)
   apply (auto)
  done

lemma proper_write_array: "\<lbrakk> proper_list rs_map arr; proper_exp rs_map v; Some arr' = write_array arr i v \<rbrakk> \<Longrightarrow> proper_list rs_map arr'"
  apply (induct arr' arbitrary: i arr)
   apply (auto)
   apply (case_tac arr)
    apply (auto)
   apply (case_tac "i = 0")
    apply (auto)
   apply (case_tac "write_array list (i - 1) v")
    apply (auto)
  apply (case_tac arr)
   apply (auto)
  apply (case_tac "i = 0")
   apply (auto)
  apply (case_tac "write_array list (i - 1) v")
   apply (auto)
  apply (case_tac "Some ab = write_array list (i - 1) v")
   apply (iprover)
  apply (auto)
  done

lemma well_typed_write_array: "\<lbrakk> well_typed_list env rs_list arr n t; well_typed env r_s v t r_s r_s;
  Some arr' = write_array arr i v; is_value v \<rbrakk> \<Longrightarrow>
  well_typed_list env (\<lambda>j. if j = i + n then Some r_s else rs_list j) arr' (n :: int) t"
  apply (induct arr' arbitrary: n i arr)
   apply (auto)
    (* n = i, (i = 0) *)
     apply (cut_tac arr="arr" and arr'="arr'" and v="v" and a="a" in corr_write_array_zero)
      apply (auto)
    apply (cut_tac arr="arr" and arr'="arr'" and v="v" and a="a" in corr_write_array_zero)
     apply (auto)
    (* - to prove that the remainder is well-typed, we claim it is the same remainder as the original *)
   apply (cut_tac arr="arr" and arr'="arr'" and v="v" and a="a" in corr_write_array_zero)
    apply (auto)
   apply (rule_tac wtwa_add_rev)
    apply (auto)
    (* n \<noteq> i *)
  apply (cut_tac arr="arr" and arr'="arr'" and v="v" and a="a" in corr_write_array_nz)
    apply (auto)
  apply (rule_tac t="i + n" and s="(i - 1) + (n + 1)" in subst)
   apply (simp)
  apply (iprover)
  done

lemma scv_write_case: "\<lbrakk>well_typed_state s1 env rs_map; valid_exp_use_env s1 rs_map r_f; leq_use_env r_s1 r_f; are = CVApp;
        proper_exp rs_map (AppExp (AppExp (ConstExp WriteConst) (VarExp (LocType ab b))) (PairExp (ConstExp (IConst i)) v));
        well_typed env r_s1 (write_app_abbrev (LocType ab b) i v) tau r_s2 rx; is_value v;
        FunTy t1a (FunTy (PairTy IntTy t2 rb) tau r a) ra aa = pure_fun (ArrayTy t) (FunTy (PairTy IntTy t OwnPerm) UnitTy OwnPerm Ref) Prim;
        ax = UseAct x; s1 ab = Some (ArrValue arr); Some arr' = write_array arr i v;
        env (Loc ab) = Some t1a \<rbrakk>
       \<Longrightarrow> \<exists>g_ax. well_typed (red_env env g_ax) (exp_red_use_env r_s1 g_ax) unit_exp tau (end_red_use_env r_s2 g_ax) (end_red_use_env rx g_ax) \<and>
                  proper_exp (red_nres_map rs_map g_ax) unit_exp \<and>
                  well_typed_state (add_env s1 ab (ArrValue arr')) (red_env env g_ax) (red_nres_map rs_map g_ax) \<and>
                  valid_exp_use_env (add_env s1 ab (ArrValue arr')) (red_nres_map rs_map g_ax) (exp_red_use_env r_f g_ax) \<and>
                  safe_act s1 (infl_use_env r_f r_s2) g_ax \<and> corr_act (UseAct b) g_ax"
  apply (simp add: write_app_abbrev_def)
  apply (auto)
  apply (case_tac "t1 \<noteq> PairTy IntTy t2 rb")
   apply (simp add: write_arr_abbrev_def)
   apply (simp add: pure_fun_def)
   apply (auto)
    (* get the well-typedness statement for the value *)
  apply (cut_tac env="env" and ?r_s1.0="r_s2a" and i="i" and v="v" and ?t1.0="IntTy" and ?t2.0="t2" and
      r="rb" and ?r_s2.0="r_s3" and rx="rx2" in write_var_type)
    apply (auto)
   apply (simp add: is_own_def)
   apply (simp add: pure_fun_def)
    (* prelim: r = Own *)
  apply (case_tac "\<not> is_own r")
   apply (simp add: is_own_def)
   apply (simp add: pure_fun_def)
    (* prelim: r = rc *)
  apply (case_tac "r \<noteq> rc")
   apply (simp add: write_arr_abbrev_def)
   apply (simp add: pure_fun_def)
    (* prelim: constructed rx2 \<le> r_f *)
  apply (cut_tac r_sc="lift_use_env (comp_use_env rx2 (infl_use_env r_s2a r_s3)) r" and r_sb="r_s1" and r_sa="r_f" in trans_leq_use_env)
    apply (simp)
   apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
    apply (rule_tac well_typed_perm_leq)
    apply (auto)
   apply (simp add: lift_comp_use_env)
   apply (rule_tac dist_comp_leq_use_env)
    apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
     apply (rule_tac well_typed_perm_leq)
     apply (auto)
    apply (rule_tac r_sb="comp_use_env rx1 (lift_use_env rx2 r)" in trans_leq_use_env)
     apply (simp)
    apply (rule_tac self_comp_leq_use_env2)
   apply (simp add: infl_lift_use_env)
   apply (rule_tac lhs_infl_leq_use_env)
   apply (rule_tac id_leq_use_env)
    (* well-typedness statement *)
  apply (rule_tac x="WriteResAct ab (lift_use_env (comp_use_env rx2 (infl_use_env r_s2a r_s3)) r)" in exI)
  apply (auto)
      apply (simp add: unit_exp_def)
      apply (auto)
        apply (simp add: pure_fun_def)
       apply (rule_tac dist_diff_leq_use_env)
       apply (rule_tac r_sb="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in trans_leq_use_env)
        apply (rule_tac diff_leq_use_env)
        apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
         apply (rule_tac well_typed_perm_leq)
         apply (auto)
       apply (rule_tac well_typed_perm_leq)
       apply (auto)
      apply (rule_tac dist_diff_leq_use_env)
      apply (simp)
    (* properness *)
     apply (simp add: proper_exp_def)
     apply (simp add: unit_exp_def)
    (* proving the state remains well-typed *)
    apply (simp add: well_typed_state_def)
    apply (auto)
    (* containment of env in state *)
      apply (rule_tac add_sub_env)
      apply (simp)
    (* validity of res_map: completeness *)
     apply (simp add: valid_nres_map_def)
     apply (auto)
       apply (rule_tac add_full_nres_map)
       apply (simp)
    (* - disjointness *)
      apply (rule_tac disj_add_nres_map)
       apply (simp)
      apply (rule_tac comp_sep_nres_map)
       apply (rule_tac simp_sep_nres_map)
       apply (simp)
      apply (rule_tac r_s="r_f" in leq_sep_nres_map)
       apply (simp)
      apply (simp add: valid_exp_use_env_def)
      apply (rule_tac rs_map="rs_map" in sub_sep_nres_map)
       apply (rule_tac rem_contain_env)
       apply (rule_tac id_contain_env)
      apply (simp)
    (* - element containment *)
     apply (rule_tac dist_add_sub_nres_map)
      apply (simp)
     apply (rule_tac comp_sub_use_env)
      apply (simp add: sub_nres_map_def)
     apply (rule_tac r_s="r_f" in trans_sub_use_env)
      apply (simp add: valid_exp_use_env_def)
     apply (simp)
    (* proving that the array is still well-typed + proper : xa \<noteq> deref_name x ab *)
    apply (case_tac "xa \<noteq> ab")
     apply (erule_tac x="xa" in allE)
     apply (simp add: add_env_def)
     apply (auto)
     apply (case_tac "s1 xa")
      apply (auto)
     apply (case_tac "env (Loc xa)")
      apply (auto)
      apply (simp add: nres_lookup_def)
      apply (simp add: add_env_def)
    (* - properness *)
     apply (rule_tac proper_add_mv)
      apply (simp)
     apply (rule_tac self_comp_leq_use_env1)
    (* xa = deref_name x ab case *)
    apply (case_tac "add_env s1 ab (ArrValue arr') ab = None")
     apply (simp add: add_env_def)
    apply (auto)
     apply (simp add: add_env_def)
     apply (erule_tac x="ab" in allE)
     apply (auto)
     apply (rule_tac x="(\<lambda> j. if j = i then Some (lift_use_env (comp_use_env rx2 (infl_use_env r_s2a r_s3)) r) else rs_list j)" in exI)
     apply (auto)
    (* validity of res map function: ia = i *)
      apply (simp add: valid_res_list_def)
      apply (auto)
         apply (simp add: nres_lookup_def)
         apply (rule_tac self_comp_leq_use_env2)
        apply (simp add: disj_res_list_def)
        apply (auto)
        apply (erule_tac x="j" in allE)
        apply (auto)
        apply (rule_tac r_s="r_f" in strong_disj_leq_use_env1)
         apply (rule_tac r_s="nres_lookup rs_map ab" in strong_disj_leq_use_env2)
          apply (simp add: valid_exp_use_env_def)
          apply (simp add: sep_nres_map_def)
         apply (auto)
    (* ia \<noteq> i *)
       apply (simp add: nres_lookup_def)
       apply (erule_tac x="ia" in allE)
       apply (auto)
       apply (rule_tac comp_leq_use_env1)
       apply (simp)
      apply (simp add: disj_res_list_def)
      apply (erule_tac x="ia" in allE)
      apply (auto)
      apply (rule_tac r_s="nres_lookup rs_map ab" in strong_disj_leq_use_env1)
       apply (rule_tac r_s="r_f" in strong_disj_leq_use_env2)
        apply (rule_tac comm_strong_disj_use_env)
        apply (simp add: valid_exp_use_env_def)
        apply (simp add: sep_nres_map_def)
       apply (auto)
    (* proving the array itself still types *)
     apply (cut_tac env="env" and i="i" and n="0" and arr="arr" and arr'="arr'" and r_s="lift_use_env (comp_use_env rx2 (infl_use_env r_s2a r_s3)) r" and
      rs_list="rs_list" in well_typed_write_array)
         apply (auto)
     apply (rule_tac well_typed_lift_req)
      apply (rule_tac well_typed_lift_perms)
      apply (rule_tac infl_sexp_wp)
       apply (simp add: pure_fun_def)
      apply (rule_tac value_is_sexp)
      apply (auto)
     apply (rule_tac id_leq_use_env)
    (* proving the array is still proper *)
    apply (erule_tac x="ab" in allE)
    apply (auto)
    apply (rule_tac proper_add_mv)
     apply (simp add: add_env_def)
     apply (auto)
     apply (rule_tac v="v" in proper_write_array)
       apply (auto)
     apply (simp add: proper_exp_def)
    apply (rule_tac self_comp_leq_use_env1)
    (* proving validity of the new permission map: containment in state *)
   apply (simp add: valid_exp_use_env_def)
   apply (auto)
    apply (rule_tac add_sub_use_env)
    apply (rule_tac r_s="r_f" in trans_sub_use_env)
     apply (simp)
    apply (rule_tac self_diff_leq_use_env)
    (* separation *)
   apply (rule_tac add_sep_nres_map)
    apply (rule_tac r_s="r_f" in leq_sep_nres_map)
     apply (rule_tac self_diff_leq_use_env)
    apply (simp)
   apply (rule_tac strong_disj_comp_use_env1)
    apply (rule_tac r_s="r_f" in strong_disj_leq_use_env1)
     apply (simp add: sep_nres_map_def)
    apply (rule_tac self_diff_leq_use_env)
   apply (rule_tac diff_strong_disj_use_env)
   apply (rule_tac strong_lift_use_env)
   apply (simp)
    (* - action safety *)
  apply (rule_tac spec_infl_leq_use_env)
    apply (simp)
   apply (simp add: lift_comp_use_env)
   apply (rule_tac mini_disj_comp_use_env)
    apply (rule_tac r_s="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in mini_disj_leq_use_env2)
     apply (rule_tac r_s="comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex" in mini_disj_leq_use_env1)
      apply (rule_tac mini_disj_diff_use_env)
     apply (rule_tac comp_leq_use_env1)
     apply (rule_tac self_comp_leq_use_env2)
    apply (simp)
   apply (simp add: infl_lift_use_env)
   apply (rule_tac gen_mini_disj_use_env2)
   apply (rule_tac infl_disj_use_env)
   apply (rule_tac r_sb="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in trans_leq_use_env)
    apply (rule_tac self_diff_leq_use_env)
   apply (simp)
  apply (rule_tac strong_lift_use_env)
  apply (simp add: is_own_def)
  done

    (* ##### array read case ##### *)

lemma well_typed_lookup_array: "\<lbrakk> well_typed_state s env rs_map; read_array arr i = Some v; s x = Some (ArrValue arr); env (Loc x) = Some (ArrayTy tau) \<rbrakk> \<Longrightarrow>
  (\<exists> rs_list. valid_res_list (nres_lookup rs_map x) rs_list \<and> well_typed_list env rs_list arr 0 tau)"
  apply (simp add: well_typed_state_def)
  apply (auto)
  apply (erule_tac x="x" in allE)
  apply (auto)
  done

lemma well_typed_list_elem: "\<lbrakk> well_typed_list env rs_list arr n tau; read_array arr (i :: int) = Some v \<rbrakk> \<Longrightarrow>
  (\<exists> r_x. rs_list (n + i) = Some r_x \<and> well_typed env r_x v tau r_x r_x \<and> is_value v)"
  apply (induct arr arbitrary: n i)
   apply (auto)
  apply (case_tac "i = 0")
   apply (auto)
  apply (case_tac "\<not> (\<exists>r_x. rs_list ((n + 1) + (i - 1)) = Some r_x \<and> well_typed env r_x v tau r_x r_x \<and> is_value v)")
   apply (iprover)
  apply (auto)
  done

lemma well_typed_lookup_array_elem: "\<lbrakk> well_typed_state s env rs_map; read_array arr i = Some v; s x = Some (ArrValue arr); env (Loc x) = Some (ArrayTy tau) \<rbrakk> \<Longrightarrow>
  (\<exists> rs_list r_x. unlim tau \<and> valid_res_list (nres_lookup rs_map x) rs_list \<and> rs_list i = Some r_x \<and> well_typed env r_x v tau r_x r_x \<and> is_value v)"
  apply (simp add: well_typed_state_def)
  apply (auto)
   apply (erule_tac x="x" in allE)
   apply (auto)
  apply (erule_tac x="x" in allE)
  apply (auto)
  apply (rule_tac x="rs_list" in exI)
  apply (auto)
  apply (cut_tac rs_list="rs_list" and arr="arr" and n="0" and i="i" in well_typed_list_elem)
    apply (auto)
  done

lemma wts_mem_val_env: "\<lbrakk> well_typed_state s env rs_map \<rbrakk> \<Longrightarrow> mem_val_env env"
  apply (simp add: mem_val_env_def)
  apply (auto)
  apply (case_tac "env x")
   apply (auto)
  apply (simp add: well_typed_state_def)
  apply (auto)
  apply (simp add: sub_env_def)
  apply (erule_tac x="x" in allE)
  apply (auto)
  apply (erule_tac x="y" in allE)
  apply (auto)
  apply (case_tac ya)
  apply (auto)
  done
    (*
lemma ack_exp_value: "\<lbrakk> is_value e \<rbrakk> \<Longrightarrow> is_value (set_own e a)"
  apply (induct e)
        apply (auto)
   apply (case_tac x)
    apply (auto)
  apply (case_tac e1)
        apply (auto)
  done*)
  (*
lemma finish_is_value: "\<lbrakk> is_value e \<rbrakk> \<Longrightarrow> is_value (finish_value s e)"
  apply (induct e)
        apply (auto)
    apply (case_tac x2a)
      apply (auto)
   apply (case_tac x2a)
     apply (auto)
  apply (case_tac e1)
        apply (auto)
  done
    *)
lemma alpha_rename_is_value: "\<lbrakk> is_value e \<rbrakk> \<Longrightarrow> is_value (deep_alpha_rename e a b)"
  apply (induct e)
        apply (auto)
   apply (case_tac x)
    apply (auto)
  apply (case_tac e1)
        apply (auto)
  done

lemma lam_var_remove_is_value: "\<lbrakk> is_value e \<rbrakk> \<Longrightarrow> is_value (lam_var_remove e a b)"
  apply (induct e)
        apply (auto)
  apply (case_tac e1)
        apply (auto)
  done

lemma lam_var_list_remove_is_value: "\<lbrakk> is_value e \<rbrakk> \<Longrightarrow> is_value (lam_var_list_remove e vl)"
  apply (induct vl arbitrary: e)
   apply (auto)
  apply (cut_tac e="e" and a="a" and b="b" in lam_var_remove_is_value)
   apply (auto)
  done

lemma proper_path_lookup: "\<lbrakk> rs_map a = Some r_s; proper_exp rs_map (VarExp (LocType a b)) \<rbrakk> \<Longrightarrow> (\<exists> l. path_lookup rs_map b l a)"
  apply (simp add: proper_exp_def)
  done

lemma read_proper_exp: "\<lbrakk> proper_list rs_map arr; read_array arr i = Some v \<rbrakk> \<Longrightarrow> proper_exp rs_map v"
  apply (induct arr arbitrary: i)
   apply (auto)
  apply (case_tac "i = 0")
   apply (auto)
  done

lemma scv_read_case:
  "\<lbrakk>well_typed_state s1 env rs_map; valid_exp_use_env s1 rs_map r_f; leq_use_env r_s1 r_f; are = CVApp;
        proper_exp rs_map (AppExp (AppExp (ConstExp ReadConst) (VarExp (LocType ab b))) (ConstExp (IConst i))); leq_use_env r_s2aa r_s1;
        leq_use_env r_s2 (diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)); leq_use_env rx1a r_s2aa;
        leq_use_env r_s2a (diff_use_env r_s3a (comp_use_env (comp_use_env rx1a (lift_use_env rx2a ra)) r_exa));
        leq_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_s3; disj_use_env rx1 (lift_use_env rx2 r); leq_use_env rx r_s2;
        leq_use_env (comp_use_env rx1a (lift_use_env rx2a ra)) r_s3a; leq_use_env r_ex r_s1; leq_use_env (app_req rx1 rx2 r tau r_ex) rx;
        leq_use_env r_exa r_s1;
        leq_use_env (app_req rx1a rx2a ra (FunTy IntTy tau r a) r_exa) rx1; c = ReadConst;
        FunTy t1a (FunTy IntTy tau r a) ra aa = pure_fun (ArrayTy t) (pure_fun IntTy t Ref) Prim; unlim t; v1 = VarExp (LocType ab b); v2 = ConstExp (IConst i);
        ax = UseAct b; s1 ab = Some (ArrValue arr); read_array arr i = Some v; s2 = s1; e2 = set_own v b; t1 = IntTy; env (Loc ab) = Some t1a;
        leq_use_env r_s3 r_s2a; leq_use_env rx2 r_s3; env (Loc b) = Some tau_x; req_type t1a = Ref; req_type tau_x = Ref;
        leq_use_env (ereq_use_env (Loc b) tau_x) r_s2aa; leq_use_env r_s3a (diff_use_env r_s2aa (comp_use_env (ereq_use_env (Loc b) tau_x) r_exb));
        leq_use_env rx2a r_s3a; leq_use_env r_exb r_s2aa;
        leq_use_env (diff_use_env (ereq_use_env (Loc b) tau_x) (comp_use_env (ereq_use_env (Loc b) tau_x) r_exb)) rx2a\<rbrakk>
       \<Longrightarrow> \<exists>g_ax. well_typed (red_env env g_ax) (exp_red_use_env r_s1 g_ax) (set_own v b) tau (end_red_use_env r_s2 g_ax) (end_red_use_env rx g_ax) \<and>
                  proper_exp (red_nres_map rs_map g_ax) (set_own v b) \<and>
                  well_typed_state s1 (red_env env g_ax) (red_nres_map rs_map g_ax) \<and>
                  valid_exp_use_env s1 (red_nres_map rs_map g_ax) (exp_red_use_env r_f g_ax) \<and> safe_act s1 (infl_use_env r_f r_s2) g_ax \<and> corr_act (UseAct b) g_ax"
    (* array read case *)
    (* - first we have to extract the type of e2. *)
  apply (cut_tac rs_map="rs_map" and s="s1" and env="env" and i="i" and v="v" and x="ab" and arr="arr" in well_typed_lookup_array_elem)
      apply (auto)
   apply (simp add: pure_fun_def)
  apply (rule_tac x="ReadResAct" in exI)
  apply (auto)
    (* - the idea here is that e2 should be re-typed so that all of its permissions are encompassed by x3. *)
  apply (cut_tac env="env" and s="s1" and rs_map="rs_map" in wts_mem_val_env)
   apply (auto)
  apply (case_tac "\<not> mem_ty tau_x")
   apply (simp add: mem_val_env_def)
   apply (erule_tac x="Loc b" in allE)
   apply (auto)
  apply (cut_tac env="env" and r_x="r_x" and e="v" and tau="t" and t="tau_x" and b="b" and r_s="one_use_env (Loc b) UsePerm" and s="s1" in well_typed_set_own)
          apply (auto)
     apply (simp add: one_use_env_def)
    apply (simp add: well_typed_state_def)
  apply (simp add: mem_val_env_def)
  apply (erule_tac x="Loc b" in allE)
  apply (auto)
    (* prelim: r_s2 \<le> r_s1 *)
  apply (cut_tac r_sc="r_s3" and r_sb="diff_use_env r_s3a (comp_use_env (comp_use_env rx1a (lift_use_env rx2a ra)) r_exa)" and r_sa="r_s1" in trans_leq_use_env)
    apply (rule_tac diff_leq_use_env)
    apply (rule_tac r_sb="diff_use_env r_s2aa (comp_use_env (ereq_use_env (Loc b) tau_x) r_exb)" in trans_leq_use_env)
     apply (rule_tac diff_leq_use_env)
     apply (simp_all)
   apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
    apply (auto)
  apply (cut_tac r_sc="r_s2" and r_sb="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" and r_sa="r_s1" in trans_leq_use_env)
    apply (rule_tac diff_leq_use_env)
    apply (auto)
    (* analysis based on whether x3 is in rx or not *)
  apply (case_tac "rx (Loc b) \<noteq> NoPerm")
   apply (case_tac "\<not> leq_use_env (one_use_env (Loc b) UsePerm) rx")
    apply (simp add: leq_use_env_def)
    apply (simp add: one_use_env_def)
    apply (auto)
    apply (case_tac "Loc b = x")
     apply (auto)
    apply (case_tac "rx (Loc b)")
      apply (auto)
   apply (rule_tac ?r_s1.0="r_s2" in well_typed_incr_start_perm)
    apply (rule_tac rx="one_use_env (Loc b) UsePerm" in well_typed_incr_req)
      apply (rule_tac r_s="one_use_env (Loc b) UsePerm" in well_typed_incr_simul_perm)
       apply (rule_tac r_sb="rx" in trans_leq_use_env)
        apply (auto)
   apply (simp add: pure_fun_def)
    (* prelim: x3 \<le> r_s1 *)
  apply (cut_tac r_sc="one_use_env (Loc b) UsePerm" and r_sb="ereq_use_env (Loc b) tau_x" and r_sa="r_s1" in trans_leq_use_env)
    apply (rule_tac r_sb="r_s2aa" in trans_leq_use_env)
     apply (simp_all)
   apply (simp add: ereq_use_env_def)
   apply (simp add: leq_use_env_def)
   apply (simp add: one_use_env_def)
   apply (simp add: end_req_perm_def)
    (* case where t2 = Prim *)
  apply (simp add: app_req_def)
  apply (case_tac "req_type tau = Prim")
   apply (auto)
   apply (rule_tac ?r_s2.0="r_s1" and rx="empty_use_env" in well_typed_simul_end_perm)
      apply (rule_tac rx="one_use_env (Loc b) UsePerm" in wt_sexp_no_req)
        apply (rule_tac r_s="one_use_env (Loc b) UsePerm" in well_typed_incr_simul_perm)
         apply (auto)
    apply (simp add: pure_fun_def)
   apply (rule_tac value_is_sexp)
   apply (rule_tac v="v" in set_own_value)
     apply (auto)
    (* otherwise, since rx x3 = NoPerm, we prepare a diff *)
  apply (rule_tac ?r_s2.0="diff_use_env r_s1 (comp_use_env (comp_use_env (comp_use_env (ereq_use_env (Loc b) tau_x) r_exb)
          (comp_use_env (comp_use_env rx1a (lift_use_env rx2a ra)) r_exa))
          (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex))" and
      rx="diff_use_env (one_use_env (Loc b) UsePerm) (comp_use_env (comp_use_env (comp_use_env (ereq_use_env (Loc b) tau_x) r_exb)
          (comp_use_env (comp_use_env rx1a (lift_use_env rx2a ra)) r_exa))
          (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex))" in well_typed_simul_end_perm)
     apply (rule_tac well_typed_diff_end_perm)
      apply (rule_tac r_s="one_use_env (Loc b) UsePerm" in well_typed_incr_simul_perm)
       apply (simp)
      apply (simp add: pure_fun_def)
     apply (rule_tac dist_comp_leq_use_env)
      apply (rule_tac dist_comp_leq_use_env)
       apply (rule_tac r_sb="r_s2aa" in trans_leq_use_env)
        apply (auto)
      apply (rule_tac dist_comp_leq_use_env)
       apply (auto)
    apply (rule_tac dist_comp_leq_use_env)
      apply (auto)
     apply (rule_tac r_sb="r_s3a" in trans_leq_use_env)
      apply (rule_tac r_sb="diff_use_env r_s2aa (comp_use_env (ereq_use_env (Loc b) tau_x) r_exb)" in trans_leq_use_env)
       apply (rule_tac diff_leq_use_env)
       apply (auto)
    apply (rule_tac dist_comp_leq_use_env)
     apply (auto)
    apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
     apply (auto)
   apply (rule_tac r_sb="diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in trans_leq_use_env)
    apply (rule_tac rhs_unroll_dcl_use_env)
    apply (rule_tac dist_diff_leq_use_env)
    apply (rule_tac r_sb="diff_use_env r_s3a (comp_use_env (comp_use_env rx1a (lift_use_env rx2a ra)) r_exa)" in trans_leq_use_env)
     apply (rule_tac rhs_unroll_dcl_use_env)
     apply (rule_tac dist_diff_leq_use_env)
     apply (rule_tac r_sb="diff_use_env r_s2aa (comp_use_env (ereq_use_env (Loc b) tau_x) r_exb)" in trans_leq_use_env)
    apply (rule_tac dist_diff_leq_use_env)
      apply (auto)
   apply (rule_tac r_sb="r_s2a" in trans_leq_use_env)
    apply (auto)
  apply (rule_tac r_sb="diff_use_env (comp_use_env rx1 rx2) (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in trans_leq_use_env)
   apply (simp)
  apply (rule_tac lhs_unroll_dcl_use_env)
  apply (rule_tac dist_diff_leq_use_env)
  apply (rule_tac comp_leq_use_env1)
  apply (simp add: pure_fun_def)
  apply (rule_tac r_sb="diff_use_env (comp_use_env rx1a rx2a) (comp_use_env (comp_use_env rx1a (lift_use_env rx2a ra)) r_exa)" in trans_leq_use_env)
   apply (auto)
  apply (rule_tac lhs_unroll_dcl_use_env)
  apply (rule_tac dist_diff_leq_use_env)
  apply (rule_tac comp_leq_use_env2)
  apply (rule_tac r_sb="diff_use_env (ereq_use_env (Loc b) tau_x) (comp_use_env (ereq_use_env (Loc b) tau_x) r_exb)" in trans_leq_use_env)
   apply (simp)
  apply (rule_tac dist_diff_leq_use_env)
  apply (simp add: ereq_use_env_def)
  apply (simp add: leq_use_env_def)
  apply (simp add: one_use_env_def)
  apply (simp add: end_req_perm_def)
    (* to prove it is proper, we first have to do the lookup of deref_name x ab. *)
  apply (case_tac "rs_map ab = None")
   apply (case_tac "s1 ab = None")
    apply (simp)
   apply (simp add: well_typed_state_def)
   apply (simp add: valid_nres_map_def)
   apply (simp add: full_nres_map_def)
   apply (auto)
   apply (erule_tac x="ab" in allE)
   apply (auto)
  apply (cut_tac rs_map="rs_map" and a="ab" and b="b" in proper_path_lookup)
    apply (auto)
   apply (simp add: proper_exp_def)
    (* with this in mind, we can prove it is still proper after ack *)
  apply (rule_tac e="v" and a="ab" and b="b" and l="l" and r_s="y" and env="env" and r_se="r_x" and r_xe="r_x" in proper_set_own)
      apply (auto)
    (* - the value is proper from our definition of wts *)
    apply (simp add: well_typed_state_def)
    apply (auto)
    apply (erule_tac x="ab" in allE)
    apply (auto)
    apply (cut_tac arr="arr" and i="i" and v="v" in read_proper_exp)
      apply (auto)
   apply (rule_tac wts_mem_val_env)
   apply (auto)
    (* well-typedness since r_x \<le> y *)
  apply (rule_tac ?r_s1.0="r_x" in well_typed_incr_start_perm)
   apply (simp)
  apply (simp add: valid_res_list_def)
  apply (erule_tac x="i" in allE)
  apply (erule_tac x="r_x" in allE)
  apply (auto)
  apply (simp add: nres_lookup_def)
  done

lemma sares_cv_case: "
  \<lbrakk>well_typed_state s1 env rs_map; valid_exp_use_env s1 rs_map r_f; leq_use_env r_s1 r_f; are = CVApp; e1 = AppExp (AppExp (ConstExp c) v1) v2;
        bin_const c; is_value v1; is_value v2; app_cv s1 c v1 v2 ax (s2, e2); FunTy t1a (FunTy t1 tau r a) ra aa \<in> const_type c;
        proper_exp rs_map (AppExp (AppExp (ConstExp c) v1) v2); well_typed env r_s2a v2 t1 r_s3 rx2; leq_use_env r_s2aa r_s1;
        leq_use_env r_s2 (diff_use_env r_s3 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)); leq_use_env rx1a r_s2aa;
        well_typed env r_s2aa v1 t1a r_s3a rx2a;
        leq_use_env r_s2a (diff_use_env r_s3a (comp_use_env (comp_use_env rx1a (lift_use_env rx2a ra)) r_exa));
        leq_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_s3; (*safe_use_lift rx2a ra;*) disj_use_env rx1 (lift_use_env rx2 r);
        leq_use_env rx r_s2; leq_use_env (comp_use_env rx1a (lift_use_env rx2a ra)) r_s3a; leq_use_env r_ex r_s1; leq_use_env (app_req rx1 rx2 r tau r_ex) rx;
        disj_use_env rx1a (lift_use_env rx2a ra); leq_use_env rx1 r_s2a; leq_use_env r_exa r_s1;
        leq_use_env (app_req rx1a rx2a ra (FunTy t1 tau r a) r_exa) rx1\<rbrakk>
       \<Longrightarrow> \<exists>g_ax. well_typed (red_env env g_ax) (exp_red_use_env r_s1 g_ax) e2 tau (end_red_use_env r_s2 g_ax) (end_red_use_env rx g_ax) \<and>
                  proper_exp (red_nres_map rs_map g_ax) e2 \<and> well_typed_state s2 (red_env env g_ax) (red_nres_map rs_map g_ax) \<and>
                  valid_exp_use_env s2 (red_nres_map rs_map g_ax) (exp_red_use_env r_f g_ax) \<and> safe_act s1 (infl_use_env r_f r_s2) g_ax \<and> corr_act ax g_ax"
  apply (case_tac c)
              apply (auto)
    (* array extension case *)
     apply (rule_tac scv_ext_array_alt)
              apply (auto)
      apply (simp add: pure_fun_def)
      apply (simp add: ext_app_abbrev_def)
      apply (rule_tac x="t1" in exI)
      apply (rule_tac x="r" in exI)
      apply (rule_tac x="a" in exI)
      apply (rule_tac x="r_s2a" in exI)
      apply (rule_tac x="rx1" in exI)
      apply (simp add: ext_arr_abbrev_def)
      apply (auto)
      apply (rule_tac x="t1a" in exI)
      apply (rule_tac x="ra" in exI)
      apply (auto)
      apply (rule_tac x="r_s2aa" in exI)
      apply (auto)
     apply (simp add: pure_fun_def)
    (* array read case *)
    apply (rule_tac ?r_s3.0="r_s3" and r_ex="r_ex" and ?rx2.0="rx2" in scv_read_case)
                      apply (auto)
    (* array write case *)
   apply (rule_tac scv_write_case)
             apply (auto)
   apply (simp add: write_app_abbrev_def)
   apply (rule_tac x="PairTy IntTy t2 rb" in exI)
   apply (rule_tac x="r" in exI)
   apply (rule_tac x="a" in exI)
   apply (rule_tac x="r_s2a" in exI)
   apply (rule_tac x="rx1" in exI)
   apply (auto)
    apply (simp add: write_arr_abbrev_def)
    apply (rule_tac x="t1a" in exI)
    apply (rule_tac x="ra" in exI)
    apply (auto)
    apply (rule_tac x="r_s2aa" in exI)
    apply (auto)
   apply (simp add: write_pair_abbrev_def)
   apply (rule_tac x="rx2" in exI)
   apply (auto)
   apply (rule_tac x="r_s3" in exI)
   apply (auto)
   apply (rule_tac x="r_s2b" in exI)
   apply (auto)
done

end