theory ProcLemma
  imports ProcSendCase
begin

    (* ##### 3. process reduction validity for thread case ##### *)

lemma id_sub_env: "sub_env s s"
  apply (simp add: sub_env_def)
  done

lemma super_sub_use_env: "\<lbrakk> sub_env s' s; sub_use_env s r_s \<rbrakk> \<Longrightarrow> sub_use_env s' r_s"
  apply (simp add: sub_env_def)
  apply (simp add: sub_use_env_def)
  done

lemma app_red_exp_sub_env: "\<lbrakk> app_red_exp are (s1, e1) ax (s2, e2) \<rbrakk> \<Longrightarrow> sub_env s2 s1"
  apply (case_tac are)
        apply (auto)
        apply (rule_tac id_sub_env)
       apply (rule_tac id_sub_env)
      apply (case_tac c)
                  apply (auto)
        apply (rule_tac add_sub_env)
        apply (rule_tac id_sub_env)
       apply (rule_tac id_sub_env)
      apply (rule_tac add_sub_env)
      apply (rule_tac add_sub_env)
      apply (rule_tac id_sub_env)
     apply (rule_tac id_sub_env)
    apply (rule_tac id_sub_env)
   apply (rule_tac id_sub_env)
  apply (case_tac c)
              apply (auto)
     apply (rule_tac add_sub_env)
     apply (rule_tac id_sub_env)
    apply (rule_tac id_sub_env)
   apply (rule_tac add_sub_env)
   apply (rule_tac id_sub_env)
  done

    (* MAIN PROCESS REDUCTION LEMMA *)

lemma srps_thread_case: "\<lbrakk>well_typed_system env rs_map p_map s1 ps1; valid_reduct app_red_exp; r_ax = ThreadAct; ps1 u = Some (app_hole h e1); wf_hole h;
        ps2 = add_env ps1 u (app_hole h e2); app_red_exp are (s1, e1) ax (s2, e2)\<rbrakk>
       \<Longrightarrow> \<exists>r_s g_ax. (\<exists>p_map'. well_typed_system (red_env env g_ax) (red_nres_map rs_map g_ax) p_map' s2 (add_env ps1 u (app_hole h e2))) \<and> safe_act s1 r_s g_ax"
    (* case where action is performed on single thread 'u'. *)
  apply (case_tac "\<not> (well_typed_state s1 env rs_map \<and> well_typed_proc_set env rs_map p_map ps1 \<and> sub_nres_map s1 p_map \<and> (\<forall> u. case p_map u of
      None \<Rightarrow> True | Some r_s \<Rightarrow> sep_nres_map r_s rs_map))")
   apply (simp add: well_typed_system_def)
  apply (auto)
    (* we start by obtaining the well-typedness and validity for thread 'u' *)
  apply (simp add: well_typed_proc_set_def)
  apply (auto)
  apply (erule_tac x="u" in allE)
  apply (erule_tac x="u" in allE)
  apply (auto)
  apply (case_tac "p_map u")
   apply (auto)
    (* using the gsre lemma, we know that the resulting expression will be well-typed. *)
  apply (cut_tac env="env" and ?r_s1.0="a" and ?e1.0="app_hole h e1" and tau="UnitTy" and ?r_s2.0="r_s2" and rx="rx" and ?s1.0="s1" and
        rs_map="rs_map" and ?e2.0="app_hole h e2" and ax="ax" and ?s2.0="s2" and r_f="a" in safe_full_red_exp)
         apply (auto)
    apply (simp add: valid_exp_use_env_def)
    apply (simp add: sub_nres_map_def)
    apply (simp add: nres_lookup_def)
    apply (erule_tac x="u" in allE)
    apply (auto)
   apply (rule_tac id_leq_use_env)
  apply (rule_tac x="a" in exI)
  apply (rule_tac x="g_ax" in exI)
  apply (auto)
  apply (rule_tac x="add_env p_map u (exp_red_use_env a g_ax)" in exI)
    (* prove that the resulting system is well-typed overall *)
  apply (simp add: well_typed_system_def)
    (* prove that the process set in particular remains well-typed *)
  apply (simp add: well_typed_proc_set_def)
  apply (auto)
    (* prove that the new map still covers the state *)
       apply (rule_tac add_full_nres_map)
       apply (simp)
    (* prove that it is still disjoint *)
      apply (rule_tac disj_add_nres_map)
       apply (simp)
      apply (rule_tac ?s1.0="s1" in red_sep_nres_map)
          apply (auto)
       apply (rule_tac r_x="infl_use_env a r_s2" in leq_safe_act)
        apply (simp)
       apply (rule_tac lhs_infl_leq_use_env)
       apply (rule_tac id_leq_use_env)
      apply (simp add: sub_nres_map_def)
       apply (erule_tac x="u" in allE)
      apply (simp add: nres_lookup_def)
    (* prove that everything is still well-typed. we start with the original expressions from ps1 *)
      apply (case_tac "u \<noteq> ua")
       apply (case_tac "add_env ps1 u (app_hole h e2) ua")
        apply (auto)
       apply (erule_tac x="ua" in allE)
       apply (simp add: add_env_def)
       apply (case_tac "p_map ua")
        apply (auto)
       apply (rule_tac x="rxa" in exI)
       apply (rule_tac x="r_s2a" in exI)
       apply (rule_tac env'="env" in well_typed_contain_env)
        apply (rule_tac s="s1" in red_contain_env)
         apply (simp_all)
       apply (simp add: well_typed_state_def)
    (* - proving that it's still proper as well *)
      apply (rule_tac s="s1" in red_proper_exp)
        apply (auto)
      apply (simp add: well_typed_state_def)
    (* - it's true for the modified res map by valid_reduct's def *)
      apply (simp add: add_env_def)
      apply (erule_tac x="u" in allE)
      apply (erule_tac x="u" in allE)
      apply (auto)
    (* prove that each res map in p_map is still contained in s2. this is true for the original
        res maps since s1 <: s2 *)
     apply (simp add: sub_nres_map_def)
     apply (auto)
     apply (case_tac "u \<noteq> x")
      apply (rule_tac s="s1" in super_sub_use_env)
       apply (simp add: nres_lookup_def)
       apply (simp add: add_env_def)
      apply (rule_tac are="are" in app_red_exp_sub_env)
      apply (auto)
    (* - it's true for the modified res map by valid_exp *)
     apply (simp add: nres_lookup_def)
     apply (simp add: add_env_def)
    apply (simp add: valid_exp_use_env_def)
    apply (simp add: nres_lookup_def)
    apply (simp add: add_env_def)
    (* prove that each res map in p_map is disjoint from the new rs_map. this is true for the original
        res maps by lemma *)
   apply (case_tac "u \<noteq> ua")
    apply (simp add: add_env_def)
    apply (auto)
    apply (erule_tac x="ua" in allE)
    apply (erule_tac x="ua" in allE)
    apply (case_tac "p_map ua")
     apply (auto)
    apply (simp add: valid_exp_use_env_def)
     apply (rule_tac p_map="p_map" and u="u" and v="ua" and r_p="aa" and r_s="a" and ?s1.0="s1" in red_sep_nres_map2)
           apply (auto)
      apply (rule_tac r_x="infl_use_env a r_s2" in leq_safe_act)
       apply (simp)
      apply (rule_tac lhs_infl_leq_use_env)
      apply (rule_tac id_leq_use_env)
    (* - it's true for the modified res map by valid_reduct's def *)
   apply (simp add: add_env_def)
   apply (simp add: valid_exp_use_env_def)
    (* - action safety *)
  apply (rule_tac r_x="infl_use_env a r_s2" in leq_safe_act)
   apply (simp)
  apply (rule_tac lhs_infl_leq_use_env)
  apply (rule_tac id_leq_use_env)
  done

    (* ##### 4a. fork lemma: proves well-typedness of new thread ##### *)

definition unit_app_abbrev where
  "unit_app_abbrev e = (AppExp e (ConstExp UnitConst))"

    (* this lemma allows us to type the expression passed into a fork so that it can be moved into another thread. since it will be
        stored in another thread, the requirements must be contained by r_s1, yet completely removable from it.
        from the previous lemma, we know that this can be taken from just the non-prim vars in e *)

lemma safe_fork_lam: "\<lbrakk> well_typed env r_s1 (app_hole h (AppExp (ConstExp ForkConst) e)) tau r_s2 rx; is_value e; is_own r \<rbrakk> \<Longrightarrow>
  well_typed env (np_dom_use_env env e) (unit_app_abbrev e) UnitTy empty_use_env empty_use_env"
  apply (induct h arbitrary: env r_s1 r_s2 tau rx)
    apply (auto)
  apply (simp add: unit_app_abbrev_def)
    (* base case *)
  apply (cut_tac env="env" and ?r_s1.0="r_s2a" and e="e" and tau="FunTy UnitTy UnitTy UsePerm a" and ?r_s2.0="r_s3" and rx="rx2" in infl_sexp_wp)
    apply (simp)
   apply (rule_tac value_is_sexp)
   apply (auto)
  apply (rule_tac x="UsePerm" in exI)
  apply (rule_tac x="a" in exI)
  apply (rule_tac x="np_dom_use_env env e" in exI)
  apply (rule_tac x="np_dom_use_env env e" in exI)
  apply (auto)
    (* the idea is that the infl_sexp_wp requirements are strictly greater than np_dom, and since np_dom is strong, there is an exact way of
        subtracting to get to np_dom. (we do cheat a little by lifting rx2). *)
   apply (rule_tac t="np_dom_use_env env e" and s="diff_use_env (comp_use_env (lift_use_env rx2 ra) (infl_use_env r_s2a r_s3))
    (diff_use_env (lift_use_env (comp_use_env (lift_use_env rx2 ra) (infl_use_env r_s2a r_s3)) r) (np_dom_use_env env e))" in subst)
    apply (rule_tac sfl_diff_use_env)
      apply (simp add: np_dom_use_env_def)
      apply (rule_tac strong_dom_use_env)
     apply (simp add: leq_use_env_def)
     apply (auto)
    (* to prove that the infl_sexp_wp reqs are greater than np_dom, we use the fact that any npv must have a permission *)
    apply (simp add: np_dom_use_env_def)
    apply (simp add: dom_use_env_def)
    apply (auto)
    apply (case_tac "comp_use_env (lift_use_env rx2 ra) (infl_use_env r_s2a r_s3) x \<noteq> OwnPerm")
     apply (case_tac "comp_use_env rx2 (infl_use_env r_s2a r_s3) x = NoPerm")
      apply (cut_tac x="x" and env="env" and e="e" and ?r_s1.0="comp_use_env rx2 (infl_use_env r_s2a r_s3)" in well_typed_no_npv_use)
        apply (auto)
    apply (cut_tac r_sa="lift_use_env rx2 ra" and r_sb="infl_use_env r_s2a r_s3" and x="x" in comp_use_no_own_both)
     apply (auto)
    apply (case_tac "rx2 x \<noteq> NoPerm")
     apply (simp add: is_own_def)
    apply (case_tac "rx2 x")
      apply (auto)
    apply (case_tac "infl_use_env r_s2a r_s3 x \<noteq> NoPerm")
     apply (simp add: infl_use_env_def)
     apply (case_tac "r_s2a x = OwnPerm \<and> r_s3 x = NoPerm")
      apply (auto)
    apply (cut_tac r_sa="rx2" and r_sb="infl_use_env r_s2a r_s3" and x="x" in comp_use_none)
      apply (auto)
    (* with that in mind, we manipulate until we match the infl sexp lemma *)
   apply (rule_tac well_typed_diff_perms)
    apply (rule_tac rx="comp_use_env rx2 (infl_use_env r_s2a r_s3)" in well_typed_incr_req)
      apply (rule_tac r_s="comp_use_env rx2 (infl_use_env r_s2a r_s3)" in well_typed_incr_simul_perm)
       apply (rule_tac dist_comp_leq_use_env)
        apply (rule_tac comp_leq_use_env1)
        apply (rule_tac self_lift_leq_use_env)
       apply (rule_tac self_comp_leq_use_env2)
      apply (simp)
     apply (rule_tac dist_comp_leq_use_env)
      apply (rule_tac comp_leq_use_env1)
      apply (rule_tac self_lift_leq_use_env)
     apply (rule_tac self_comp_leq_use_env2)
    apply (rule_tac id_leq_use_env)
    (* next, we must show that the differential is actually subtractible, which is true since it removes all non-prim vars *)
  apply (auto)
   apply (case_tac "np_dom_use_env env e x \<noteq> OwnPerm")
    apply (simp add: np_dom_use_env_def)
    apply (simp add: dom_use_env_def)
   apply (cut_tac r_s="lift_use_env (comp_use_env (lift_use_env rx2 ra) (infl_use_env r_s2a r_s3)) r" and
       r_ex="np_dom_use_env env e" and x="x" in diff_use_none_ex)
    apply (simp)
   apply (simp add: own_env_vars_def)
    (* lastly, we prove the various inequalities for application to a unit const *)
  apply (rule_tac x="empty_use_env" in exI)
  apply (rule_tac x="np_dom_use_env env e" in exI)
  apply (auto)
    apply (rule_tac id_leq_use_env)
   apply (rule_tac leq_empty_use_env)
  apply (rule_tac x="empty_use_env" in exI)
  apply (auto)
         apply (rule_tac leq_empty_use_env)(*
        apply (simp add: empty_use_env_def)
       apply (simp add: unlim_def)*)
      apply (rule_tac dist_comp_leq_use_env)
       apply (rule_tac id_leq_use_env)
      apply (rule_tac leq_empty_use_env)
     apply (rule_tac disj_empty_use_env1)
    apply (rule_tac leq_empty_use_env)
   apply (rule_tac leq_empty_use_env)
  apply (simp add: app_req_def)
  apply (rule_tac leq_empty_use_env)
  done

    (* ##### 4b. fork lemma: if x is an npv in 'e', then we have ownership permissions for 'h (fork e)' ##### *)

lemma safe_fork_own_npv_use: "\<lbrakk> well_typed env r_s1 (app_hole h (AppExp (ConstExp ForkConst) e)) tau r_s2 rx;
 is_value e; x \<in> non_prim_vars env e \<rbrakk> \<Longrightarrow> r_s1 x = OwnPerm"
  apply (induct h arbitrary: env r_s1 r_s2 tau rx)
        apply (auto)
    (* base case *)
     apply (cut_tac env="env" and ?r_s1.0="r_s2a" and e="e" and ?r_s2.0="r_s3" and rx="rx2" in infl_sexp_wp)
       apply (auto)
      apply (rule_tac value_is_sexp)
      apply (simp)
     apply (case_tac "comp_use_env rx2 (infl_use_env r_s2a r_s3) x = NoPerm")
      apply (cut_tac env="env" and x="x" and e="e" and ?r_s1.0="comp_use_env rx2 (infl_use_env r_s2a r_s3)" in well_typed_no_npv_use)
        apply (auto)
     apply (case_tac "rx2 x \<noteq> NoPerm")
      apply (cut_tac r_x="lift_use_env rx2 r" and r_s="r_s1" and x="x" in leq_use_own)
        apply (simp add: is_own_def)
       apply (rule_tac r_sb="comp_use_env rx1 (lift_use_env rx2 r)" in trans_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 (auto)
       apply (rule_tac well_typed_perm_leq)
       apply (auto)
      apply (rule_tac self_comp_leq_use_env2)
     apply (case_tac "infl_use_env r_s2a r_s3 x \<noteq> NoPerm")
      apply (simp add: infl_use_env_def)
      apply (case_tac "r_s2a x = OwnPerm \<and> r_s3 x = NoPerm")
       apply (auto)
      apply (rule_tac r_x="r_s2a" in leq_use_own)
       apply (auto)
     apply (cut_tac r_sa="rx2" and r_sb="infl_use_env r_s2a r_s3" and x="x" in comp_use_none)
       apply (auto)
    (* rhs induct *)
    apply (rule_tac r_x="r_s2a" in leq_use_own)
     apply (simp)
    apply (rule_tac well_typed_perm_leq)
    apply (auto)
    (* rhs pair *)
    apply (rule_tac r_x="r_s2a" in leq_use_own)
    apply (simp)
   apply (rule_tac well_typed_perm_leq)
   apply (auto)
    (* unpack *)(*
  apply (rule_tac r_x="r_s2a" in leq_use_own)
   apply (simp)
  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 diff_leq_use_env)
   apply (rule_tac r_sb="r_s2b" in trans_leq_use_env)
    apply (auto)
  apply (rule_tac well_typed_perm_leq)
  apply (auto)*)
  done

    (* ##### 4c. fork lemma: proves well-typedness of original thread post-fork ##### *)

    (* this lemma proves that e should be removable from the fork. combined with the previous lemmas, we can also remove the
      permissions of e, and type the two resultant expressions disjointly. *)

lemma safe_fork_exp_ih: "\<lbrakk> well_typed env r_s1 (app_hole h (AppExp (ConstExp ForkConst) e)) tau r_s2 rx; is_value e \<rbrakk> \<Longrightarrow>
  well_typed env r_s1 (app_hole h (ConstExp UnitConst)) tau r_s2 rx"
  apply (induct h arbitrary: env r_s1 e tau r_s2 rx)
        apply (auto)
    (* base case *)
        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 r_sb="r_s2a" in trans_leq_use_env)
          apply (simp)
         apply (rule_tac diff_leq_use_env)
         apply (rule_tac well_typed_perm_leq)
         apply (auto)
    (* lhs induct *)
       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 (auto)
    (* rhs induct *)
      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 (auto)
      apply (rule_tac x="rx2" in exI)
      apply (rule_tac x="r_s3" in exI)
      apply (auto)
    (* if case *)
     apply (rule_tac x="rx'" in exI)
     apply (rule_tac x="r_s2a" in exI)
     apply (auto)
    (* lhs pair case *)
    apply (rule_tac x="r_s2a" in exI)
    apply (rule_tac x="r_s3" in exI)
    apply (rule_tac x="rx1" in exI)
    apply (auto)
    (* rhs pair case *)
   apply (rule_tac x="r_s2a" in exI)
   apply (rule_tac x="r_s3" in exI)
   apply (rule_tac x="rx1" in exI)
   apply (auto)
   apply (rule_tac x="rx2" in exI)
   apply (auto)
    (* unpack case *)(*
  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 (auto)
   apply (rule_tac x="t1a" in exI)
   apply (rule_tac x="ra" in exI)
   apply (auto)
    apply (rule_tac x="aa" in exI)
    apply (rule_tac x="t1b" in exI)
    apply (rule_tac x="t2" in exI)
    apply (rule_tac x="tx" in exI)
    apply (auto)
   apply (rule_tac x="r_s2b" in exI)
   apply (auto)
  apply (rule_tac x="rx2" in exI)
  apply (rule_tac x="r_s3" in exI)
  apply (auto)*)
  done

    (* uses:
        - safe_fork_hole_npv_use: to determine that if x is an np-var, it is not in h
        - 4b (safe_fork_own_npv_use) to determine that if x is an np-var, we own it
    *)

lemma safe_fork_exp: "\<lbrakk> well_typed env r_s1 (app_hole h (AppExp (ConstExp ForkConst) e)) tau r_s2 rx;
  valid_nres_map s rs_map; valid_exp_use_env s rs_map r_s1; wf_hole h; is_value e \<rbrakk> \<Longrightarrow>
  well_typed env (diff_use_env r_s1 (full_dom_use_env env rs_map e)) (app_hole h (ConstExp UnitConst)) tau
  (diff_use_env r_s2 (full_dom_use_env env rs_map e)) (diff_use_env rx (full_dom_use_env env rs_map e))"
  apply (rule_tac well_typed_diff_perms)
   apply (rule_tac safe_fork_exp_ih)
    apply (auto)
  apply (simp add: non_prim_vars_def)
  apply (auto)
    (* we want to show that if x is in the dominator, it is not an np-var in h.
        > if x is an np-var itself, it cannot be in e by lemma *)
  apply (case_tac "x \<in> non_prim_vars env e")
   apply (cut_tac h="h" and x="x" and e="ConstExp UnitConst" in app_hole_free_vars_rev)
    apply (auto)
   apply (cut_tac h="h" and x="x" and env="env" and ?r_s1.0="r_s1" and e="e" in safe_fork_hole_npv_use)
       apply (auto)
    (* otherwise, x is in the completion. we identify its ancestor z. *)
  apply (simp add: own_env_vars_def)
  apply (simp add: full_dom_use_env_def)
  apply (simp add: dom_use_env_def)
  apply (case_tac "\<exists>l z. z \<in> non_prim_vars env e \<and> path_lookup rs_map z l x")
   apply (auto)
    (* we note that z is a np-var of e therefore r_s1 z = Own *)
  apply (cut_tac x="z" and env="env" in safe_fork_own_npv_use)
     apply (auto)
    (* x then is in the lookup map of some parent y. *)
  apply (cut_tac rs_map="rs_map" and z="z" and x="x" in path_lookup_parent)
     apply (auto)
    (* with that in mind, by separation, x is disjoint from r_s1. *)
  apply (case_tac "r_s1 x \<noteq> NoPerm")
   apply (simp add: valid_exp_use_env_def)
   apply (simp add: sep_nres_map_def)
   apply (auto)
   apply (erule_tac x="y" in allE)
   apply (simp add: nres_lookup_def)
   apply (simp add: strong_disj_use_env_def)
   apply (erule_tac x="x" in allE)
   apply (auto)
    (* by extension, x is not in 'h (fork e)' *)
  apply (cut_tac env="env" and ?r_s1.0="r_s1" and x="x" in well_typed_no_npv_use)
    apply (auto)
  apply (simp add: non_prim_vars_def)
    (* the very last part is showing that x not in 'h (fork e)' implies x not in 'h ()'. *)
  apply (cut_tac x="x" and h="h" and e="ConstExp UnitConst" in app_hole_free_vars_rev)
   apply (auto)
  apply (cut_tac x="x" and h="h" and e="AppExp (ConstExp ForkConst) e" in app_hole_free_vars2)
   apply (auto)
  done

    (*
lemma safe_fork_exp_full: "\<lbrakk> well_typed env r_s1 (app_hole h (AppExp (ConstExp ForkConst) e)) tau r_s2 rx;
  scope_res_map rs_map; valid_use_env s rs_map r_c r_s1; wf_hole h; is_value e \<rbrakk> \<Longrightarrow>
  well_typed env (diff_use_env r_s1 (full_dom_use_env env rs_map e)) (app_hole h (ConstExp UnitConst)) tau
  (diff_use_env r_s2 (full_dom_use_env env rs_map e)) (diff_use_env rx (full_dom_use_env env rs_map e))"
  apply (rule_tac well_typed_diff_perms)
   apply (rule_tac safe_fork_exp_ih)
    apply (auto)
  apply (simp add: non_prim_vars_def)
  apply (auto)
    (* we want to show that if x is in the dominator, it is not an np-var in h.
        > if x is an np-var itself, it cannot be in h by lemma *)
  apply (case_tac "x \<in> non_prim_vars env e")
   apply (cut_tac h="h" and x="x" and e="ConstExp UnitConst" in app_hole_free_vars_rev)
    apply (auto)
   apply (cut_tac h="h" and x="x" and env="env" and ?r_s1.0="r_s1" and e="e" in safe_fork_hole_npv_use)
       apply (auto)
    (* otherwise, x is in the completion. we identify its ancestor z. *)
  apply (simp add: own_env_vars_def)
  apply (simp add: full_dom_use_env_def)
  apply (simp add: dom_use_env_def)
  apply (case_tac "\<exists>l z. z \<in> non_prim_vars env e \<and> path_lookup rs_map z l x")
   apply (auto)
    (* we note that z is a np-var of e therefore r_c z = Own *)
  apply (cut_tac r_x="r_s1" and r_s="r_c" and x="z" in leq_use_own)
    apply (rule_tac x="z" and env="env" in safe_fork_own_npv_use)
      apply (auto)
   apply (simp add: valid_use_env_def)
    (* x is also in the lookup map of some parent y. we claim that r_c y = Own.
        if y = z, because of the prev, otherwise by path lookup. *)
  apply (cut_tac rs_map="rs_map" and z="z" and x="x" in path_lookup_parent)
     apply (auto)
  apply (case_tac "r_c y \<noteq> OwnPerm")
   apply (case_tac "y = z")
    apply (auto)
   apply (cut_tac r_c="r_c" and x="y" and z="z" in path_lookup_own)
        apply (auto)
   apply (simp add: valid_use_env_def)
   apply (simp add: valid_use_entry_def)
   apply (simp add: part_valid_entry_def)
    (* with that in mind, its lookup map should be disjoint from r_s, and by extension np-vars of h *)
  apply (case_tac "r_s1 x \<noteq> NoPerm")
   apply (simp add: valid_use_env_def)
   apply (simp add: valid_use_entry_def)
   apply (auto)
   apply (erule_tac x="y" in allE)
   apply (auto)
   apply (simp add: strong_disj_use_env_def)
   apply (simp add: lookup_res_def)
    apply (
   apply (simp add: mini_disj_use_env_def)
  apply (cut_tac env="env" and ?r_s1.0="r_s1" and x="x" in well_typed_no_npv_use)
    apply (auto)
  apply (simp add: non_prim_vars_def)
    (* the very last part is showing that x not in h (fork e) implies x not in h (). *)
  apply (cut_tac x="x" and h="h" and e="ConstExp UnitConst" in app_hole_free_vars_rev)
   apply (auto)
  apply (cut_tac x="x" and h="h" and e="AppExp (ConstExp ForkConst) e" in app_hole_free_vars2)
   apply (auto)
  done   *)

    (* ##### 4d. fork lemma: structural lemma for thread-disjointness in fork case ###### *)

lemma alift_strong_disj_use_env1: "\<lbrakk> strong_disj_use_env r_x r_s \<rbrakk> \<Longrightarrow> strong_disj_use_env (lift_use_env r_x r) r_s"
  apply (simp add: strong_disj_use_env_def)
  apply (auto)
  apply (case_tac r)
    apply (auto)
  done

    (* a special lemma that makes it easier to comprehend our strategy for proving the disjointness of the fork *)
lemma fork_disj_nres_map: "\<lbrakk> disj_nres_map p_map; p_map u = Some r_s; is_own r;
  leq_use_env r_xa (lift_use_env r_s r); leq_use_env r_xb (lift_use_env r_s r);
  strong_disj_use_env r_xa r_xb \<rbrakk> \<Longrightarrow> disj_nres_map (add_env (add_env p_map u r_xa) v r_xb)"
  apply (rule_tac disj_add_nres_map)
   apply (rule_tac disj_add_nres_map)
    apply (simp)
    (* first we must prove the disjointness of the new assignment to u *)
   apply (simp add: sep_nres_map_def)
   apply (auto)
   apply (case_tac "u = x")
    apply (cut_tac rs_map="p_map" and x="u" in nres_rem_same)
    apply (auto)
    apply (rule_tac empty_strong_disj_use_env2)
   apply (cut_tac rs_map="p_map" and x="u" and y="x" in nres_rem_diff)
    apply (auto)
   apply (simp add: disj_nres_map_def)
   apply (erule_tac x="u" in allE)
   apply (erule_tac x="x" in allE)
   apply (auto)
   apply (rule_tac r_s="lift_use_env r_s r" in strong_disj_leq_use_env1)
    apply (rule_tac alift_strong_disj_use_env1)
    apply (simp add: nres_lookup_def)
   apply (simp)
    (* next we prove the disjointness of v, starting with its disjointness to u *)
  apply (simp add: sep_nres_map_def)
  apply (auto)
  apply (case_tac "x = v")
   apply (cut_tac rs_map="add_env p_map u r_xa" and x="v" in nres_rem_same)
   apply (auto)
   apply (rule_tac empty_strong_disj_use_env2)
  apply (case_tac "x = u")
   apply (auto)
   apply (case_tac "\<not> nres_lookup (add_env p_map u r_xa) u = r_xa")
    apply (simp add: nres_lookup_def)
    apply (simp add: add_env_def)
   apply (cut_tac rs_map="add_env p_map u r_xa" and x="v" and y="u" in nres_rem_diff)
    apply (auto)
   apply (rule_tac comm_strong_disj_use_env)
   apply (simp)
    (* next we prove its disjointess to the rest of the map *)
  apply (cut_tac rs_map="add_env p_map u r_xa" and x="v" and y="x" in nres_rem_diff)
   apply (auto)
  apply (cut_tac rs_map="p_map" and x="u" and y="x" and r_s="r_xa" in nres_add_diff)
   apply (auto)
  apply (simp add: disj_nres_map_def)
  apply (erule_tac x="u" in allE)
  apply (erule_tac x="x" in allE)
  apply (auto)
  apply (rule_tac r_s="lift_use_env r_s r" in strong_disj_leq_use_env1)
   apply (rule_tac alift_strong_disj_use_env1)
   apply (simp add: nres_lookup_def)
  apply (simp)
  done

    (* ##### 4_X. process reduction validity for fork case ##### *)

lemma lift_sep_nres_map: "\<lbrakk> sep_nres_map r_s rs_map \<rbrakk> \<Longrightarrow> sep_nres_map (lift_use_env r_s r) rs_map"
  apply (simp add: sep_nres_map_def)
  apply (auto)
  apply (rule_tac alift_strong_disj_use_env1)
  apply (auto)
  done

lemma lift_sub_use_env: "\<lbrakk> sub_use_env s r_s \<rbrakk> \<Longrightarrow> sub_use_env s (lift_use_env r_s r)"
  apply (simp add: sub_use_env_def)
  apply (auto)
  apply (case_tac r)
    apply (auto)
  done

lemma srps_fork_case: "\<lbrakk>well_typed_system env rs_map p_map s2 ps1; r_ax = ForkAct; ps1 u = Some (app_hole h (AppExp (ConstExp ForkConst) e));
                wf_hole h; is_value e; ps2 = add_env (add_env ps1 u (app_hole h (ConstExp UnitConst))) v (AppExp e (ConstExp UnitConst)); fresh_var ps1 v;
                s1 = s2\<rbrakk>
               \<Longrightarrow> \<exists>r_s g_ax. (\<exists>p_map'. well_typed_system (red_env env g_ax) (red_nres_map rs_map g_ax) p_map' s2
                                     (add_env (add_env ps1 u (app_hole h (ConstExp UnitConst))) v (AppExp e (ConstExp UnitConst)))) \<and>
                          safe_act s2 r_s g_ax"
    (* fork case. no resources are generated in this step *)
  apply (rule_tac x="empty_use_env" in exI)
  apply (rule_tac x="NoResAct" in exI)
  apply (auto)
  apply (simp add: well_typed_system_def)
  apply (auto)
    (* before we can give the new process map types, we have to get the well-typedness statement for h (fork e) *)
  (*apply (case_tac "\<not> (case ps1 u of None \<Rightarrow> True
                     | Some e \<Rightarrow> (case lookup_mem p_map u of None \<Rightarrow> False
                                 | Some (r_c, s') \<Rightarrow> \<exists>rx r_s r_s2. well_typed env r_s e UnitTy r_s2 rx \<and> valid_use_env s2 rs_map r_c r_s))")*)
  apply (case_tac "\<not> (full_nres_map ps1 p_map \<and>
     disj_nres_map p_map \<and> (\<forall>u. case ps1 u of None \<Rightarrow> True | Some e \<Rightarrow>
      (case p_map u of None \<Rightarrow> False | Some r_s \<Rightarrow> \<exists>rx r_s2. well_typed env r_s e UnitTy r_s2 rx \<and> proper_exp rs_map e)))")
   apply (simp add: well_typed_proc_set_def)
  apply (auto)
  apply (case_tac "\<not> (case ps1 u of None \<Rightarrow> True | Some e \<Rightarrow> (case p_map u of None \<Rightarrow> False | Some r_s \<Rightarrow> \<exists>rx r_s2. well_typed env r_s e UnitTy r_s2 rx \<and> proper_exp rs_map e))")
   apply (erule_tac x="u" in allE)
   apply (erule_tac x="u" in allE)
   apply (auto)
  apply (case_tac "p_map u")
   apply (auto)
    (* using the fork lemmas, we can generate a type for e + a type for h () *)
  apply (cut_tac eq_own)
  apply (auto)
  apply (cut_tac env="env" and e="e" and ?r_s1.0="a" and tau="UnitTy" and h="h" and ?r_s2.0="r_s2" and rx="rx" and r="r" in safe_fork_lam)
     apply (auto)
  apply (cut_tac env="env" and e="e" and ?r_s1.0="a" and tau="UnitTy" and h="h" and ?r_s2.0="r_s2" and rx="rx" and s="s2" and rs_map="rs_map" in safe_fork_exp)
       apply (auto)
    apply (simp add: well_typed_state_def)
    (* - complete proof that a is still valid *)
   apply (simp add: valid_exp_use_env_def)
   apply (simp add: well_typed_proc_set_def)
   apply (simp add: sub_nres_map_def)
   apply (erule_tac x="u" in allE)
   apply (erule_tac x="u" in allE)
   apply (simp add: nres_lookup_def)
    (* - prelim: prove that (full_dom_use_env env rs_map e) \<le> a (old complete map) *)(*
  apply (cut_tac rs_map="rs_map" and e="e" and r_c="a" and h="h" and env="env" in valid_full_dom_leq_use_env)
      apply (auto)
   apply (simp add: well_typed_state_def)*)
    (* - prelim: np_dom_use_env env e \<le> lift_use_env a r *)
  apply (cut_tac r_sc="np_dom_use_env env e" and r_sb="np_dom_use_env env (app_hole h (AppExp (ConstExp ForkConst) e))"
      and r_sa="lift_use_env a r" in trans_leq_use_env)
    apply (rule_tac wt_np_leq_use_env)
     apply (auto)
   apply (simp add: np_dom_use_env_def)
   apply (rule_tac dist_dom_leq_use_env)
   apply (auto)
   apply (simp add: non_prim_vars_def)
   apply (cut_tac x="x" and e="AppExp (ConstExp ForkConst) e" in app_hole_free_vars)
    apply (auto)
    (* we fill in the  new process map, by taking perms from 'u' [[ h () ]] and giving them to 'v' [[ e () ]] *)
  apply (rule_tac x="add_env (add_env p_map u (diff_use_env a (full_dom_use_env env rs_map e))) v (np_dom_use_env env e)" in exI)
  apply (simp add: well_typed_proc_set_def)
  apply (auto)
    (* completeness of the new process map *)
      apply (rule_tac add_full_nres_map)
      apply (rule_tac add_full_nres_map)
      apply (simp)
    (* disjointness of the new process map *)
     apply (rule_tac r_s="a" and r="r" in fork_disj_nres_map)
          apply (auto)
      apply (rule_tac lift_leq_use_env)
      apply (rule_tac self_diff_leq_use_env)
     apply (rule_tac r_s="full_dom_use_env env rs_map e" in strong_disj_leq_use_env2)
      apply (rule_tac reduce_strong_disj_use_env)
       apply (simp add: disj_use_env_def)
       apply (auto)
        apply (rule_tac r_s="a" in mini_disj_strong_use_env)
         apply (rule_tac id_leq_use_env)
        apply (simp add: full_dom_use_env_def)
        apply (rule_tac strong_dom_use_env)
       apply (rule_tac mini_disj_diff_use_env)
      apply (simp add: full_dom_use_env_def)
      apply (rule_tac strong_dom_use_env)
     apply (rule_tac full_dom_leq_use_env)
    (* proving everything is still well-typed. we start with ua = v, ie the 'e ()' thread. *)
    apply (case_tac "ua = v")
     apply (case_tac "\<not> add_env (add_env ps1 u (app_hole h (ConstExp UnitConst))) v (AppExp e (ConstExp UnitConst)) ua =
      Some (unit_app_abbrev e)")
      apply (simp add: add_env_def)
      apply (simp add: unit_app_abbrev_def)
     apply (auto)
     apply (case_tac "\<not> (add_env (add_env p_map u (diff_use_env a (full_dom_use_env env rs_map e))) v (np_dom_use_env env e)) v =
      Some (np_dom_use_env env e)")
      apply (simp add: add_env_def)
     apply (auto)
    (* - properness *)
     apply (cut_tac rs_map="rs_map" and h="h" and e="AppExp (ConstExp ForkConst) e" in proper_app_hole_split2)
      apply (simp)
     apply (simp add: unit_app_abbrev_def)
     apply (simp add: proper_exp_def)
    (* - well-typedness for ua = u, the 'h ()' thread*)
    apply (case_tac "ua = u")
     apply (case_tac "\<not> add_env (add_env ps1 u (app_hole h (ConstExp UnitConst))) v (AppExp e (ConstExp UnitConst)) ua =
        Some (app_hole h (ConstExp UnitConst))")
      apply (simp add: add_env_def)
     apply (auto)
     apply (case_tac "\<not> (add_env (add_env p_map u (diff_use_env a (full_dom_use_env env rs_map e))) v (np_dom_use_env env e)) u =
        Some (diff_use_env a (full_dom_use_env env rs_map e))")
      apply (simp add: add_env_def)
     apply (auto)
    (* - properness *)
     apply (cut_tac rs_map="rs_map" and h="h" in proper_app_hole_split1)
      apply (simp)
     apply (rule_tac proper_app_hole_recon)
      apply (simp)
     apply (simp add: proper_exp_def)
    (* - well-typedness for unaltered threads *)
    apply (erule_tac x="ua" in allE)
    apply (case_tac "\<not> add_env (add_env ps1 u (app_hole h (ConstExp UnitConst))) v (AppExp e (ConstExp UnitConst)) ua = ps1 ua")
     apply (simp add: add_env_def)
    apply (case_tac "ps1 ua")
     apply (auto)
    apply (case_tac "\<not> (add_env (add_env p_map u (diff_use_env a (full_dom_use_env env rs_map e))) v (np_dom_use_env env e)) ua =
      p_map ua")
     apply (simp add: add_env_def)
    apply (auto)
    apply (erule_tac x="ua" in allE)
    apply (auto)
    (* proving the new process map is contained in the state *)
   apply (rule_tac add_sub_nres_map1)
    apply (rule_tac add_sub_nres_map1)
     apply (simp)
    apply (rule_tac r_s="a" in trans_sub_use_env)
     apply (simp add: sub_nres_map_def)
     apply (erule_tac x="u" in allE)
     apply (erule_tac x="u" in allE)
     apply (simp add: nres_lookup_def)
    apply (rule_tac self_diff_leq_use_env)
   apply (rule_tac r_s="lift_use_env a r" in trans_sub_use_env)
    apply (rule_tac lift_sub_use_env)
    apply (simp add: sub_nres_map_def)
    apply (erule_tac x="u" in allE)
    apply (erule_tac x="u" in allE)
    apply (simp add: nres_lookup_def)
   apply (simp)
    (* proving that separation still holds. we again start with ua = v, the 'e ()' thread *)
  apply (case_tac "ua = v")
   apply (simp add: add_env_def)
   apply (rule_tac r_s="lift_use_env a r" in leq_sep_nres_map)
    apply (simp)
   apply (rule_tac lift_sep_nres_map)
   apply (erule_tac x="u" in allE)
   apply (simp)
    (* - same for ua = u, ie the 'h ()' thread *)
  apply (case_tac "ua = u")
   apply (simp add: add_env_def)
   apply (rule_tac r_s="a" in leq_sep_nres_map)
    apply (rule_tac self_diff_leq_use_env)
   apply (erule_tac x="u" in allE)
   apply (simp)
    (* - lastly prove separation for original threads *)
  apply (simp add: add_env_def)
  done

  (*
lemma valid_fork: "valid_reduct fork_reduce"
  apply (simp add: valid_reduct_def)
  apply (auto)
  apply (case_tac e1)
       apply (auto)
  apply (case_tac x61)
       apply (auto)
  apply (case_tac x1)
               apply (auto)
  apply (case_tac e2)
       apply (auto)
   apply (case_tac x1)
                apply (auto)
   apply (case_tac "aa")
    apply (auto)
  apply (rule_tac x="NoResAct" 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 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 (auto)
    apply (rule_tac well_typed_perm_leq)
    apply (auto)
   apply (case_tac x1)
                apply (auto)
  apply (case_tac x1)
               apply (auto)
  done*)

    (* the main gsre lemma is intended to prove that given a hole, an expression in that hole, and a reduction on that expression,
        we can re-type the hole entirely.

      this lemma aims to do something similar, but in addition to re-typing the hole, we pull out the old expression and type it
        disjointly from the old hole. this is not achievable with the standard gsre lemma because it's not really true that in general
        they will end up disjoint.

      in this case they will end up disjoint because the expression being put into the hole has permissions disjoint from the rest
        of the expression.
    *)

    (* if e appears on the lhs of an expression, it will be subtracted out before you get to e2.
        if e appears on the rhs, it can be assumed that you will subtract it out then.

       but either way, the point is that we can get rxa, the exact permissions for e, and type h () in a manner disjoint from rxa.
    *)

    (*
lemma valid_np_dom_leq_use_env: "\<lbrakk> well_typed env r_s (app_hole h (AppExp (ConstExp ForkConst) e)) tau r_s2 rx; is_value e;
  valid_use_env s rs_map r_c r_s \<rbrakk> \<Longrightarrow> leq_use_env (np_dom_use_env env e) r_s"
  apply (simp add: leq_use_env_def)
  apply (simp add: np_dom_use_env_def)
  apply (simp add: dom_use_env_def)
  apply (simp add: valid_use_env_def)
  apply (auto)
  apply (cut_tac env="env" and ?r_s1.0="r_s" and h="h" and e="e" and x="x" in safe_fork_own_npv_use)
     apply (simp_all)
  done

lemma valid_full_dom_leq_use_env: "\<lbrakk> well_typed env r_s (app_hole h (AppExp (ConstExp ForkConst) e)) tau r_s2 rx; is_value e;
  valid_res_map s rs_map; valid_use_env s rs_map r_c r_s \<rbrakk> \<Longrightarrow> leq_use_env (full_dom_use_env env rs_map e) r_c"
  apply (simp add: leq_use_env_def)
  apply (simp add: full_dom_use_env_def)
  apply (simp add: dom_use_env_def)
  apply (auto)
    (* if x is in the non-prim var set, we must have ownership in r_s, and thus r_c *)
  apply (case_tac "x \<in> non_prim_vars env e")
   apply (cut_tac env="env" and ?r_s1.0="r_s" and h="h" and e="e" and x="x" in safe_fork_own_npv_use)
      apply (simp_all)
   apply (cut_tac r_x="r_s" and r_s="r_c" and x="x" in leq_use_own)
     apply (simp_all)
   apply (simp add: valid_use_env_def)
    (* otherwise x has ancestor z. z is in the non-prim var set, so c has a value on it *)
  apply (case_tac "r_c z = NoPerm")
   apply (cut_tac r_x="r_s" and r_s="r_c" and x="z" in leq_use_none)
     apply (simp add: valid_use_env_def)
    apply (simp)
   apply (cut_tac x="z" and ?r_s1.0="r_s" and env="env" in well_typed_no_npv_use)
     apply (auto)
   apply (cut_tac x="z" and h="h" and e="AppExp (ConstExp ForkConst) e" in app_hole_free_vars)
    apply (simp add: non_prim_vars_def)
   apply (simp add: non_prim_vars_def)
    (* by path lookup, r_c x has ownership  *)
  apply (cut_tac r_c="r_c" and z="z" and l="l" in path_lookup_own)
       apply (auto)
   apply (simp add: valid_res_map_def)
  apply (simp add: valid_use_env_def)
  apply (simp add: valid_use_entry_def)
  apply (simp add: part_valid_entry_def)
  done

    (*
lemma safe_fork_exp: "\<lbrakk> well_typed env r_s1 (app_hole h (AppExp (ConstExp ForkConst) e)) tau r_s2 rx; wf_hole h; is_value e \<rbrakk> \<Longrightarrow>
  well_typed env (diff_use_env r_s1 (np_dom_use_env env e)) (app_hole h (ConstExp UnitConst)) tau
  (diff_use_env r_s2 (np_dom_use_env env e)) (diff_use_env rx (np_dom_use_env env e))"
  apply (rule_tac well_typed_diff_perms)
   apply (rule_tac safe_fork_exp_ih)
    apply (auto)
  apply (simp add: non_prim_vars_def)
  apply (auto)
  apply (cut_tac h="h" and x="x" and e="ConstExp UnitConst" in app_hole_free_vars_rev)
   apply (auto)
  apply (cut_tac h="h" and x="x" and env="env" and ?r_s1.0="r_s1" and e="e" in safe_fork_hole_npv_use)
      apply (auto)
  apply (simp add: non_prim_vars_def)
  apply (simp add: own_env_vars_def)
  apply (simp add: np_dom_use_env_def)
  apply (simp add: dom_use_env_def)
  apply (simp add: non_prim_vars_def)
  apply (case_tac "x \<in> free_vars e")
   apply (auto)
  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 red_valid_use_env: "\<lbrakk> app_red_exp are (s1, e1) ax (s2, e2); valid_use_env s1 rs_map r_c r_s;
  safe_act s1 g_ax; corr_act ax g_ax \<rbrakk> \<Longrightarrow> valid_use_env s2 (red_res_map rs_map g_ax) r_c r_s"
  apply (simp add: valid_use_env_def)
  apply (auto)
    (* r_c still contained in s2 *)
   apply (rule_tac s="s1" in contain_sub_use_env)
    apply (simp)
   apply (rule_tac app_red_exp_contain_env)
   apply (auto)
    (* the map for each element of r_s is still valid *)
  apply (case_tac g_ax)
    apply (auto)
  apply (case_tac "x = x21")
   apply (auto)
   apply (cut_tac rs_map="rs_map" and x="x21" and r_s="x23" in lookup_add_mem_same)
   apply (simp)
   apply (simp add: sub_use_env_def)
  apply (cut_tac rs_map="rs_map" and x="x21" and r_s="x23" and y="x" in lookup_add_mem_diff)
   apply (simp_all)
  done
    (*
lemma sep_red_nres_map: "\<lbrakk> app_red_exp are (s1, e1) ax (s2, e2); corr_act ax g_ax; sep_nres_map r_s rs_map \<rbrakk> \<Longrightarrow> sep_nres_map r_s (red_nres_map rs_map g_ax)"
  apply (case_tac g_ax)
    apply (auto)
  apply (simp add: sep_nres_map_def)
  apply (auto)
  apply (case_tac "x \<noteq> x21")
   apply (simp add: nres_lookup_def)
   apply (simp add: add_env_def)
  apply (simp add: nres_lookup_def)
  apply (simp add: add_env_def)
  apply (case_tac are)
        apply (auto)
  apply (case_tac c)
              apply (auto)
    *)

    (*
fun parent_res where
  "parent_res NilStack y x = False"
| "parent_res (ConsStack a r_s rs_map') y x = (parent_res rs_map' y x \<or>
    (a = y \<and> (r_s x \<noteq> NoPerm \<or> (\<exists> y'. r_s y' \<noteq> NoPerm \<and> parent_res rs_map' y' x))))"

lemma fpr_coerce: "\<lbrakk> \<And>s. \<lbrakk>x \<in> complete_vars rs_map s; x \<notin> s \<rbrakk> \<Longrightarrow> \<exists>y. y \<in> s \<and> parent_res rs_map y x;
  x \<in> complete_vars rs_map s; x \<notin> s \<rbrakk> \<Longrightarrow> \<exists>y. y \<in> s \<and> parent_res rs_map y x"
  apply (auto)
  done

    *)(*

    (* if x is in the completion of s, it is in the completion of t + s *)
lemma union_complete_vars: "\<lbrakk> x \<in> complete_vars rs_map t \<rbrakk> \<Longrightarrow> x \<in> complete_vars rs_map (t \<union> s)"
  apply (induct rs_map arbitrary: s t)
   apply (auto)
   apply (rule_tac t="use_env_vars x2 \<union> (t \<union> s)" and s="(use_env_vars x2 \<union> t) \<union> s" in subst)
    apply (auto)
  apply (case_tac "x1 \<in> t")
   apply (auto)
   apply (rule_tac t="use_env_vars x2 \<union> (t \<union> s)" and s="(use_env_vars x2 \<union> t) \<union> s" in subst)
    apply (auto)
  apply (rule_tac t="use_env_vars x2 \<union> (t \<union> s)" and s="t \<union> (use_env_vars x2 \<union> s)" in subst)
   apply (auto)
  done

    (* if x is in the completion of t + s, but not in the completion of s, it must be in the completion of t *)
lemma union_complete_vars_rev: "\<lbrakk> x \<in> complete_vars rs_map (t \<union> s) \<rbrakk> \<Longrightarrow> x \<in> complete_vars rs_map s \<or> x \<in> complete_vars rs_map t"
  apply (induct rs_map arbitrary: t s)
   apply (auto)
     apply (case_tac "x \<in> complete_vars rs_map t")
      apply (cut_tac rs_map="rs_map" and t="t" and s="use_env_vars x2" and x="x" in union_complete_vars)
       apply (auto)
     apply (case_tac "t \<union> use_env_vars x2 \<noteq> use_env_vars x2 \<union> t")
      apply (auto)
    apply (case_tac "use_env_vars x2 \<union> (t \<union> s) \<noteq> (use_env_vars x2 \<union> s) \<union> t")
     apply (auto)
   apply (case_tac "use_env_vars x2 \<union> (t \<union> s) \<noteq> (use_env_vars x2 \<union> s) \<union> t")
    apply (auto)
  apply (case_tac "use_env_vars x2 \<union> (t \<union> s) \<noteq> (use_env_vars x2 \<union> t) \<union> s")
   apply (auto)
  done

lemma complete_vars_subset_ih: "\<lbrakk> s \<subseteq> s' \<rbrakk> \<Longrightarrow> s \<subseteq> complete_vars rs_map s'"
  apply (induct rs_map arbitrary: s')
   apply (auto)
  apply (case_tac "s \<subseteq> (use_env_vars x2 \<union> s')")
   apply (auto)
  done

lemma complete_vars_subset: "s \<subseteq> complete_vars rs_map s"
  apply (rule_tac complete_vars_subset_ih)
  apply (simp)
  done

*)

lemma full_dom_child_leq_use_env: "\<lbrakk> scope_res_map rs_map; full_dom_use_env env rs_map e x \<noteq> NoPerm \<rbrakk>
       \<Longrightarrow> leq_use_env (lookup_res rs_map x) (full_dom_use_env env rs_map e)"
  apply (simp add: lookup_res_def)
  apply (case_tac "lookup_mem rs_map x")
   apply (auto)
   apply (rule_tac leq_empty_use_env)
  apply (simp add: leq_use_env_def)
  apply (auto)
  apply (case_tac "a xa = NoPerm")
   apply (auto)
  apply (cut_tac env="env" and rs_map="rs_map" and x="x" and y="xa" in full_dom_recall)
     apply (auto)
   apply (simp add: lookup_res_def)
   apply (cut_tac rs_map="rs_map" and r_s="a" in scope_res_map_strong)
     apply (auto)
   apply (simp add: strong_use_env_def)
   apply (case_tac "a xa")
     apply (auto)
  apply (simp add: full_dom_use_env_def)
  apply (simp add: dom_use_env_def)
  apply (auto)
  apply (case_tac "\<exists>l z. z \<in> non_prim_vars env e \<and> path_lookup rs_map z l xa")
   apply (auto)
  done

lemma valid_np_dom_disj_use_env: "\<lbrakk> well_typed env r_s (app_hole h (AppExp (ConstExp ForkConst) e)) tau r_s2 rx; is_value e;
  full_dom_use_env env rs_map e x \<noteq> NoPerm; valid_res_map s rs_map; valid_use_env s rs_map r_c r_s \<rbrakk> \<Longrightarrow>
  disj_use_env (lookup_res rs_map x) (np_dom_use_env env e)"
  apply (case_tac "r_c x = NoPerm")
   apply (cut_tac r_x="full_dom_use_env env rs_map e" and r_s="r_c" and x="x" in leq_use_none)
     apply (rule_tac valid_full_dom_leq_use_env)
        apply (auto)
  apply (rule_tac r_s="r_s" in disj_leq_use_env2)
   apply (simp add: valid_use_env_def)
   apply (auto)
   apply (erule_tac x="x" in allE)
   apply (auto)
   apply (simp add: valid_use_entry_def)
  apply (rule_tac valid_np_dom_leq_use_env)
    apply (auto)
  done

    (* in theory we know that x is non-prim *)
lemma valid_full_dom_disj_use_env: "\<lbrakk>
  well_typed env r_s (app_hole h (AppExp (ConstExp ForkConst) e)) tau r_s2 rx; is_value e;
  r_c x \<noteq> NoPerm; full_dom_use_env env rs_map e x = NoPerm; valid_res_map s rs_map; valid_use_env s rs_map r_c r_s \<rbrakk> \<Longrightarrow>
  mini_disj_use_env (full_dom_use_env env rs_map e) (lookup_res rs_map x)"
  apply (simp add: mini_disj_use_env_def)
  apply (auto)
  apply (simp add: full_dom_use_env_def)
  apply (simp add: dom_use_env_def)
  apply (case_tac "\<exists>l z. z \<in> non_prim_vars env e \<and> path_lookup rs_map z l xa")
   apply (auto)
    (* if l = [], xa is a non_prim_var, which means xa is in r_s xa *)
  apply (case_tac l)
   apply (auto)
   apply (case_tac "r_s xa \<noteq> OwnPerm")
    apply (cut_tac ?r_s1.0="r_s" and env="env" and x="xa" in safe_fork_own_npv_use)
       apply (auto)
    (* however the map of x should be disjoint *)
   apply (simp add: valid_use_env_def)
   apply (auto)
   apply (erule_tac x="x" in allE)
   apply (auto)
   apply (simp add: valid_use_entry_def)
   apply (simp add: disj_use_env_def)
   apply (simp add: mini_disj_use_env_def)
    (* in that case, we use path lookup to get the parent of xa *)
  apply (case_tac "lookup_mem rs_map z")
   apply (auto)
  apply (cut_tac rs_map="rs_map" and z="z" and l="a # list" and x="xa" in path_lookup_parent)
     apply (auto)
   apply (simp add: valid_res_map_def)
    (* because y contains xa, if x also contains xa, we break map disjointness. to prove y \<noteq> x, we use the fact that
        x is not in the completion *)
  apply (case_tac "\<exists>l z. z \<in> non_prim_vars env e \<and> path_lookup rs_map z l x")
   apply (auto)
  apply (case_tac "x = y")
   apply (erule_tac x="l'" in allE)
   apply (erule_tac x="z" in allE)
   apply (auto)
    (* map disjointness *)
  apply (simp add: valid_res_map_def)
  apply (simp add: disj_res_map_def)
  apply (auto)
  apply (erule_tac x="x" in allE)
  apply (erule_tac x="y" in allE)
  apply (auto)
  apply (simp add: strong_disj_use_env_def)
  apply (erule_tac x="xa" in allE)
  apply (auto)
  apply (simp add: lookup_res_def)
  done*)

    (* ##### 5. final proof composition ##### *)

lemma safe_red_proc_set: "\<lbrakk> well_typed_system env rs_map p_map s1 ps1; red_proc_set (s1, ps1) r_ax (s2, ps2); valid_reduct app_red_exp \<rbrakk> \<Longrightarrow>
  (\<exists> r_s g_ax p_map'. well_typed_system (red_env env g_ax) (red_nres_map rs_map g_ax) p_map' s2 ps2 \<and> safe_act s1 r_s g_ax)"
    (* split over process reduction type. *)
  apply (case_tac "r_ax")
    apply (auto)
    (* single thread action case. *)
    apply (rule_tac srps_thread_case)
          apply (auto)
    (* fork case. *)
   apply (rule_tac srps_fork_case)
          apply (auto)
    (* send case. *)
  apply (rule_tac srps_send_case)
                apply (auto)
done

end