theory DropEnv
  imports WTLemma
begin

lemma var_value_prim1: "\<lbrakk> v \<noteq> NoRef; var_val_type v tau tau_x \<rbrakk> \<Longrightarrow> req_type tau \<noteq> Prim"
  apply (case_tac v)
    apply (auto)
   apply (case_tac tau_x)
         apply (auto)
  apply (case_tac tau_x)
        apply (auto)
  done

lemma var_value_unlim: "\<lbrakk> v \<noteq> NoRef; var_val_type v tau tau_x \<rbrakk> \<Longrightarrow> req_type tau_x = Ref"
  apply (case_tac v)
    apply (auto)
   apply (case_tac tau_x)
         apply (auto)
  apply (case_tac tau_x)
        apply (auto)
  done

    (* - requirements dropping (reduces requirements to pass into lambdas) *)

definition drop_use_env where
  "drop_use_env r_s = (\<lambda> x. if r_s x = OwnPerm then UsePerm else r_s x)"

lemma self_drop_leq_use_env: "leq_use_env (drop_use_env r_x) r_x"
  apply (simp add: leq_use_env_def)
  apply (simp add: drop_use_env_def)
  apply (auto)
  apply (case_tac "r_x x")
    apply (auto)
  done

lemma drop_leq_use_env: "\<lbrakk> leq_use_env r_x r_s \<rbrakk> \<Longrightarrow> leq_use_env (drop_use_env r_x) r_s"
  apply (rule_tac r_sb="r_x" in trans_leq_use_env)
   apply (simp)
  apply (rule_tac self_drop_leq_use_env)
  done

lemma dist_drop_leq_use_env: "\<lbrakk> leq_use_env r_x r_s \<rbrakk> \<Longrightarrow> leq_use_env (drop_use_env r_x) (drop_use_env r_s)"
  apply (simp add: leq_use_env_def)
  apply (auto)
  apply (erule_tac x="x" in allE)
  apply (simp add: drop_use_env_def)
  apply (auto)
   apply (case_tac "r_s x")
     apply (auto)
  apply (case_tac "r_x x")
    apply (auto)
  done

lemma weak_drop_use_env: "\<lbrakk> weak_use_env r_s \<rbrakk> \<Longrightarrow> drop_use_env r_s = r_s"
  apply (case_tac "\<forall> x. drop_use_env r_s x = r_s x")
   apply (auto)
  apply (simp add: drop_use_env_def)
  apply (simp add: weak_use_env_def)
  done

lemma drop_weak_use_env: "weak_use_env (drop_use_env r_s)"
  apply (simp add: weak_use_env_def)
  apply (simp add: drop_use_env_def)
  done

lemma dist_drop_comp_use_env: "drop_use_env (comp_use_env r_sa r_sb) = comp_use_env (drop_use_env r_sa) (drop_use_env r_sb)"
  apply (case_tac "\<forall> x. drop_use_env (comp_use_env r_sa r_sb) x = comp_use_env (drop_use_env r_sa) (drop_use_env r_sb) x")
   apply (auto)
  apply (simp add: comp_use_env_def)
  apply (simp add: drop_use_env_def)
  apply (case_tac "r_sa x")
    apply (auto)
    apply (case_tac "r_sb x")
      apply (auto)
   apply (case_tac "r_sb x")
     apply (auto)
  apply (case_tac "r_sb x")
    apply (auto)
  done

lemma drop_lift_leq_use_env: "leq_use_env (drop_use_env (lift_use_env r_s r)) (lift_use_env (drop_use_env r_s) r)"
  apply (simp add: drop_use_env_def)
  apply (simp add: leq_use_env_def)
  apply (auto)
   apply (case_tac r)
     apply (auto)
  apply (case_tac r)
    apply (auto)
   apply (case_tac "r_s x")
     apply (auto)
  apply (case_tac "r_s x")
    apply (auto)
  done

lemma rhs_drop_leq_use_env: "\<lbrakk> weak_use_env r_x; leq_use_env r_x r_s \<rbrakk> \<Longrightarrow> leq_use_env r_x (drop_use_env r_s)"
  apply (simp add: weak_use_env_def)
  apply (simp add: leq_use_env_def)
  apply (simp add: drop_use_env_def)
  apply (auto)
  apply (erule_tac x="x" in allE)
  apply (erule_tac x="x" in allE)
  apply (case_tac "r_x x")
    apply (auto)
  done

lemma diff_drop_use_env: "drop_use_env (diff_use_env r_s r_ex) = diff_use_env (drop_use_env r_s) r_ex"
  apply (case_tac "\<forall> x. drop_use_env (diff_use_env r_s r_ex) x = diff_use_env (drop_use_env r_s) r_ex x")
   apply (auto)
  apply (simp add: diff_use_env_def)
  apply (simp add: minus_use_env_def)
  apply (simp add: neg_use_env_def)
  apply (simp add: drop_use_env_def)
  apply (case_tac "r_s x")
    apply (auto)
   apply (case_tac "r_ex x")
     apply (auto)
  apply (case_tac "r_ex x")
    apply (auto)
  done

lemma dist_drop_diff_use_env: "diff_use_env (drop_use_env r_s) r_x = drop_use_env (diff_use_env r_s r_x)"
  apply (case_tac "\<forall> x. diff_use_env (drop_use_env r_s) r_x x = drop_use_env (diff_use_env r_s r_x) x")
   apply (auto)
  apply (simp add: diff_use_env_def)
  apply (simp add: minus_use_env_def)
  apply (simp add: drop_use_env_def)
  apply (simp add: neg_use_env_def)
  apply (case_tac "r_s x = OwnPerm")
   apply (auto)
   apply (case_tac "r_x x")
     apply (auto)
   apply (simp add: neg_use_env_def)
  apply (case_tac "r_s x")
    apply (auto)
  apply (case_tac "r_x x")
    apply (auto)
    apply (simp_all add: neg_use_env_def)
  done

lemma wtsdr_weak_use_env: "\<lbrakk> leq_use_env r_s (diff_use_env r_s r_x); leq_use_env r_x r_s \<rbrakk> \<Longrightarrow> weak_use_env r_x"
  apply (simp add: leq_use_env_def)
  apply (simp add: diff_use_env_def)
  apply (simp add: minus_use_env_def)
  apply (simp add: neg_use_env_def)
  apply (simp add: weak_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_s x")
    apply (auto)
  done

lemma wt_sexp_drop_all: "\<lbrakk> well_typed env rx e tau rx rx'; req_type tau \<noteq> Aff; is_sexp e \<rbrakk> \<Longrightarrow>
  well_typed env (drop_use_env rx) e tau (drop_use_env rx) (drop_use_env rx')"
  apply (induct e arbitrary: env tau rx rx')
        apply (auto)
    (* const + op cases *)
          apply (rule_tac id_leq_use_env)
         apply (rule_tac dist_drop_leq_use_env)
         apply (simp)
        apply (rule_tac id_leq_use_env)
       apply (rule_tac dist_drop_leq_use_env)
       apply (simp)
    (* var case p1 *)
      apply (rule_tac ereq_leq_use_envx)
      apply (cut_tac r_x="ereq_use_env x1a tau_x" and r_s="rx" and x="x1a" in spec_leq_perm)
       apply (simp)
      apply (simp add: ereq_use_env_def)
      apply (simp add: one_use_env_def)
      apply (simp add: drop_use_env_def)
      apply (simp add: end_req_perm_def)
      apply (cut_tac v="x2a" and tau_x="tau_x" in var_value_unlim)
        apply (auto)
    (* var case p2 *)
     apply (cut_tac r_s="rx" and r_x="comp_use_env (ereq_use_env x1a tau_x) r_ex" in wtsdr_weak_use_env)
       apply (simp)
      apply (rule_tac dist_comp_leq_use_env)
       apply (auto)
     apply (rule_tac x="r_ex" in exI)
     apply (auto)
        apply (rule_tac rhs_weak_leq_use_env)
         apply (case_tac tau)
               apply (auto)
        apply (rule_tac id_leq_use_env)
       apply (rule_tac dist_drop_leq_use_env)
       apply (simp)
      apply (rule_tac rhs_drop_leq_use_env)
       apply (rule_tac r_sa="ereq_use_env x1a tau_x" in weak_comp_use_env2)
       apply (auto)
     apply (rule_tac rhs_drop_leq_use_env)
      apply (rule_tac weak_diff_use_env)
      apply (rule_tac r_sb="r_ex" in weak_comp_use_env1)
      apply (case_tac tau)
            apply (auto)
    (* pair case *)
    apply (case_tac "r = OwnPerm")
     apply (auto)
    apply (case_tac "max_aff (req_type t1) (req_type t2) = Aff")
     apply (case_tac r)
       apply (auto)
    apply (case_tac "req_type t1 = Aff")
     apply (auto)
    apply (case_tac "req_type t2 = Aff")
      apply (case_tac "req_type t1")
       apply (auto)
    apply (case_tac "lift_use_env rx2 r \<noteq> rx2 \<or> lift_use_env rx1 r \<noteq> rx1")
     apply (case_tac r)
       apply (auto)
(*
    apply (case_tac "\<not> (req_type t1 \<noteq> Aff \<and> req_type t2 \<noteq> Aff)")
     apply (auto)
     apply (case_tac "req_type t1")
       apply (auto)*)
    apply (cut_tac r_s="rx" and r_x="r_ex" in wtsdr_weak_use_env)
      apply (rule_tac r_sb="diff_use_env r_s3 r_ex" in trans_leq_use_env)
       apply (rule_tac dist_diff_leq_use_env)
       apply (rule_tac r_sb="r_s2" 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 x="drop_use_env rx" in exI)
    apply (rule_tac x="drop_use_env rx" in exI)
    apply (rule_tac x="drop_use_env rx1" in exI)
    apply (auto)
     apply (cut_tac e="e1" in value_is_sexp)
      apply (auto)
     apply (cut_tac env="env" and ?r_s1.0="rx" and r_c="r_s2" and ?r_s2.0="rx" and e="e1" and tau="t1" and rx="rx1" in well_typed_decr_end_perm)
        apply (auto)
      apply (rule_tac r_sb="diff_use_env r_s3 r_ex" in trans_leq_use_env)
       apply (rule_tac diff_leq_use_env)
       apply (rule_tac well_typed_perm_leq)
       apply (auto)
     apply (rule_tac r_sb="r_s2" in trans_leq_use_env)
      apply (rule_tac well_typed_perm_leq)
      apply (auto)
     apply (rule_tac well_typed_perm_leqx)
     apply (auto)
    apply (cut_tac r_sc="r_s3" and r_sb="r_s2" and r_sa="rx" in trans_leq_use_env)
      apply (rule_tac well_typed_perm_leq)
      apply (auto)
     apply (rule_tac well_typed_perm_leq)
     apply (auto)
    apply (cut_tac r_sc="rx" and r_sb="diff_use_env r_s3 r_ex" and r_sa="r_s3" in trans_leq_use_env)
      apply (rule_tac self_diff_leq_use_env)
     apply (simp)
    apply (case_tac "lift_use_env (drop_use_env rx2) r \<noteq> drop_use_env rx2")
     apply (case_tac r)
       apply (auto)
    apply (case_tac "lift_use_env (drop_use_env rx1) r \<noteq> drop_use_env rx1")
     apply (case_tac r)
       apply (auto)
    apply (rule_tac x="drop_use_env rx2" in exI)
    apply (auto)
          apply (cut_tac e="e2" in value_is_sexp)
           apply (auto)
          apply (cut_tac env="env" and ?r_s1.0="rx" and r_c="r_s3" and ?r_s2.0="rx" and e="e2" and tau="t2" and rx="rx2" in well_typed_decr_end_perm)
             apply (rule_tac ?r_s1.0="r_s2" in well_typed_incr_start_perm)
              apply (auto)
           apply (rule_tac well_typed_perm_leq)
           apply (auto)
          apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
         apply (auto)
         apply (rule_tac dist_drop_leq_use_env)
         apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
          apply (auto)
        apply (rule_tac dist_drop_leq_use_env)
        apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
         apply (auto)
     apply (rule_tac r_s="rx1" in disj_leq_use_env1)
      apply (rule_tac r_s="rx2" in disj_leq_use_env2)
       apply (simp)
      apply (rule_tac self_drop_leq_use_env)
     apply (rule_tac self_drop_leq_use_env)
    apply (rule_tac x="empty_use_env" in exI)
    apply (auto)
       apply (rule_tac rhs_weak_leq_use_env)
        apply (simp add: weak_use_env_def)
        apply (simp add: empty_use_env_def)
       apply (rule_tac id_leq_use_env)
      apply (rule_tac dist_drop_leq_use_env)
      apply (simp)
     apply (rule_tac leq_empty_use_env)
    apply (case_tac "req_type (PairTy t1 t2 r) = Prim")
     apply (simp add: pair_req_def)
     apply (rule_tac leq_empty_use_env)
    apply (simp add: pair_req_def)
    apply (rule_tac diff_leq_use_env)
    apply (rule_tac r_sb="drop_use_env (diff_use_env (comp_use_env rx1 rx2) r_ex)" in trans_leq_use_env)
     apply (rule_tac dist_drop_leq_use_env)
     apply (simp)
    apply (rule_tac t="drop_use_env (diff_use_env (comp_use_env rx1 rx2) r_ex)" and s="diff_use_env (drop_use_env (comp_use_env rx1 rx2)) r_ex" in subst)
     apply (rule_tac dist_drop_diff_use_env)
    apply (rule_tac rhs_weak_leq_use_env)
     apply (simp)
    apply (simp add: dist_drop_comp_use_env)
    apply (rule_tac id_leq_use_env)
    (* lam case *)
   apply (simp add: aff_use_env_def)
   apply (rule_tac x="rxa" in exI)
   apply (auto)
    apply (rule_tac rhs_drop_leq_use_env)
     apply (auto)
    apply (case_tac a)
      apply (auto)
    apply (simp add: weak_use_env_def)
    apply (simp add: null_use_env_def)
   apply (cut_tac r_s="rx" and r_x="r_ex" in wtsdr_weak_use_env)
     apply (auto)
   apply (rule_tac x="r_ex" in exI)
   apply (auto)
      apply (rule_tac rhs_weak_leq_use_env)
       apply (simp)
      apply (rule_tac id_leq_use_env)
     apply (rule_tac dist_drop_leq_use_env)
     apply (simp)
    apply (rule_tac rhs_drop_leq_use_env)
     apply (auto)
   apply (rule_tac rhs_drop_leq_use_env)
    apply (rule_tac weak_diff_use_env)
    apply (auto)
   apply (case_tac a)
     apply (auto)
   apply (simp add: weak_use_env_def)
   apply (simp add: null_use_env_def)
    (* app case. e1 *)
  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="drop_use_env rx" in exI)
  apply (rule_tac x="empty_use_env" in exI)
  apply (auto)
   apply (case_tac e1)
         apply (auto)
    apply (rule_tac id_leq_use_env)
   apply (rule_tac leq_empty_use_env)
    (* app case. e2, lambda unrolling *)
  apply (rule_tac x="drop_use_env rx2" in exI)
  apply (rule_tac x="drop_use_env rx" in exI)
  apply (auto)
   apply (cut_tac env="env" and r_c="rx" and ?r_s1.0="r_s2" and ?r_s2.0="rx" and e="e2" and tau="t1" and rx="rx2" in well_typed_incr_start_perm)
     apply (rule_tac r_c="r_s3" in well_typed_decr_end_perm)
       apply (simp)
      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 r_sb="r_s3" in trans_leq_use_env)
      apply (rule_tac r_sb="r_s2" 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 well_typed_perm_leqx)
     apply (auto)
    apply (rule_tac well_typed_perm_leq)
    apply (auto)
    (* - prove that e2 is an s-expression *)
   apply (case_tac "\<not> is_sexp e2")
    apply (cut_tac ?e1.0="e1" and ?e2.0="e2" in e2_sexp)
     apply (simp_all)
    (* - prove that t1 is unlim *)
   apply (case_tac "\<not> req_type t1 \<noteq> Aff")
    apply (case_tac e1)
         apply (auto)
    apply (case_tac x1)
               apply (auto)
        apply (simp_all add: pure_fun_def)
    (* app case. tau primitive case (only happens for fixed point w/ primitive fun) *)
  apply (simp add: app_req_def)
  apply (case_tac "req_type tau = Prim")
   apply (auto)
   apply (case_tac e1)
        apply (auto)
    apply (case_tac x1)
                apply (auto)
        apply (simp_all add: pure_fun_def)
   apply (auto)
   apply (case_tac t)
          apply (auto)
   apply (case_tac "\<not> weak_use_env empty_use_env")
    apply (simp add: weak_use_env_def)
    apply (simp add: empty_use_env_def)
   apply (rule_tac x="empty_use_env" in exI)
   apply (auto)
         apply (rule_tac rhs_weak_leq_use_env)
          apply (rule_tac dist_weak_comp_use_env)
           apply (rule_tac dist_weak_comp_use_env)
            apply (auto)
          apply (rule_tac drop_weak_use_env)
         apply (rule_tac id_leq_use_env)
       apply (rule_tac dist_comp_leq_use_env)
        apply (rule_tac leq_empty_use_env)
       apply (rule_tac dist_drop_leq_use_env)
       apply (rule_tac r_sb="r_s2" in trans_leq_use_env)
        apply (simp)
       apply (rule_tac r_sb="r_s3" in trans_leq_use_env)
        apply (rule_tac well_typed_perm_leq)
        apply (auto)
       apply (rule_tac well_typed_perm_leqx)
       apply (auto)
      apply (rule_tac disj_empty_use_env2)
     apply (rule_tac dist_drop_leq_use_env)
     apply (simp)
    apply (rule_tac leq_empty_use_env)
   apply (rule_tac leq_empty_use_env)
    (* non prim case. *)
    (* - prove weakness of rx1 + rx2 + r_ex *)
  apply (cut_tac r_s="r_s3" and r_x="comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex" in wtsdr_weak_use_env)
    apply (rule_tac r_sb="rx" in trans_leq_use_env)
     apply (simp)
    apply (rule_tac r_sb="r_s2" 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_comp_leq_use_env)
    apply (simp)
   apply (rule_tac r_sb="rx" in trans_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 self_diff_leq_use_env)
    apply (simp_all)
    (* - r not ownership *)
  apply (case_tac "r = OwnPerm")
   apply (case_tac e1)
        apply (auto)
   apply (case_tac x1)
               apply (auto)
        apply (simp_all add: pure_fun_def)
    (* - final manipulation *)
  apply (rule_tac x="r_ex" in exI)
  apply (auto)
       apply (rule_tac rhs_weak_leq_use_env)
        apply (rule_tac r_s="comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex" in leq_weak_use_env)
         apply (simp)
        apply (rule_tac dist_comp_leq_use_env)
         apply (rule_tac comp_leq_use_env1)
         apply (rule_tac dist_comp_leq_use_env)
          apply (rule_tac leq_empty_use_env)
         apply (rule_tac comp_leq_use_env2)
         apply (rule_tac dist_lift_leq_use_env)
         apply (rule_tac self_drop_leq_use_env)
        apply (rule_tac self_comp_leq_use_env2)
       apply (rule_tac id_leq_use_env)
(*
       apply (simp add: drop_use_env_def)
       apply (case_tac r)
         apply (auto)*)
      apply (rule_tac dist_comp_leq_use_env)
       apply (rule_tac leq_empty_use_env)
      apply (case_tac "lift_use_env (drop_use_env rx2) r \<noteq> drop_use_env rx2")
       apply (case_tac r)
         apply (auto)
      apply (rule_tac dist_drop_leq_use_env)
      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_s2" 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 comp_leq_use_env2)
      apply (rule_tac self_lift_leq_use_env)
     apply (rule_tac disj_empty_use_env2)
    apply (rule_tac dist_drop_leq_use_env)
    apply (simp)
   apply (rule_tac rhs_drop_leq_use_env)
    apply (rule_tac r_sa="comp_use_env rx1 (lift_use_env rx2 r)" in weak_comp_use_env2)
    apply (auto)
  apply (rule_tac r_sb="drop_use_env (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 (rule_tac dist_drop_leq_use_env)
   apply (auto)
  apply (rule_tac rhs_drop_leq_use_env)
   apply (rule_tac weak_diff_use_env)
   apply (rule_tac dist_weak_comp_use_env)
    apply (simp add: weak_use_env_def)
    apply (simp add: empty_use_env_def)
   apply (rule_tac drop_weak_use_env)
  apply (rule_tac rhs_weak_leq_use_env)
   apply (simp)
  apply (rule_tac diff_leq_use_env)
  apply (rule_tac dist_comp_leq_use_env)
   apply (rule_tac leq_empty_use_env)
  apply (rule_tac comp_leq_use_env2)
  apply (rule_tac self_drop_leq_use_env)
  done

lemma wt_sexp_drop_req: "\<lbrakk> well_typed env r_s1 e tau r_s2 rx; req_type tau \<noteq> Aff; (*\<not> aff_fun_ty tau;*) is_sexp e \<rbrakk> \<Longrightarrow>
    well_typed env r_s1 e tau r_s2 (drop_use_env rx)"
  apply (induct e arbitrary: r_s1 r_s2 tau rx)
        apply (auto)
    (* const + op cases *)
       apply (rule_tac drop_leq_use_env)
       apply (simp)
      apply (rule_tac drop_leq_use_env)
      apply (simp)
    (* var case. *)
     apply (rule_tac x="r_ex" in exI)
     apply (auto)
      apply (rule_tac drop_leq_use_env)
      apply (simp)
     apply (rule_tac rhs_drop_leq_use_env)
      apply (rule_tac weak_diff_use_env)
      apply (rule_tac weak_ereq_use_env)
      apply (cut_tac tau_x="tau_x" in var_value_unlim)
        apply (auto)
     apply (simp add: unlim_def)
    (* pair case. *)
    apply (case_tac "r = OwnPerm")
     apply (auto)
    apply (case_tac "max_aff (req_type t1) (req_type t2) = Aff")
     apply (case_tac r)
       apply (auto)
    apply (rule_tac x="r_s2a" in exI)
    apply (rule_tac x="r_s3" in exI)
    apply (rule_tac x="drop_use_env rx1" in exI)
    apply (auto)
     apply (case_tac "req_type t1 = Aff")
      apply (auto)
     apply (cut_tac e="e1" in value_is_sexp)
      apply (auto)
    apply (rule_tac x="drop_use_env rx2" in exI)
    apply (auto)
        apply (case_tac "req_type t2 = Aff")
         apply (case_tac "req_type t1")
           apply (auto)
        apply (cut_tac e="e2" in value_is_sexp)
         apply (auto)
       apply (rule_tac r_sb="lift_use_env rx1 r" in trans_leq_use_env)
        apply (simp)
       apply (rule_tac dist_lift_leq_use_env)
       apply (rule_tac self_drop_leq_use_env)
      apply (rule_tac r_sb="lift_use_env rx2 r" in trans_leq_use_env)
       apply (simp)
      apply (rule_tac dist_lift_leq_use_env)
      apply (rule_tac self_drop_leq_use_env)
     apply (rule_tac r_s="lift_use_env rx1 r" in disj_leq_use_env1)
      apply (rule_tac r_s="lift_use_env rx2 r" in disj_leq_use_env2)
       apply (simp)
      apply (rule_tac dist_lift_leq_use_env)
      apply (rule_tac self_drop_leq_use_env)
     apply (rule_tac dist_lift_leq_use_env)
     apply (rule_tac self_drop_leq_use_env)
    apply (rule_tac x="r_ex" in exI)
    apply (auto)
     apply (rule_tac drop_leq_use_env)
     apply (simp)
    apply (case_tac "lift_use_env (drop_use_env rx1) r \<noteq> drop_use_env rx1")
     apply (case_tac r)
       apply (auto)
    apply (case_tac "lift_use_env (drop_use_env rx2) r \<noteq> drop_use_env rx2")
     apply (case_tac r)
       apply (auto)
    apply (case_tac "req_type (PairTy t1 t2 r) = Prim")
     apply (simp add: pair_req_def)
     apply (rule_tac leq_empty_use_env)
    apply (simp add: pair_req_def)
    apply (rule_tac rhs_drop_leq_use_env)
     apply (rule_tac weak_diff_use_env)
     apply (rule_tac dist_weak_comp_use_env)
      apply (rule_tac drop_weak_use_env)
     apply (rule_tac drop_weak_use_env)
    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 dist_comp_leq_use_env)
     apply (rule_tac comp_leq_use_env1)
     apply (rule_tac drop_leq_use_env)
     apply (rule_tac self_lift_leq_use_env)
    apply (rule_tac comp_leq_use_env2)
    apply (rule_tac drop_leq_use_env)
    apply (rule_tac self_lift_leq_use_env)
    (* lam case  *)
   apply (rule_tac x="rxa" in exI)
   apply (auto)
   apply (rule_tac x="r_ex" in exI)
   apply (auto)
    apply (rule_tac drop_leq_use_env)
    apply (simp)
   apply (rule_tac rhs_drop_leq_use_env)
    apply (rule_tac weak_diff_use_env)
    apply (simp add: aff_use_env_def)
    apply (case_tac a)
      apply (auto)
   apply (simp add: null_use_env_def)
   apply (simp add: weak_use_env_def)
    (* app 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="drop_use_env rx1" in exI)
  apply (auto)
   apply (case_tac "req_type (FunTy t1 tau r a) = Aff")
    apply (case_tac e1)
          apply (auto)
    apply (case_tac x1)
                apply (auto)
         apply (simp_all add: pure_fun_def)
   apply (case_tac "\<not> is_sexp e1")
    apply (case_tac e1)
          apply (auto)
  apply (rule_tac x="drop_use_env rx2" in exI)
  apply (rule_tac x="r_s3" in exI)
  apply (auto)
   apply (case_tac "req_type t1 = Aff")
    apply (case_tac e1)
          apply (auto)
    apply (case_tac x1)
                apply (auto)
         apply (simp_all add: pure_fun_def)
   apply (case_tac "\<not> is_sexp e2")
    apply (case_tac "is_value e2")
     apply (cut_tac e="e2" in value_is_sexp)
      apply (auto)
    apply (case_tac e1)
          apply (auto)
   apply (case_tac x1)
               apply (auto)
   apply (case_tac e2)
         apply (auto)
  apply (cut_tac r_xa="drop_use_env rx1" and r_xb="lift_use_env (drop_use_env rx2) r" and r_s="comp_use_env rx1 (lift_use_env rx2 r)" in dist_comp_leq_use_env)
    apply (rule_tac comp_leq_use_env1)
    apply (rule_tac self_drop_leq_use_env)
   apply (rule_tac comp_leq_use_env2)
   apply (rule_tac dist_lift_leq_use_env)
   apply (rule_tac self_drop_leq_use_env)
  apply (rule_tac x="comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex" 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 dist_diff_leq_use_env_gen)
        apply (rule_tac id_leq_use_env)
       apply (rule_tac dist_comp_leq_use_env)
        apply (rule_tac comp_leq_use_env1)
         apply (simp)
        apply (rule_tac id_leq_use_env)
       apply (simp)
     apply (rule_tac r_sb="comp_use_env rx1 (lift_use_env rx2 r)" in trans_leq_use_env)
      apply (simp_all)
    apply (rule_tac r_s="rx1" in disj_leq_use_env1)
     apply (rule_tac r_s="lift_use_env rx2 r" in disj_leq_use_env2)
      apply (simp)
     apply (rule_tac dist_lift_leq_use_env)
     apply (rule_tac self_drop_leq_use_env)
    apply (rule_tac self_drop_leq_use_env)
   apply (rule_tac drop_leq_use_env)
    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 (case_tac "req_type tau = Prim")
   apply (simp add: app_req_def)
   apply (rule_tac leq_empty_use_env)
  apply (simp add: app_req_def)
  apply (rule_tac rhs_drop_leq_use_env)
   apply (rule_tac weak_diff_use_env)
   apply (rule_tac dist_weak_comp_use_env)
    apply (rule_tac drop_weak_use_env)
   apply (rule_tac drop_weak_use_env)
  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_gen)
   apply (rule_tac dist_comp_leq_use_env)
    apply (rule_tac comp_leq_use_env1)
    apply (rule_tac self_drop_leq_use_env)
   apply (rule_tac comp_leq_use_env2)
   apply (rule_tac self_drop_leq_use_env)
  apply (rule_tac self_comp_leq_use_env2)
  done

    (* ####### primitive lemmas *)

lemma wt_sexp_no_all: "\<lbrakk> well_typed env r_s1 e tau r_s2 rx; req_type tau = Prim; is_sexp e \<rbrakk> \<Longrightarrow> well_typed env empty_use_env e tau empty_use_env empty_use_env"
  apply (induction e arbitrary: env tau r_s1 r_s2 rx)
        apply (auto)
    (* const + op case *)
       apply (rule_tac leq_empty_use_env)
       apply (rule_tac leq_empty_use_env)
    (* var cases (impossible) *)
      apply (simp add: var_value_prim1)
     apply (simp add: var_value_prim1)
    (* pair case *)
    apply (case_tac "r \<noteq> NoPerm")
     apply (case_tac r)
       apply (auto)
    apply (case_tac "max_aff (req_type t1) (req_type t2)")
      apply (auto)
    apply (case_tac "req_type t1")
       apply (auto)
     apply (case_tac "req_type t2")
       apply (auto)
    apply (case_tac "req_type t2")
      apply (auto)
    apply (rule_tac x="empty_use_env" in exI)
    apply (rule_tac x="empty_use_env" in exI)
    apply (rule_tac x="empty_use_env" in exI)
    apply (auto)
     apply (cut_tac e="e1" in value_is_sexp)
      apply (auto)
    apply (rule_tac x="empty_use_env" in exI)
    apply (auto)
        apply (cut_tac e="e2" in value_is_sexp)
         apply (auto)
      apply (rule_tac leq_empty_use_env)
     apply (rule_tac disj_empty_use_env1)
    apply (rule_tac x="empty_use_env" in exI)
    apply (auto)
      apply (rule_tac leq_empty_use_env)
     apply (rule_tac leq_empty_use_env)
    apply (simp add: pair_req_def)
    apply (rule_tac leq_empty_use_env)
    (* lam case *)
   apply (rule_tac x="rxa" in exI)
   apply (auto)
    apply (simp add: leq_use_env_def)
    apply (simp add: aff_use_env_def)
    apply (simp add: null_use_env_def)
   apply (rule_tac x="empty_use_env" in exI)
   apply (auto)
     apply (rule_tac leq_empty_use_env)
    apply (rule_tac leq_empty_use_env)
   apply (rule_tac diff_leq_use_env)
   apply (simp add: leq_use_env_def)
   apply (simp add: aff_use_env_def)
   apply (simp add: null_use_env_def)
    (* app case. since tau is primitive, the only possible const is the fix point *)
  apply (case_tac e1)
        apply (auto)
  apply (case_tac "x1 \<noteq> FixConst")
   apply (case_tac x1)
               apply (auto)
       apply (simp_all add: pure_fun_def)
    (* - with that in mind, we fill in the rest *)
  apply (auto)
  apply (rule_tac x="empty_use_env" in exI)
  apply (auto)
   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 (rule_tac x="empty_use_env" in exI)
  apply (rule_tac x="empty_use_env" in exI)
  apply (auto)
   apply (case_tac "\<not> is_sexp e2")
    apply (case_tac e2)
          apply (auto)
  apply (rule_tac x="empty_use_env" in exI)
  apply (auto)
       apply (rule_tac leq_empty_use_env)
     apply (rule_tac dist_comp_leq_use_env)
      apply (rule_tac leq_empty_use_env)
     apply (rule_tac leq_empty_use_env)
    apply (rule_tac disj_empty_use_env2)
   apply (rule_tac leq_empty_use_env)
  apply (simp add: app_req_def)
  apply (rule_tac leq_empty_use_env)
  done

lemma wt_sexp_no_req: "\<lbrakk> well_typed env r_s1 e tau r_s2 rx; req_type tau = Prim; is_sexp e \<rbrakk> \<Longrightarrow> well_typed env r_s1 e tau r_s2 empty_use_env"
  apply (rule_tac r_c="r_s1" in well_typed_decr_end_perm)
    apply (rule_tac r_s="empty_use_env" in well_typed_incr_simul_perm)
     apply (rule_tac leq_empty_use_env)
    apply (rule_tac wt_sexp_no_all)
      apply (auto)
   apply (rule_tac well_typed_perm_leq)
   apply (auto)
  apply (rule_tac leq_empty_use_env)
  done

fun drop_use_env_dep where
  "drop_use_env_dep r_s OwnPerm = r_s"
| "drop_use_env_dep r_s UsePerm = drop_use_env r_s"
| "drop_use_env_dep r_s NoPerm = empty_use_env"

lemma wt_sexp_drop_dep_req: "\<lbrakk> well_typed env r_s1 e tau r_s2 rx; is_sexp e; safe_type_x tau r \<rbrakk> \<Longrightarrow> well_typed env r_s1 e tau r_s2 (drop_use_env_dep rx r)"
  apply (case_tac r)
    apply (auto)
   apply (rule_tac wt_sexp_no_req)
     apply (auto)
  apply (rule_tac wt_sexp_drop_req)
    apply (auto)
  apply (simp add: unlim_def)
  done

end


(*  Title:      JinjaThreads/Compiler/Compiler1.thy
    Author:     Andreas Lochbihler, Tobias Nipkow

    Based on Jinja/Compiler/Compiler1
*)

section \<open>Compilation Stage 1\<close>

theory Compiler1 imports
  PCompiler
  J1State
  ListIndex
begin

definition fresh_var :: "vname list \<Rightarrow> vname"
  where "fresh_var Vs = sum_list (STR ''V'' # Vs)"

lemma fresh_var_fresh: "fresh_var Vs \<notin> set Vs"
proof -
  have "V \<in> set Vs \<Longrightarrow> length (String.explode V) < length (String.explode (fresh_var Vs))" for V
    by (induction Vs) (auto simp add: fresh_var_def Literal.rep_eq)
  then show ?thesis
    by auto
qed

text\<open>Replacing variable names by indices.\<close>

function compE1  :: "vname list \<Rightarrow> 'addr expr      \<Rightarrow> 'addr expr1"
  and compEs1 :: "vname list \<Rightarrow> 'addr expr list \<Rightarrow> 'addr expr1 list"
where
  "compE1 Vs (new C) = new C"
| "compE1 Vs (newA T\<lfloor>e\<rceil>) = newA T\<lfloor>compE1 Vs e\<rceil>"
| "compE1 Vs (Cast T e) = Cast T (compE1 Vs e)"
| "compE1 Vs (e instanceof T) = (compE1 Vs e) instanceof T"
| "compE1 Vs (Val v) = Val v"
| "compE1 Vs (Var V) = Var(index Vs V)"
| "compE1 Vs (e\<guillemotleft>bop\<guillemotright>e') = (compE1 Vs e)\<guillemotleft>bop\<guillemotright>(compE1 Vs e')"
| "compE1 Vs (V:=e) = (index Vs V):= (compE1 Vs e)"
| "compE1 Vs (a\<lfloor>i\<rceil>) = (compE1 Vs a)\<lfloor>compE1 Vs i\<rceil>"
| "compE1 Vs (a\<lfloor>i\<rceil>:=e) = (compE1 Vs a)\<lfloor>compE1 Vs i\<rceil>:=compE1 Vs e"
| "compE1 Vs (a\<bullet>length) = compE1 Vs a\<bullet>length"
| "compE1 Vs (e\<bullet>F{D}) = compE1 Vs e\<bullet>F{D}"
| "compE1 Vs (e\<bullet>F{D}:=e') = compE1 Vs e\<bullet>F{D}:=compE1 Vs e'"
| "compE1 Vs (e\<bullet>compareAndSwap(D\<bullet>F, e', e'')) = compE1 Vs e\<bullet>compareAndSwap(D\<bullet>F, compE1 Vs e', compE1 Vs e'')"
| "compE1 Vs (e\<bullet>M(es)) = (compE1 Vs e)\<bullet>M(compEs1 Vs es)"
| "compE1 Vs {V:T=vo; e} = {(size Vs):T=vo; compE1 (Vs@[V]) e}"
| "compE1 Vs (sync\<^bsub>U\<^esub> (o') e) = sync\<^bsub>length Vs\<^esub> (compE1 Vs o') (compE1 (Vs@[fresh_var Vs]) e)"
| "compE1 Vs (insync\<^bsub>U\<^esub> (a) e) = insync\<^bsub>length Vs\<^esub> (a) (compE1 (Vs@[fresh_var Vs]) e)"
| "compE1 Vs (e1;;e2) = (compE1 Vs e1);;(compE1 Vs e2)"
| "compE1 Vs (if (b) e1 else e2) = (if (compE1 Vs b) (compE1 Vs e1) else (compE1 Vs e2))"
| "compE1 Vs (while (b) e) = (while (compE1 Vs b) (compE1 Vs e))"
| "compE1 Vs (throw e) = throw (compE1 Vs e)"
| "compE1 Vs (try e1 catch(C V) e2) = try(compE1 Vs e1) catch(C (size Vs)) (compE1 (Vs@[V]) e2)"

| "compEs1 Vs []     = []"
| "compEs1 Vs (e#es) = compE1 Vs e # compEs1 Vs es"
by pat_completeness auto
termination
apply(relation "case_sum (\<lambda>p. size (snd p)) (\<lambda>p. size_list size (snd p)) <*mlex*> {}")
apply(rule wf_mlex[OF wf_empty])
apply(rule mlex_less, simp)+
done

lemmas compE1_compEs1_induct =
  compE1_compEs1.induct[case_names New NewArray Cast InstanceOf Val Var BinOp LAss AAcc AAss ALen FAcc FAss CAS Call Block Synchronized InSynchronized Seq Cond While throw TryCatch Nil Cons]

lemma compEs1_conv_map [simp]: "compEs1 Vs es = map (compE1 Vs) es"
by(induct es) simp_all

lemmas compEs1_map_Val = compEs1_conv_map

lemma compE1_eq_Val [simp]: "compE1 Vs e = Val v \<longleftrightarrow> e = Val v"
apply(cases e, auto)
done

lemma Val_eq_compE1 [simp]: "Val v = compE1 Vs e \<longleftrightarrow> e = Val v"
apply(cases e, auto)
done

lemma compEs1_eq_map_Val [simp]: "compEs1 Vs es = map Val vs \<longleftrightarrow> es = map Val vs"
apply(induct es arbitrary: vs)
apply(auto, blast)
done

lemma compE1_eq_Var [simp]: "compE1 Vs e = Var V \<longleftrightarrow> (\<exists>V'. e = Var V' \<and> V = index Vs V')"
by(cases e, auto)

lemma compE1_eq_Call [simp]:
  "compE1 Vs e = obj\<bullet>M(params) \<longleftrightarrow> (\<exists>obj' params'. e = obj'\<bullet>M(params') \<and> compE1 Vs obj' = obj \<and> compEs1 Vs params' = params)"
by(cases e, auto)

lemma length_compEs2 [simp]:
  "length (compEs1 Vs es) = length es"
by(simp add: compEs1_conv_map)

lemma fixes e :: "'addr expr" and es :: "'addr expr list"
  shows expr_locks_compE1 [simp]: "expr_locks (compE1 Vs e) = expr_locks e"
  and expr_lockss_compEs1 [simp]: "expr_lockss (compEs1 Vs es) = expr_lockss es"
by(induct Vs e and Vs es rule: compE1_compEs1.induct)(auto intro: ext)

lemma fixes e :: "'addr expr" and es :: "'addr expr list"
  shows contains_insync_compE1 [simp]: "contains_insync (compE1 Vs e) = contains_insync e"
  and contains_insyncs_compEs1 [simp]: "contains_insyncs (compEs1 Vs es) = contains_insyncs es"
by(induct Vs e and Vs es rule: compE1_compEs1.induct)simp_all

lemma fixes e :: "'addr expr" and es :: "'addr expr list"
  shows max_vars_compE1: "max_vars (compE1 Vs e) = max_vars e"
  and max_varss_compEs1: "max_varss (compEs1 Vs es) = max_varss es"
apply(induct Vs e and Vs es rule: compE1_compEs1.induct)
apply(auto)
done

lemma fixes e :: "'addr expr" and es :: "'addr expr list"
  shows \<B>: "size Vs = n \<Longrightarrow> \<B> (compE1 Vs e) n"
  and \<B>s: "size Vs = n \<Longrightarrow> \<B>s (compEs1 Vs es) n"
apply(induct Vs e and Vs es arbitrary: n and n rule: compE1_compEs1.induct)
apply auto
done

lemma fixes e :: "'addr expr" and es :: "'addr expr list"
  shows fv_compE1: "fv e \<subseteq> set Vs \<Longrightarrow> fv (compE1 Vs e) = (index Vs) ` (fv e)"
  and fvs_compEs1: "fvs es \<subseteq> set Vs \<Longrightarrow> fvs (compEs1 Vs es) = (index Vs) ` (fvs es)"
proof(induct Vs e and Vs es rule: compE1_compEs1_induct)
  case (Block Vs V ty vo exp)
  have IH: "fv exp \<subseteq> set (Vs @ [V]) \<Longrightarrow> fv (compE1 (Vs @ [V]) exp) = index (Vs @ [V]) ` fv exp" by fact
  from \<open>fv {V:ty=vo; exp} \<subseteq> set Vs\<close> have fv': "fv exp \<subseteq> set (Vs @ [V])" by auto
  from IH[OF this] have IH': "fv (compE1 (Vs @ [V]) exp) = index (Vs @ [V]) ` fv exp" .
  have "fv (compE1 (Vs @ [V]) exp) - {length Vs} = index Vs ` (fv exp - {V})"
  proof(rule equalityI[OF subsetI subsetI])
    fix x
    assume x: "x \<in> fv (compE1 (Vs @ [V]) exp) - {length Vs}"
    hence "x \<noteq> length Vs" by simp
    from x IH' have "x \<in> index (Vs @ [V]) ` fv exp" by simp
    thus "x \<in> index Vs ` (fv exp - {V})"
    proof(rule imageE)
      fix y
      assume [simp]: "x = index (Vs @ [V]) y"
        and y: "y \<in> fv exp"
      have "y \<noteq> V"
      proof
        assume [simp]: "y = V"
        hence "x = length Vs" by simp
        with \<open>x \<noteq> length Vs\<close> show False by contradiction
      qed
      moreover with fv' y have "y \<in> set Vs" by auto
      ultimately have "index (Vs @ [V]) y = index Vs y" by(simp)
      thus ?thesis using y \<open>y \<noteq> V\<close> by auto
    qed
  next
    fix x
    assume x: "x \<in> index Vs ` (fv exp - {V})"
    thus "x \<in> fv (compE1 (Vs @ [V]) exp) - {length Vs}"
    proof(rule imageE)
      fix y
      assume [simp]: "x = index Vs y"
        and y: "y \<in> fv exp - {V}"
      with fv' have "y \<in> set Vs" "y \<noteq> V" by auto
      hence "index Vs y = index (Vs @ [V]) y" by simp
      with y have "x \<in> index (Vs @ [V]) ` fv exp" by auto
      thus ?thesis using IH' \<open>y \<in> set Vs\<close> by simp
    qed
  qed
  thus ?case by simp
next
  case (Synchronized Vs V exp1 exp2)
  have IH1: "fv exp1 \<subseteq> set Vs \<Longrightarrow> fv (compE1 Vs exp1) = index Vs ` fv exp1"
    and IH2: "fv exp2 \<subseteq> set (Vs @ [fresh_var Vs]) \<Longrightarrow> fv (compE1 (Vs @ [fresh_var Vs]) exp2) = index (Vs @ [fresh_var Vs]) ` fv exp2"
    by fact+
  from \<open>fv (sync\<^bsub>V\<^esub> (exp1) exp2) \<subseteq> set Vs\<close> have fv1: "fv exp1 \<subseteq> set Vs"
    and fv2: "fv exp2 \<subseteq> set Vs" by auto
  from fv2 have fv2': "fv exp2 \<subseteq> set (Vs @ [fresh_var Vs])" by auto
  have "index (Vs @ [fresh_var Vs]) ` fv exp2 = index Vs ` fv exp2"
  proof(rule equalityI[OF subsetI subsetI])
    fix x
    assume x: "x \<in> index (Vs @ [fresh_var Vs]) ` fv exp2"
    thus "x \<in> index Vs ` fv exp2"
    proof(rule imageE)
      fix y
      assume [simp]: "x = index (Vs @ [fresh_var Vs]) y"
        and y: "y \<in> fv exp2"
      from y fv2 have "y \<in> set Vs" by auto
      moreover hence "y \<noteq> (fresh_var Vs)" by(auto simp add: fresh_var_fresh)
      ultimately show ?thesis using y by(auto)
    qed
  next
    fix x
    assume x: "x \<in> index Vs ` fv exp2"
    thus "x \<in> index (Vs @ [fresh_var Vs]) ` fv exp2"
    proof(rule imageE)
      fix y
      assume [simp]: "x = index Vs y"
        and y: "y \<in> fv exp2"
      from y fv2 have "y \<in> set Vs" by auto
      moreover hence "y \<noteq> (fresh_var Vs)" by(auto simp add: fresh_var_fresh)
      ultimately have "index Vs y = index (Vs @ [fresh_var Vs]) y" by simp
      thus ?thesis using y by(auto)
    qed
  qed
  with IH1[OF fv1] IH2[OF fv2'] show ?case by(auto)
next
  case (InSynchronized Vs V a exp)
  have IH: "fv exp \<subseteq> set (Vs @ [fresh_var Vs]) \<Longrightarrow> fv (compE1 (Vs @ [fresh_var Vs]) exp) = index (Vs @ [fresh_var Vs]) ` fv exp"
    by fact
  from \<open>fv (insync\<^bsub>V\<^esub> (a) exp) \<subseteq> set Vs\<close> have fv: "fv exp \<subseteq> set Vs" by simp
  hence fv': "fv exp \<subseteq> set (Vs @ [fresh_var Vs])" by auto
  have "index (Vs @ [fresh_var Vs]) ` fv exp = index Vs ` fv exp"
  proof(rule equalityI[OF subsetI subsetI])
    fix x
    assume "x \<in> index (Vs @ [fresh_var Vs]) ` fv exp"
    thus "x \<in> index Vs ` fv exp"
    proof(rule imageE)
      fix y
      assume [simp]: "x = index (Vs @ [fresh_var Vs]) y"
        and y: "y \<in> fv exp"
      from y fv have "y \<in> set Vs" by auto
      moreover hence "y \<noteq> (fresh_var Vs)" by(auto simp add: fresh_var_fresh)
      ultimately have "index (Vs @ [fresh_var Vs]) y = index Vs y" by simp
      thus ?thesis using y by simp
    qed
  next
    fix x
    assume "x \<in> index Vs ` fv exp"
    thus "x \<in> index (Vs @ [fresh_var Vs]) ` fv exp"
    proof(rule imageE)
      fix y
      assume [simp]: "x = index Vs y"
        and y: "y \<in> fv exp"
      from y fv have "y \<in> set Vs" by auto
      moreover hence "y \<noteq> (fresh_var Vs)" by(auto simp add: fresh_var_fresh)
      ultimately have "index Vs y = index (Vs @ [fresh_var Vs]) y" by simp
      thus ?thesis using y by auto
    qed
  qed
  with IH[OF fv'] show ?case by simp
next
  case (TryCatch Vs exp1 C V exp2)
  have IH1: "fv exp1 \<subseteq> set Vs \<Longrightarrow> fv (compE1 Vs exp1) = index Vs ` fv exp1"
    and IH2: "fv exp2 \<subseteq> set (Vs @ [V]) \<Longrightarrow> fv (compE1 (Vs @ [V]) exp2) = index (Vs @ [V]) ` fv exp2"
    by fact+
  from \<open>fv (try exp1 catch(C V) exp2) \<subseteq> set Vs\<close> have fv1: "fv exp1 \<subseteq> set Vs"
    and fv2: "fv exp2 \<subseteq> set (Vs @ [V])" by auto
  have "index (Vs @ [V]) ` fv exp2 - {length Vs} = index Vs ` (fv exp2 - {V})"
  proof(rule equalityI[OF subsetI subsetI])
    fix x
    assume x: "x \<in> index (Vs @ [V]) ` fv exp2 - {length Vs}"
    hence "x \<noteq> length Vs" by simp
    from x have "x \<in> index (Vs @ [V]) ` fv exp2" by auto
    thus "x \<in> index Vs ` (fv exp2 - {V})"
    proof(rule imageE)
      fix y
      assume [simp]: "x = index (Vs @ [V]) y"
        and y: "y \<in> fv exp2"
      have "y \<noteq> V"
      proof
        assume [simp]: "y = V"
        hence "x = length Vs" by simp
        with \<open>x \<noteq> length Vs\<close> show False by contradiction
      qed
      moreover with fv2 y have "y \<in> set Vs" by auto
      ultimately have "index (Vs @ [V]) y = index Vs y" by(simp)
      thus ?thesis using y \<open>y \<noteq> V\<close> by auto
    qed
  next
    fix x
    assume x: "x \<in> index Vs ` (fv exp2 - {V})"
    thus "x \<in> index (Vs @ [V]) ` fv exp2 - {length Vs}"
    proof(rule imageE)
      fix y
      assume [simp]: "x = index Vs y"
        and y: "y \<in> fv exp2 - {V}"
      with fv2 have "y \<in> set Vs" "y \<noteq> V" by auto
      hence "index Vs y = index (Vs @ [V]) y" by simp
      with y have "x \<in> index (Vs @ [V]) ` fv exp2" by auto
      thus ?thesis using \<open>y \<in> set Vs\<close> by simp
    qed
  qed
  with IH1[OF fv1] IH2[OF fv2] show ?case by auto
qed(auto)

lemma fixes e :: "'addr expr" and es :: "'addr expr list"
  shows syncvars_compE1: "fv e \<subseteq> set Vs \<Longrightarrow> syncvars (compE1 Vs e)"
  and syncvarss_compEs1: "fvs es \<subseteq> set Vs \<Longrightarrow> syncvarss (compEs1 Vs es)"
proof(induct Vs e and Vs es rule: compE1_compEs1_induct)
  case (Block Vs V ty vo exp)
  from \<open>fv {V:ty=vo; exp} \<subseteq> set Vs\<close> have "fv exp \<subseteq> set (Vs @ [V])" by auto
  from \<open>fv exp \<subseteq> set (Vs @ [V]) \<Longrightarrow> syncvars (compE1 (Vs @ [V]) exp)\<close>[OF this] show ?case by(simp)
next
  case (Synchronized Vs V exp1 exp2)
  note IH1 = \<open>fv exp1 \<subseteq> set Vs \<Longrightarrow> syncvars (compE1 Vs exp1)\<close>
  note IH2 = \<open>fv exp2 \<subseteq> set (Vs @ [fresh_var Vs]) \<Longrightarrow> syncvars (compE1 (Vs @ [fresh_var Vs]) exp2)\<close>
  from \<open>fv (sync\<^bsub>V\<^esub> (exp1) exp2) \<subseteq> set Vs\<close> have fv1: "fv exp1 \<subseteq> set Vs"
    and fv2: "fv exp2 \<subseteq> set Vs" and fv2': "fv exp2 \<subseteq> set (Vs @ [fresh_var Vs])" by auto
  have "length Vs \<notin> index (Vs @ [fresh_var Vs]) ` fv exp2"
  proof
    assume "length Vs \<in> index (Vs @ [fresh_var Vs]) ` fv exp2"
    thus False
    proof(rule imageE)
      fix x
      assume x: "length Vs = index (Vs @ [fresh_var Vs]) x"
        and x': "x \<in> fv exp2"
      from x' fv2 have "x \<in> set Vs" "x \<noteq> (fresh_var Vs)" by(auto simp add: fresh_var_fresh)
      with x show ?thesis by(simp)
    qed
  qed
  with IH1[OF fv1] IH2[OF fv2'] fv2' show ?case by(simp add: fv_compE1)
next
  case (InSynchronized Vs V a exp)
  note IH = \<open>fv exp \<subseteq> set (Vs @ [fresh_var Vs]) \<Longrightarrow> syncvars (compE1 (Vs @ [fresh_var Vs]) exp)\<close>
  from \<open>fv (insync\<^bsub>V\<^esub> (a) exp) \<subseteq> set Vs\<close> have fv: "fv exp \<subseteq> set Vs"
    and fv': "fv exp \<subseteq> set (Vs @ [fresh_var Vs])" by auto
  have "length Vs \<notin> index (Vs @ [fresh_var Vs]) ` fv exp"
  proof
    assume "length Vs \<in> index (Vs @ [fresh_var Vs]) ` fv exp"
    thus False
    proof(rule imageE)
      fix x
      assume x: "length Vs = index (Vs @ [fresh_var Vs]) x"
        and x': "x \<in> fv exp"
      from x' fv have "x \<in> set Vs" "x \<noteq> (fresh_var Vs)" by(auto simp add: fresh_var_fresh)
      with x show ?thesis by(simp)
    qed
  qed
  with IH[OF fv'] fv' show ?case by(simp add: fv_compE1)
next
  case (TryCatch Vs exp1 C V exp2)
  note IH1 = \<open>fv exp1 \<subseteq> set Vs \<Longrightarrow> syncvars (compE1 Vs exp1)\<close>
  note IH2 = \<open>fv exp2 \<subseteq> set (Vs @ [V]) \<Longrightarrow> syncvars (compE1 (Vs @ [V]) exp2)\<close>
  from \<open>fv (try exp1 catch(C V) exp2) \<subseteq> set Vs\<close> have fv1: "fv exp1 \<subseteq> set Vs"
    and fv2: "fv exp2 \<subseteq> set (Vs @ [V])" by auto
  from IH1[OF fv1] IH2[OF fv2] show ?case by auto
qed auto

lemma (in heap_base) synthesized_call_compP [simp]:
  "synthesized_call (compP f P) h aMvs = synthesized_call P h aMvs"
by(simp add: synthesized_call_def)

primrec fin1 :: "'addr expr \<Rightarrow> 'addr expr1"
where
  "fin1 (Val v) = Val v"
| "fin1 (throw e) = throw (fin1 e)"

lemma comp_final: "final e \<Longrightarrow> compE1 Vs e = fin1 e"
by(erule finalE, simp_all)

lemma fixes e :: "'addr expr" and es :: "'addr expr list"
  shows [simp]: "max_vars (compE1 Vs e) = max_vars e"
  and "max_varss (compEs1 Vs es) = max_varss es"
by (induct Vs e and Vs es rule: compE1_compEs1_induct)(simp_all)

text\<open>Compiling programs:\<close>

definition compP1 :: "'addr J_prog \<Rightarrow> 'addr J1_prog"
where
  "compP1  \<equiv>  compP (\<lambda>C M Ts T (pns,body). compE1 (this#pns) body)"

declare compP1_def[simp]

end


theory SafeRedCase
  imports WTLemma ReduceRestrX ReduceWTS SRUseEnv SafeRedUnpack
begin

  (* ###### case lemmas *)

lemma safe_app_op_case: "\<lbrakk> app_red_exp OpApp (s1, AppExp (OpExp xop) v) ax (s2, e2); FunTy tx tau r a = op_type xop \<rbrakk> \<Longrightarrow> well_typed env r_s1 e2 tau r_s1 empty_use_env"
  apply (case_tac v)
       apply (auto)
  apply (case_tac ax)
   apply (auto)
    (* given xop: op, x1: const, assuming tau matches the return type of xop, we want to show that e2 is well-typed.
        now e2 can either be an op or a const.
    *)
  apply (case_tac "\<not> (\<exists> rop. e2 = OpExp rop)")
   apply (case_tac "\<not> (\<exists> c. e2 = ConstExp c)")
    apply (auto)
        apply (case_tac xop)
             apply (auto)
    (* the hard part is proving that e2 will have the right type. *)
       apply (case_tac xop)
            apply (auto)
         apply (simp add: pure_fun_def)
        apply (simp add: pure_fun_def)
       apply (simp add: pure_fun_def)
      apply (rule_tac id_leq_use_env)
     apply (rule_tac leq_empty_use_env)
    (* op case, same thing *)
    apply (case_tac xop)
         apply (auto)
      apply (simp add: pure_fun_def)
     apply (simp add: pure_fun_def)
    apply (simp add: pure_fun_def)
   apply (rule_tac id_leq_use_env)
  apply (rule_tac leq_empty_use_env)
  done

lemma well_typed_state_add_vars: "\<lbrakk> well_typed_state s1 env rs_map; fresh_var s1 x; well_typed_mem_value env r_s tau v; proper_mem_value rs_map v;
  sub_use_env s1 r_s; sep_nres_map r_s (rem_env rs_map x) \<rbrakk> \<Longrightarrow> well_typed_state (add_env s1 x v) (add_env env x tau) (add_env rs_map x r_s)"
    (* starts by proving the validity of the env + res map *)
  apply (simp add: well_typed_state_def)
  apply (auto)
    apply (rule_tac dist_add_sub_env)
    apply (simp)
   apply (simp add: valid_nres_map_def)
   apply (auto)
    (* the state is still fully covered by the map *)
     apply (simp add: full_nres_map_def)
     apply (auto)
      apply (simp add: add_env_def)
      apply (auto)
     apply (simp add: add_env_def)
     apply (auto)
    (* prove disjointness remains *)
    apply (rule_tac disj_add_nres_map)
     apply (auto)
    (* prove containment remains *)
   apply (rule_tac add_sub_nres_map2)
    apply (rule_tac add_sub_nres_map1)
     apply (simp_all)
   apply (simp add: fresh_var_def)
    (* now it remains to prove that all the values are still well-typed. we do the x = xa case first *)
  apply (erule_tac x="xa" in allE)
  apply (case_tac "x = xa")
   apply (case_tac "add_env s1 x v x")
    apply (simp add: add_env_def)
   apply (auto)
   apply (case_tac "add_env env x tau x")
    apply (simp add: add_env_def)
   apply (auto)
   apply (cut_tac rs_map="rs_map" and x="x" and r_s="r_s" in nres_add_same)
   apply (simp)
   apply (rule_tac well_typed_mv_add_vars)
    apply (simp add: add_env_def)
   apply (simp add: fresh_var_def)
    apply (simp add: sub_env_def)
    (* proper mem value *)
   apply (rule_tac proper_add_mv)
    apply (simp add: add_env_def)
   apply (simp add: nres_lookup_def)
   apply (simp add: valid_nres_map_def)
   apply (simp add: full_nres_map_def)
   apply (simp add: fresh_var_def)
   apply (rule_tac leq_empty_use_env)
    (* now we do that x \<noteq> xa case *)
  apply (simp add: add_env_def)
  apply (case_tac "s1 xa")
   apply (auto)
  apply (simp add: add_env_def)
  apply (case_tac "env xa")
   apply (auto)
  apply (cut_tac rs_map="rs_map" and x="x" and r_s="r_s" and y="xa" in nres_add_diff)
   apply (simp_all)
  apply (rule_tac well_typed_mv_add_vars)
   apply (auto)
  apply (simp add: fresh_var_def)
   apply (simp add: sub_env_def)
    (* properness *)
  apply (rule_tac proper_add_mv)
   apply (simp)
  apply (simp add: fresh_var_def)
  apply (simp add: valid_nres_map_def)
  apply (simp add: full_nres_map_def)
  apply (simp add: nres_lookup_def)
  apply (rule_tac leq_empty_use_env)
  done

    (* this lemma states that given a well-typed state, adding x simultaneously to the state, env, rs_map should yield another well-typed state.  *)(*
lemma well_typed_state_add_vars: "\<lbrakk> well_typed_state s1 env rs_map; fresh_var s1 x; well_typed_mem_value s1 env (intro_use_env empty_use_env cs) tau v;
  scope_use_env rs_map (intro_use_env empty_use_env cs)(*; sep_res_map (intro_use_env empty_use_env cs) rs_map*) \<rbrakk> \<Longrightarrow>
  well_typed_state (add_env s1 x v) (add_env env x tau) (add_mem rs_map x (intro_use_env empty_use_env cs))"
    (* starts by proving the validity of the env + res map *)
  apply (simp add: well_typed_state_def)
  apply (auto)
    apply (rule_tac dist_add_sub_env)
    apply (simp)
   apply (simp add: valid_res_map_def)
   apply (auto)(*
     apply (rule_tac disj_add_res_map)
      apply (auto)*)
    apply (rule_tac add_sub_res_map)
    apply (auto)
   apply (rule_tac add_scope_res_map)
     apply (auto)
   apply (simp add: fresh_var_def)
   apply (simp add: sub_res_map_def)
   apply (simp add: fresh_map_var_def)
    (* now it remains to prove that all the values are still well-typed. we do the x = xa case first *)
  apply (erule_tac x="xa" in allE)
  apply (case_tac "x = xa")
   apply (case_tac "add_env s1 x v x")
    apply (simp add: add_env_def)
   apply (auto)
   apply (case_tac "add_env env x tau x")
    apply (simp add: add_env_def)
   apply (auto)
   apply (simp add: lookup_res_def)
   apply (simp add: add_mem_def)
   apply (rule_tac well_typed_mv_add_vars)
    apply (rule_tac well_typed_mv_add_env)
      apply (simp add: add_env_def)
     apply (auto)
   apply (simp add: fresh_var_def)
   apply (simp add: sub_env_def)
    (* now we do that x \<noteq> xa case *)
  apply (simp add: add_env_def)
  apply (case_tac "s1 xa")
   apply (auto)
  apply (simp add: add_env_def)
  apply (case_tac "env xa")
   apply (auto)
  apply (simp add: lookup_res_def)
  apply (simp add: add_mem_def)
  apply (rule_tac well_typed_mv_add_vars)
   apply (rule_tac well_typed_mv_add_env)
     apply (auto)
  apply (simp add: fresh_var_def)
  apply (simp add: sub_env_def)
  done*)

lemma sacc_make_act_case: "
        \<lbrakk>well_typed_state s1 env rs_map; app_red_exp ConstApp (s1, AppExp (ConstExp c) v) (MakeAct x) (s2, e2); valid_exp_use_env s1 rs_map r_f;
                well_typed env r_s1 v t1 r_s2 rx2; leq_use_env r_s3 (diff_use_env r_s2 (comp_use_env rx1 (lift_use_env rx2 r))); leq_use_env rx r_s3;
                FunTy t1 t2 r a \<in> const_type c; c \<noteq> FixConst; ax = MakeAct x; leq_use_env r_s1 r_f\<rbrakk>
               \<Longrightarrow> well_typed (add_env env x t2) (add_use_env r_s1 x OwnPerm) e2 t2 r_s3 rx"
    (* e2 will always be the generated variable *)
  apply (case_tac "e2 \<noteq> VarExp x SelfRef")
   apply (case_tac c)
                apply (auto)
    (* simple var reqs *)
   apply (simp add: add_env_def)
    apply (case_tac c)
               apply (auto)
   apply (simp add: deref_name_def)
  apply (simp add: add_env_def)
  apply (auto)
    apply (case_tac c)
                apply (auto)
    apply (simp add: pure_fun_def)
   apply (rule_tac ereq_leq_use_envx)
   apply (simp add: add_use_env_def)
    (* prelim: x2 is fresh *)
  apply (case_tac "\<not> fresh_var s1 x")
   apply (case_tac c)
                apply (auto)
    (* prelim: cs is empty, remove elim *)(*
  apply (case_tac "\<not> cs = {}")
   apply (case_tac c)
                apply (auto)*)
    (* prelim: r_s3 \<le> r_s1 *)
  apply (cut_tac r_sc="r_s3" and r_sb="diff_use_env r_s2 (comp_use_env rx1 (lift_use_env rx2 r))" and r_sa="r_s1" in trans_leq_use_env)
    apply (rule_tac diff_leq_use_env)
    apply (rule_tac well_typed_perm_leq)
    apply (auto)
    (* we can achieve the desired permissions by removing x from the end perms + reqs (which is okay since they dont appear anywhere else yet). *)
  apply (rule_tac x="one_use_env x OwnPerm" in exI)
  apply (auto)
    (* - the end perm bound is possible since we assume r_s3 didnt already contain x2 *)
    apply (rule_tac t=" leq_use_env r_s3 (diff_use_env (add_use_env r_s1 x OwnPerm) (comp_use_env (ereq_use_env x t2) (one_use_env x OwnPerm)))" and
        s=" leq_use_env (rem_use_env r_s3 x) (diff_use_env (add_use_env r_s1 x OwnPerm) (comp_use_env (ereq_use_env x t2) (one_use_env x OwnPerm)))" in subst)
     apply (cut_tac r_s="r_s3" and x="x" in ignore_rem_use_env)
      apply (rule_tac r_s="r_s1" in leq_use_none)
       apply (auto)
     apply (simp add: valid_exp_use_env_def)
     apply (simp add: sub_use_env_def)
     apply (auto)
     apply (erule_tac x="x" in allE)
     apply (simp add: fresh_var_def)
     apply (cut_tac r_x="r_s1" and r_s="r_f" and x="x" in leq_use_none)
       apply (auto)
    (* - given this, we can finish proving the bound *)
    apply (rule_tac rhs_unroll_dcl_use_env)
    apply (rule_tac rhs_unroll_rem_use_env)
    apply (rule_tac dist_rem_leq_use_env)
    apply (rule_tac rhs_weak_leq_use_env)
     apply (rule_tac weak_ereq_use_env)
     apply (case_tac c)
                   apply (auto)
     apply (simp add: pure_fun_def)
     apply (simp add: unlim_def)
    apply (rule_tac rhs_add_leq_use_env)
     apply (auto)
    (* - unrolling definitions to prove the subtracter bound *)
   apply (simp add: leq_use_env_def)
   apply (simp add: one_use_env_def)
   apply (simp add: add_use_env_def)
    (* - proving the requirement bound *)
  apply (rule_tac r_sb="diff_use_env (ereq_use_env x t2) (one_use_env x OwnPerm)" in trans_leq_use_env)
   apply (simp add: ereq_use_env_def)
   apply (rule_tac diff_one_leq_use_env)
  apply (rule_tac lhs_unroll_dcl_use_env)
  apply (rule_tac dist_diff_leq_use_env)
  apply (rule_tac self_diff_leq_use_env)
  done

lemma add_env_force_ex: "\<lbrakk> \<forall> z. add_env s x v z = add_env s x w z \<rbrakk> \<Longrightarrow> v = w"
  apply (erule_tac x="x" in allE)
  apply (simp add: add_env_def)
  done

lemma add_env_force: "\<lbrakk> add_env s x v = add_env s x w \<rbrakk> \<Longrightarrow> v = w"
  apply (rule_tac s="s" and x="x" and v="v" and w="w" in add_env_force_ex)
  apply (auto)
  done

lemma disj_add_use_env: "\<lbrakk> disj_use_env r_s r_x; r_s x = NoPerm \<rbrakk> \<Longrightarrow> disj_use_env r_s (add_use_env r_x x r)"
  apply (simp add: disj_use_env_def)
  apply (simp add: add_use_env_def)
  apply (simp add: mini_disj_use_env_def)
  done

lemma strong_disj_add_use_env: "\<lbrakk> strong_disj_use_env r_s r_x; r_s x = NoPerm \<rbrakk> \<Longrightarrow> strong_disj_use_env r_s (add_use_env r_x x r)"
  apply (simp add: strong_disj_use_env_def)
  apply (simp add: add_use_env_def)
  done

lemma add_valid_exp_use_env: "\<lbrakk> valid_nres_map s rs_map; valid_exp_use_env s rs_map r_s; fresh_var s x \<rbrakk> \<Longrightarrow>
  valid_exp_use_env (add_env s x v) (add_env rs_map x empty_use_env) (add_use_env r_s x OwnPerm)"
  apply (simp add: valid_exp_use_env_def)
  apply (auto)
    (* domain preservation *)
   apply (rule_tac rhs_add_sub_use_env)
   apply (rule_tac add_sub_use_env)
    apply (simp)
   apply (simp add: add_env_def)
    (* separation *)
  apply (simp add: sep_nres_map_def)
  apply (auto)
  apply (case_tac "x = xa")
   apply (auto)
   apply (simp add: nres_add_same)
   apply (rule_tac empty_strong_disj_use_env2)
  apply (simp add: nres_add_diff)
  apply (erule_tac x="xa" in allE)
  apply (rule_tac comm_strong_disj_use_env)
  apply (rule_tac strong_disj_add_use_env)
  apply (rule_tac comm_strong_disj_use_env)
   apply (simp)
  apply (simp add: valid_nres_map_def)
  apply (simp add: sub_nres_map_def)
  apply (auto)
  apply (erule_tac x="xa" in allE)
  apply (simp add: sub_use_env_def)
  apply (simp add: fresh_var_def)
  done

lemma add_valid_use_env: "\<lbrakk> valid_res_map s rs_map; valid_use_env s rs_map r_c r_s; fresh_var s x \<rbrakk> \<Longrightarrow>
  valid_use_env (add_env s x v) (add_mem rs_map x empty_use_env) (add_use_env r_c x OwnPerm) (add_use_env r_s x OwnPerm)"
  apply (simp add: valid_use_env_def)
  apply (auto)
    (* subset preservation *)
      apply (rule_tac rhs_add_sub_use_env)
       apply (rule_tac add_sub_use_env)
       apply (simp)
      apply (simp add: add_env_def)
    (* main perm set containment *)
     apply (rule_tac dist_add_leq_use_env)
     apply (simp)
    (* resource perm set containment *)
  apply (simp add: valid_use_entry_def)
  apply (auto)
   apply (case_tac "x = xa")
    apply (cut_tac rs_map="rs_map" and x="x" and r_s="empty_use_env" in lookup_add_mem_same)
    apply (auto)
    apply (rule_tac leq_empty_use_env)
   apply (cut_tac rs_map="rs_map" and x="x" and y="xa" and r_s="empty_use_env" in lookup_add_mem_diff)
    apply (auto)
   apply (erule_tac x="xa" in allE)
   apply (auto)
    apply (simp add: add_use_env_def)
   apply (rule_tac rhs_add_leq_use_env)
    apply (auto)
    (* resource perm set disjointness *)
  apply (case_tac "x = xa")
   apply (cut_tac rs_map="rs_map" and x="x" and r_s="empty_use_env" in lookup_add_mem_same)
   apply (auto)
   apply (rule_tac empty_strong_disj_use_env1)
  apply (cut_tac rs_map="rs_map" and x="x" and y="xa" and r_s="empty_use_env" in lookup_add_mem_diff)
   apply (auto)
  apply (rule_tac strong_disj_add_use_env)
   apply (erule_tac x="xa" in allE)
   apply (simp add: add_use_env_def)
  apply (simp add: valid_res_map_def)
    (* - by scoping, x cannot be in rs_map xa unless it is in rs_map, meaning it is in s, a contradiction *)
  apply (cut_tac rs_map="rs_map" and x="xa" in self_scope_use_env)
   apply (simp)
  apply (case_tac "lookup_mem rs_map x = None")
   apply (simp add: scope_use_env_def)
  apply (simp add: sub_res_map_def)
  apply (auto)
  apply (erule_tac x="x" in allE)
  apply (erule_tac x="x" in allE)
  apply (simp add: fresh_var_def)
    (* - proving the weak part of rs_map is still contained *)(*
  apply (case_tac "x = xa")
   apply (cut_tac rs_map="rs_map" and r_s="empty_use_env" and x="xa" in lookup_add_mem_same)
   apply (auto)
   apply (rule_tac sdrop_leq_use_env)
   apply (rule_tac leq_empty_use_env)
  apply (erule_tac x="xa" in allE)
  apply (auto)
   apply (simp add: add_use_env_def)
  apply (cut_tac rs_map="rs_map" and r_s="empty_use_env" and x="x" and y="xa" in lookup_add_mem_diff)
   apply (auto)
  apply (rule_tac rhs_add_leq_use_env)
   apply (simp_all)*)
  done

    (*
      the hard part that we're dealing with right now is that at the end using pairs does NOT work for the WRITE constants,
        since we want "use" permission for the array, but "own" permission for the value being written.

      what this suggests is that we have to allow for constant + application to be a value.
      even if we do this, we need to give them all their own unique cases, just like for unpacking.
      - this is more complicated than it is with constants, since the contents of the first arg will generally be somewhat complex.

    *)

    (*
lemma sacc_use_case: "\<lbrakk>well_typed_state s1 env rs_map; valid_exp_use_env s1 rs_map r_f; well_typed env r_s1 v t1 r_s2 rx2;
           leq_use_env r_s3 (diff_use_env r_s2 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)); leq_use_env rx r_s3; leq_use_env r_s1 r_f;
           leq_use_env (app_req rx1 rx2 r t2 r_ex) rx; leq_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_s2; leq_use_env r_ex r_s1;
           FunTy t1 t2 r a \<in> const_type c; c \<noteq> FixConst; ax = UseAct x3; is_value v; app_con s1 c v (UseAct x3) (s2, e2)\<rbrakk>
          \<Longrightarrow> \<exists>g_ax. well_typed (red_env env g_ax) (exp_red_use_env r_s1 g_ax) e2 t2 r_s3 rx \<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 r_f g_ax \<and> corr_act (UseAct x3) g_ax"
    (* array ext case *)
  apply (case_tac c)
              apply (auto)
    apply (rule_tac x="WriteResAct x3" in exI)
    (* 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="va" and x="deref_name x3 aa" 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="x3" in allE)
   apply (auto)
  apply (case_tac tau_x)
        apply (auto)
  apply (cut_tac env="env" and r_x="r_x" and e="va" and tau="t" and t="x4" and x="x3" and r_s="one_use_env x3 UsePerm" in well_typed_ack_exp)
          apply (auto)
   apply (simp add: one_use_env_def)
  apply (simp add: mem_val_env_def)
  apply (erule_tac x="x3" in allE)
  apply (auto)
    (* prelim: r_s3 \<le> r_s1 *)
  apply (cut_tac r_sc="r_s2" and r_sb="diff_use_env r_s3a r_exaa" and r_sa="r_s1" 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 r_sb="diff_use_env r_s1 (comp_use_env (ereq_use_env x3 (ArrayTy x4)) r_exa)" in trans_leq_use_env)
      apply (rule_tac self_diff_leq_use_env)
     apply (auto)
  apply (cut_tac r_sc="r_s3" and r_sb="diff_use_env r_s2 (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 x3 \<noteq> NoPerm")
   apply (case_tac "\<not> leq_use_env (one_use_env x3 UsePerm) rx")
    apply (simp add: leq_use_env_def)
    apply (simp add: one_use_env_def)
    apply (auto)
    apply (case_tac "x3 = x")
     apply (auto)
    apply (case_tac "rx x3")
      apply (auto)
   apply (rule_tac ?r_s1.0="r_s3" in well_typed_incr_start_perm)
    apply (rule_tac rx="one_use_env x3 UsePerm" in well_typed_incr_req)
      apply (rule_tac r_s="one_use_env x3 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 x3 UsePerm" and r_sb="ereq_use_env x3 (ArrayTy x4)" and r_sa="r_s1" in trans_leq_use_env)
    apply (simp)
   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 t2 = 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 x3 UsePerm" in wt_sexp_no_req)
        apply (rule_tac r_s="one_use_env x3 UsePerm" in well_typed_incr_simul_perm)
         apply (auto)
    apply (simp add: pure_fun_def)
   apply (rule_tac value_is_sexp)
   apply (rule_tac ?e1.0="va" in ack_full_exp_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 x3 (ArrayTy x4)) r_exa) r_exaa)
          (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex))" and
      rx="diff_use_env (one_use_env x3 UsePerm) (comp_use_env (comp_use_env (comp_use_env (ereq_use_env x3 (ArrayTy x4)) r_exa) r_exaa)
          (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 x3 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 dist_comp_leq_use_env)
        apply (auto)
    apply (rule_tac dist_comp_leq_use_env)
     apply (rule_tac r_sb="r_s2" in trans_leq_use_env)
      apply (auto)
   apply (rule_tac r_sb="diff_use_env r_s2 (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 r_exaa" 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="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_env2)
  apply (simp add: pair_req_def)
  apply (simp add: pure_fun_def)
  apply (rule_tac r_sb="diff_use_env (comp_use_env rx1a rx2a) r_exaa" 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 (auto)
  apply (rule_tac r_sb="diff_use_env (ereq_use_env x3 (ArrayTy x4)) (comp_use_env (ereq_use_env x3 (ArrayTy x4)) r_exa)" 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)
  done*)

lemma saccmk2_var_type: "\<lbrakk> env x = Some (ChanTy t c_end) \<rbrakk> \<Longrightarrow>
  well_typed env (one_use_env x OwnPerm) (VarExp x SelfRef) (ChanTy t c_end) (one_use_env x OwnPerm) (one_use_env x OwnPerm)"
  apply (auto)
    apply (simp add: deref_name_def)
   apply (rule_tac ereq_leq_use_envx)
   apply (simp add: one_use_env_def)
  apply (rule_tac x="empty_use_env" in exI)
  apply (auto)
     apply (rule_tac rhs_weak_leq_use_env)
      apply (rule_tac dist_weak_comp_use_env)
       apply (rule_tac weak_ereq_use_env)
       apply (simp add: unlim_def)
      apply (simp add: weak_use_env_def)
      apply (simp add: empty_use_env_def)
     apply (rule_tac id_leq_use_env)
     apply (rule_tac id_leq_use_env)
   apply (rule_tac leq_empty_use_env)
  apply (rule_tac diff_leq_use_env)
  apply (rule_tac ereq_leq_use_envx)
  apply (simp add: one_use_env_def)
  done

lemma saccmk2_pair_type: "\<lbrakk> well_typed env (one_use_env x1 OwnPerm) v1 t1 (one_use_env x1 OwnPerm) (one_use_env x1 OwnPerm);
  well_typed env (one_use_env x2 OwnPerm) v2 t2 (one_use_env x2 OwnPerm) (one_use_env x2 OwnPerm);
  r_s1 x1 = OwnPerm; r_s1 x2 = OwnPerm; r_s2 x1 = NoPerm; r_s2 x2 = NoPerm;
  leq_use_env r_s2 r_s1; leq_use_env rx r_s2; is_own r; x1 \<noteq> x2 \<rbrakk> \<Longrightarrow>
  well_typed env r_s1 (PairExp v1 v2) (PairTy t1 t2 r) r_s2 rx"
  apply (auto)
  apply (rule_tac x="r_s1" in exI)
  apply (rule_tac x="r_s1" in exI)
  apply (rule_tac x="one_use_env x1 OwnPerm" in exI)
  apply (auto)
   apply (rule_tac r_s="one_use_env x1 OwnPerm" in well_typed_incr_simul_perm)
    apply (simp add: leq_use_env_def)
    apply (simp add: one_use_env_def)
   apply (simp)
  apply (rule_tac x="one_use_env x2 OwnPerm" in exI)
  apply (auto)
       apply (rule_tac r_s="one_use_env x2 OwnPerm" in well_typed_incr_simul_perm)
        apply (simp add: leq_use_env_def)
        apply (simp add: one_use_env_def)
       apply (simp)
      apply (simp add: is_own_def)
      apply (simp add: leq_use_env_def)
      apply (simp add: one_use_env_def)
     apply (simp add: is_own_def)
     apply (simp add: leq_use_env_def)
     apply (simp add: one_use_env_def)
    apply (simp add: is_own_def)
    apply (case_tac "max_aff (req_type t1) (req_type t2)")
      apply (auto)
   apply (simp add: is_own_def)
   apply (simp add: one_use_env_def)
   apply (simp add: disj_use_env_def)
   apply (simp add: mini_disj_use_env_def)
  apply (rule_tac x="add_use_env (one_use_env x1 OwnPerm) x2 OwnPerm" in exI)
  apply (auto)
    apply (rule_tac mini_disj_diff_leq_use_env2)
     apply (simp)
    apply (simp add: mini_disj_use_env_def)
    apply (simp add: one_use_env_def)
    apply (simp add: add_use_env_def)
    apply (auto)
   apply (rule_tac add_leq_use_env)
    apply (simp add: leq_use_env_def)
    apply (simp add: one_use_env_def)
   apply (auto)
  apply (simp add: pair_req_def)
  apply (auto)
   apply (rule_tac leq_empty_use_env)
  apply (simp add: leq_use_env_def)
  apply (simp add: add_use_env_def)
  apply (simp add: diff_use_env_def)
  apply (simp add: comp_use_env_def)
  apply (simp add: minus_use_env_def)
  apply (simp add: neg_use_env_def)
  apply (simp add: one_use_env_def)
  apply (simp add: is_own_def)
  done

lemma sacc_mk2_act_case: "
  \<lbrakk>well_typed_state s1 env rs_map; valid_exp_use_env s1 rs_map r_f; well_typed env r_s1 v t1 r_s2 rx2; proper_exp rs_map (AppExp (ConstExp c) v);
                leq_use_env r_s3 (diff_use_env r_s2 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex));
                leq_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_s2; leq_use_env r_ex r_s1; leq_use_env rx r_s3;
                leq_use_env (app_req rx1 rx2 r t2 r_ex) rx; leq_use_env r_s1 r_f; FunTy t1 t2 r a \<in> const_type c; c \<noteq> FixConst; ax = Mk2Act x31 x32;
                is_value v; app_con s1 c v (Mk2Act x31 x32) (s2, e2)\<rbrakk>
               \<Longrightarrow> \<exists>g_ax. well_typed (red_env env g_ax) (exp_red_use_env r_s1 g_ax) e2 t2 (end_red_use_env r_s3 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_s3) g_ax \<and> corr_act (Mk2Act x31 x32) g_ax"
  apply (case_tac c)
              apply (auto)
  apply (cut_tac eq_own)
  apply (auto)
  apply (rule_tac x="Add2ResAct x31 x32 t" in exI)
  apply (auto)
       apply (cut_tac env="add_env (add_env env x31 (ChanTy t SEnd)) x32 (ChanTy t REnd)" and
        ?r_s1.0="add_use_env (add_use_env r_s1 x31 OwnPerm) x32 OwnPerm" and
        ?r_s2.0="r_s3" and ?v1.0="VarExp x31 SelfRef" and ?v2.0="VarExp x32 SelfRef" and ?t1.0="ChanTy t SEnd" and ?t2.0="ChanTy t REnd"
        and ?x1.0="x31" and ?x2.0="x32" in saccmk2_pair_type)
                 apply (rule_tac saccmk2_var_type)
                 apply (simp add: add_env_def)
                apply (rule_tac saccmk2_var_type)
                apply (simp add: add_env_def)
               apply (auto)
            apply (simp add: add_use_env_def)
           apply (simp add: add_use_env_def)
          apply (rule_tac r_s="r_f" in leq_use_none)
           apply (rule_tac r_sb="r_s1" in trans_leq_use_env)
            apply (simp)
           apply (rule_tac r_sb="diff_use_env r_s2 (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 (simp_all)
          apply (simp add: fresh_var_def)
          apply (simp add: valid_exp_use_env_def)
          apply (simp add: sub_use_env_def)
         apply (rule_tac r_s="r_f" in leq_use_none)
          apply (rule_tac r_sb="r_s1" in trans_leq_use_env)
           apply (simp)
          apply (rule_tac r_sb="diff_use_env r_s2 (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 (simp_all)
         apply (simp add: fresh_var_def)
         apply (simp add: valid_exp_use_env_def)
         apply (simp add: sub_use_env_def)
        apply (rule_tac rhs_add_leq_use_env)
         apply (rule_tac rhs_add_leq_use_env)
          apply (rule_tac r_sb="diff_use_env r_s2 (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 (simp_all)
       apply (rule_tac x="ChanTy t REnd" in exI)
       apply (rule_tac x="ra" in exI)
       apply (auto)
        apply (simp add: pure_fun_def)
        apply (simp add: is_own_def)
       apply (rule_tac x="r_s2a" in exI)
       apply (rule_tac x="r_s3a" in exI)
       apply (rule_tac x="rx1a" in exI)
       apply (auto)
       apply (rule_tac x="rx2a" in exI)
       apply (auto)
       apply (rule_tac x="r_exb" in exI)
       apply (auto)
       apply (simp add: pure_fun_def)
       apply (simp add: is_own_def)
    (* proving the state remains proper *)
      apply (simp add: proper_exp_def)
    (* proving the state remains well-typed: environment containment *)
     apply (simp add: well_typed_state_def)
     apply (auto)
       apply (rule_tac dist_add_sub_env)
       apply (rule_tac dist_add_sub_env)
       apply (simp)
    (* res_map validity: completeness *)
      apply (simp add: valid_nres_map_def)
      apply (auto)
        apply (rule_tac add_full_nres_map)
        apply (rule_tac add_full_nres_map)
        apply (simp)
    (* - disjointness *)
       apply (rule_tac disj_add_nres_map)
        apply (rule_tac disj_add_nres_map)
         apply (simp)
        apply (simp add: sep_nres_map_def)
        apply (simp add: empty_strong_disj_use_env1)
       apply (simp add: sep_nres_map_def)
       apply (simp add: empty_strong_disj_use_env1)
    (* - element containment *)
      apply (rule_tac dist_add_sub_nres_map)
       apply (rule_tac dist_add_sub_nres_map)
        apply (simp)
       apply (rule_tac empty_sub_use_env)
      apply (rule_tac empty_sub_use_env)
    (* proving that the memory is still well-typed. starting with x = x31 / x = x32 *)
     apply (case_tac "x = x31")
      apply (simp add: add_env_def)
     apply (case_tac "x = x32")
      apply (simp add: add_env_def)
    (* - otherwise compare with the originals *)
     apply (simp add: add_env_def)
     apply (erule_tac x="x" in allE)
     apply (case_tac "s1 x")
      apply (auto)
     apply (simp add: add_env_def)
     apply (case_tac "env x")
      apply (auto)
     apply (rule_tac well_typed_mv_add_vars)
      apply (rule_tac well_typed_mv_add_vars)
       apply (simp add: nres_lookup_def)
       apply (simp add: add_env_def)
      apply (simp add: fresh_var_def)
      apply (simp add: sub_env_def)
     apply (simp add: fresh_var_def)
     apply (simp add: sub_env_def)
      apply (simp add: add_env_def)
    (* - properness *)
     apply (rule_tac proper_add_mv)
      apply (rule_tac proper_add_mv)
       apply (simp)
      apply (simp add: fresh_var_def)
      apply (simp add: valid_nres_map_def)
      apply (simp add: full_nres_map_def)
      apply (simp add: nres_lookup_def)
      apply (rule_tac leq_empty_use_env)
     apply (simp add: fresh_var_def)
     apply (simp add: valid_nres_map_def)
     apply (simp add: full_nres_map_def)
     apply (simp add: nres_lookup_def)
     apply (simp add: add_env_def)
     apply (rule_tac leq_empty_use_env)
    (* proving the new res_map is still valid: expression map containment *)
    apply (simp add: valid_exp_use_env_def)
    apply (auto)
     apply (rule_tac rhs_add_sub_use_env)
      apply (rule_tac rhs_add_sub_use_env)
       apply (rule_tac add_sub_use_env)
       apply (rule_tac add_sub_use_env)
       apply (simp)
      apply (simp add: add_env_def)
     apply (simp add: add_env_def)
    (* map separation *)
    apply (rule_tac add_sep_nres_map)
     apply (rule_tac add_sep_nres_map)
      apply (simp add: sep_nres_map_def)
      apply (auto)
      apply (simp add: well_typed_state_def)
      apply (simp add: valid_nres_map_def)
      apply (simp add: sub_nres_map_def)
      apply (rule_tac add_strong_disj_use_env)
       apply (rule_tac add_strong_disj_use_env)
        apply (simp)
       apply (simp add: sub_use_env_def)
       apply (simp add: fresh_var_def)
      apply (simp add: sub_use_env_def)
      apply (simp add: fresh_var_def)
     apply (rule_tac empty_strong_disj_use_env2)
    apply (rule_tac empty_strong_disj_use_env2)
   apply (simp add: fresh_var_def)
  apply (simp add: fresh_var_def)
  done

    (* the idea is that if we added a permission, we required it to be a variable not already in the env, ie a variable free in e2.
      so then we can remove x by default. *)
    (* in general, this statement says that given a constant-application, the result can be typed with a certain env + perm set,
      so that the state remains well-typed relative to the env + global perm_map, and the env + perm set remains valid *)
lemma safe_app_con_case: "\<lbrakk> well_typed_state s1 env rs_map;
    app_red_exp ConstApp (s1, AppExp (ConstExp c) v) ax (s2, e2); valid_exp_use_env s1 rs_map r_f;
    well_typed env r_s1 v t1 r_s2 rx2; proper_exp rs_map (AppExp (ConstExp c) v);
    leq_use_env r_s3 (diff_use_env r_s2 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex));
    leq_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_s2; leq_use_env r_ex r_s1; disj_use_env rx1 (lift_use_env rx2 r);
    leq_use_env rx r_s3; leq_use_env (app_req rx1 rx2 r t2 r_ex) rx; leq_use_env r_s1 r_f;
    FunTy t1 t2 r a \<in> const_type c; c \<noteq> FixConst\<rbrakk>
       \<Longrightarrow> \<exists>g_ax . well_typed (red_env env g_ax) (exp_red_use_env r_s1 g_ax) e2 t2 (end_red_use_env r_s3 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_s3) g_ax \<and> corr_act ax g_ax"
  apply (case_tac ax)
     apply (auto)
    (* no action cases *)
     apply (cut_tac ?r_s2.0="r_s2" and ?r_s1.0="r_s1" and env="env" in well_typed_perm_leq)
      apply (auto)
     apply (case_tac c)
                 apply (auto)
     apply (rule_tac sares_unpack_case)
                apply (auto)
     apply (simp add: upc_init_abbrev_def)
     apply (rule_tac x="r_s1" in exI)
     apply (auto)
      apply (rule_tac id_leq_use_env)
     apply (rule_tac x="rx1" in exI)
     apply (auto)
      apply (rule_tac r_sb="r_s2" in trans_leq_use_env)
       apply (simp)
      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 (rule_tac x="rx2" in exI)
     apply (rule_tac x="r_s2" in exI)
     apply (auto)
     apply (rule_tac x="r_s2a" in exI)
     apply (rule_tac x="r_s3a" in exI)
     apply (rule_tac x="rx1a" in exI)
     apply (auto)
    (* new resource cases. in all cases t2 should be the correct type to add *)
    apply (rule_tac x="AddResAct x2 t2 empty_use_env" in exI)
    apply (auto)
    (* - lemma for main well-typedness statement *)
        apply (rule_tac ?s2.0="s2" and ?rx1.0="rx1" in sacc_make_act_case)
                  apply (auto)
         apply (rule_tac r_sb="diff_use_env r_s2 (comp_use_env (comp_use_env rx1 (lift_use_env rx2 r)) r_ex)" in trans_leq_use_env)
          apply (rule_tac lhs_unroll_dcl_use_env)
          apply (rule_tac self_diff_leq_use_env)
         apply (simp)
    (* - proper expression *)
        apply (case_tac c)
                    apply (auto)
        apply (simp add: proper_exp_def)
    (* - well typed state. *)
       apply (case_tac "\<not> (\<exists> v. s2 = add_env s1 x2 v)")
        apply (case_tac c)
                    apply (auto)
       apply (rule_tac well_typed_state_add_vars)
           apply (auto)
          apply (case_tac c)
                      apply (auto)
    (* - wt mem val: array case *)
         apply (case_tac c)
                     apply (auto)
         apply (cut_tac s="s1" and x="x2" and v="va" and w="ArrValue []" in add_env_force)
          apply (auto)
         apply (simp add: pure_fun_def)
    (* - valid res list *)
         apply (rule_tac x="\<lambda> x. None" in exI)
          apply (simp add: valid_res_list_def)
    (* - properness *)
         apply (case_tac c)
                     apply (auto)
         apply (cut_tac s="s1" and x="x2" and v="va" and w="ArrValue []" in add_env_force)
          apply (simp)
         apply (auto)
    (* - x22 is contained in rs_map (true because x22 is the empty set) *)
        apply (simp add: sub_use_env_def)
        apply (simp add: empty_use_env_def)
    (* - map separation + strength *)
       apply (simp add: sep_nres_map_def)
       apply (auto)
       apply (rule_tac empty_strong_disj_use_env1)
    (* - valid use env. *)
      apply (case_tac "\<not> (\<exists> v. s2 = add_env s1 x2 v)")
       apply (case_tac c)
                   apply (auto)
      apply (rule_tac add_valid_exp_use_env)
        apply (simp add: well_typed_state_def)
       apply (simp)
      apply (case_tac c)
                  apply (auto)
     apply (case_tac c)
                 apply (auto)
     apply (simp add: fresh_var_def)
    apply (rule_tac leq_empty_use_env)
    (* dual new resource case. (basically only channel creation) *)
   apply (rule_tac sacc_mk2_act_case)
                apply (auto)
    (* resource usage case. (currently empty) *)
  apply (case_tac c)
              apply (auto)
(*
   apply (case_tac c)
                apply (auto)
  apply (case_tac c)
               apply (auto)*)
  done

lemma well_typed_empty_state: "well_typed_state empty_env empty_env empty_env"
  apply (simp add: well_typed_state_def)
  apply (auto)
    apply (simp add: sub_env_def)
    apply (simp add: empty_env_def)
   apply (simp add: valid_nres_map_def)(*
   apply (simp add: disj_res_map_def)
   apply (auto)
     apply (simp add: lookup_res_def)
     apply (rule_tac empty_strong_disj_use_env1)*)
   apply (auto)
     apply (simp add: full_nres_map_def)
     apply (simp add: empty_env_def)
    apply (simp add: disj_nres_map_def)
    apply (auto)
    apply (simp add: nres_lookup_def)
    apply (simp add: empty_env_def)
    apply (rule_tac empty_strong_disj_use_env1)
   apply (simp add: sub_nres_map_def)
   apply (simp add: sub_use_env_def)
   apply (simp add: nres_lookup_def)
   apply (simp add: empty_env_def)
   apply (simp add: empty_use_env_def)
  apply (simp add: empty_env_def)
  done
  (*
lemma well_typed_empty_env: "\<lbrakk> well_typed env r_s1 e tau r_s2 rx; well_typed_state s env rs_map; non_prim_env env; leq_use_env r_s1 empty_use_env \<rbrakk> \<Longrightarrow>
  well_typed empty_env r_s1 e tau r_s2 rx"
  apply (cut_tac env="env" and rs_map="empty_env" and v="e" and ?r_s1.0="r_s1" and s="s" in well_typed_restr)
     apply (simp add: well_typed_state_def)
     apply (simp add: valid_nres_map_def)

     apply (simp add: scope_res_map_def)
    apply (simp add: scope_use_env_def)
    apply (simp add: leq_use_env_def)
    apply (simp add: empty_use_env_def)
    apply (auto)
   apply (erule_tac x="x" in allE)
   apply (case_tac "r_s1 x")
     apply (auto)
  apply (rule_tac s="restr_env env NilStack" and t="empty_env" in subst)
   apply (case_tac "\<not> (\<forall> x. restr_env env NilStack x = empty_env x)")
    apply (auto)
  apply (simp add: restr_env_def)
  apply (simp add: empty_env_def)
  done*)

fun state_vars where
  "state_vars s = { x | x. s x \<noteq> None }"

definition fv_restr_env where
  "fv_restr_env e s = (\<lambda> x. if x \<in> free_vars e then s x else None)"

lemma fv_restr_env_use: "\<lbrakk> x \<in> free_vars e \<rbrakk> \<Longrightarrow> fv_restr_env e s x = s x"
  apply (simp add: fv_restr_env_def)
  done

lemma dist_rem_contain_env: "\<lbrakk> contain_env s s' \<rbrakk> \<Longrightarrow> contain_env (rem_env s x) (rem_env s' x)"
  apply (simp add: contain_env_def)
  apply (simp add: rem_env_def)
  apply (auto)
  apply (erule_tac x="xa" in allE)
  apply (case_tac "s' xa")
   apply (auto)
  apply (simp add: rem_env_def)
  done

lemma fv_contain_env: "\<lbrakk> free_vars e' \<subseteq> free_vars e \<rbrakk> \<Longrightarrow> contain_env (fv_restr_env e s) (fv_restr_env e' s)"
  apply (simp add: contain_env_def)
  apply (simp add: fv_restr_env_def)
  apply (auto)
  apply (case_tac "s x")
   apply (auto)
  apply (simp add: fv_restr_env_def)
  apply (auto)
  done

lemma rem_fv_contain_env: "\<lbrakk> free_vars e' - {x} \<subseteq> free_vars e \<rbrakk> \<Longrightarrow> contain_env (fv_restr_env e (rem_env s x)) (fv_restr_env e' (rem_env s x))"
  apply (simp add: contain_env_def)
  apply (simp add: fv_restr_env_def)
  apply (auto)
  apply (simp add: rem_env_def)
  apply (auto)
  apply (case_tac "s xa")
   apply (auto)
  apply (simp add: fv_restr_env_def)
  apply (simp add: rem_env_def)
  apply (auto)
  done

lemma rem_fv_restr_env: "rem_env (fv_restr_env e s) x = fv_restr_env e (rem_env s x)"
  apply (case_tac "\<not> (\<forall> y. rem_env (fv_restr_env e s) x y = fv_restr_env e (rem_env s x) y)")
   apply (auto)
  apply (simp add: rem_env_def)
  apply (simp add: fv_restr_env_def)
  apply (case_tac "x = y")
   apply (auto)
   apply (case_tac "x \<in> free_vars e")
    apply (auto)
  apply (simp add: fv_restr_env_def)
  apply (case_tac "y \<in> free_vars e")
   apply (auto)
  done
(*
lemma fv_restr_contain_env: "\<lbrakk> scope_use_env rs_map r_s; non_prim_env env; well_typed env r_s v tau r_se r_xe \<rbrakk> \<Longrightarrow>
  contain_env (restr_env s rs_map) (fv_restr_env v s)"
  apply (simp add: contain_env_def)
  apply (simp add: fv_restr_env_def)
  apply (auto)
  apply (case_tac "s x")
   apply (auto)
  apply (simp add: scope_use_env_def)
  apply (erule_tac x="x" in allE)
  apply (auto)
   apply (simp add: restr_env_def)
  apply (cut_tac x="x" and e="v" and ?r_s1.0="r_s" in well_typed_no_npv_use)
    apply (auto)
  apply (simp add: non_prim_vars_def)
  apply (simp add: non_prim_env_def)
  apply (erule_tac x="x" in allE)
  apply (cut_tac env="env" and x="x" and e="v" in well_typed_fv_env_use)
    apply (auto)
  apply (simp add: non_prim_entry_def)
  done*)

    (* the question is, how do we allow for replicable pairs while enforcing full resource disjointness?
        i guess the "natural" way to do it based on what we already have is to simply allow pairs that contain
        values that are not unique to also be values.

        - if x is in the end perms, x is in the reqs. if r is own, (lift rx r) subtracts it out.
        - if r is not own, it means that e is replicable, in which case it is again not a var,
        - x is not in the end perms, which is trivial

        an even cleaner solution is to make a "replicable" pair value and type accordingly.
        in this case e is still a var, however at the level of reduction semantics, we can keep
        the var out of the name set.
     *)

    (* this lemma is used to show that variables passed into pair constructors are semi-disjoint.
        we do this by showing that the var is not in the end perms after the reqs are removed.
        - if x is in the end perms, x is in the reqs. if r is own, (lift rx r) subtracts it out.
        - if r is not own, e is non-affine, meaning the "var" is not passed in. (empty name set)
        - if x is not in the end perms, trivial.
     *)

definition is_var where
  "is_var e x = (if e = VarExp x NoRef then False else True)"

fun size_mem :: "'a p_stack \<Rightarrow> nat" where
  "size_mem NilStack = 0"
| "size_mem (ConsStack x v s') = (size_mem s' + 1)"

lemma decr_size_mem: "\<lbrakk> lookup_mem rs_map x = Some (r_s, rs_map') \<rbrakk> \<Longrightarrow> size_mem rs_map' < size_mem rs_map"
  apply (induct rs_map)
   apply (auto)
  apply (case_tac "x1 = x")
   apply (auto)
  done

end