(*
   Title: The pi-calculus
   Author/Maintainer: Jesper Bengtson (jebe.dk), 2012
*)
theory Weak_Early_Sim
  imports Weak_Early_Semantics Strong_Early_Sim_Pres
begin

definition weakSimulation :: "pi \<Rightarrow> (pi \<times> pi) set \<Rightarrow> pi \<Rightarrow> bool" ("_ \<leadsto><_> _" [80, 80, 80] 80)
  where "P \<leadsto><Rel> Q \<equiv> (\<forall>a x Q'. Q \<longmapsto>a<\<nu>x> \<prec> Q' \<and> x \<sharp> P \<longrightarrow> (\<exists>P'. P \<Longrightarrow>a<\<nu>x> \<prec> P' \<and> (P', Q') \<in> Rel)) \<and>
                       (\<forall>\<alpha> Q'. Q \<longmapsto>\<alpha> \<prec> Q' \<longrightarrow> (\<exists>P'. P \<Longrightarrow>\<^sup>^\<alpha> \<prec> P' \<and> (P', Q') \<in> Rel))"

  assumes "P \<leadsto><A> P'"
  and     "A \<subseteq> B"

  shows "P \<leadsto><B> P'"
using assms
by(simp add: weakSimulation_def) blast

lemma simCasesCont[consumes 1, case_names Bound Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi \<times> pi) set"
  and   C   :: "'a::fs_name"

  assumes Eqvt:  "eqvt Rel"
  and     Bound: "\<And>a x Q'. \<lbrakk>Q \<longmapsto> a<\<nu>x> \<prec> Q'; x \<sharp> P; x \<sharp> Q; x \<noteq> a; x \<sharp> C\<rbrakk> \<Longrightarrow> \<exists>P'. P \<Longrightarrow>a<\<nu>x> \<prec> P' \<and> (P', Q') \<in> Rel"
  and     Free:  "\<And>\<alpha> Q'. Q \<longmapsto> \<alpha> \<prec> Q' \<Longrightarrow> \<exists>P'. P \<Longrightarrow>\<^sup>^ \<alpha> \<prec> P' \<and> (P', Q') \<in> Rel"

  shows "P \<leadsto><Rel> Q"
proof(auto simp add: weakSimulation_def)
  fix a x Q'
  assume QTrans: "Q \<longmapsto> a<\<nu>x> \<prec> Q'" and "x \<sharp> P"
  obtain c::name where "c \<sharp> P" and "c \<sharp> Q" and "c \<noteq> a" and "c \<sharp> Q'" and "c \<sharp> C" and "c \<noteq> x"
    by(generate_fresh "name") auto

  from QTrans `c \<sharp> Q'` have "Q \<longmapsto> a<\<nu>c> \<prec> ([(x, c)] \<bullet> Q')" by(simp add: alphaBoundOutput)
  then obtain P' where PTrans: "P \<Longrightarrow>a<\<nu>c> \<prec> P'" and P'RelQ': "(P', [(x, c)] \<bullet> Q') \<in> Rel"
    using `c \<sharp> P` `c \<sharp> Q` `c \<noteq> a` `c \<sharp> C`
    by(drule_tac Bound) auto

  from PTrans `x \<sharp> P` `c \<noteq> x` have "P \<Longrightarrow>a<\<nu>x> \<prec> ([(x, c)] \<bullet> P')"
    by(force intro: weakTransitionAlpha simp add: name_swap)
  moreover from Eqvt P'RelQ' have "([(x, c)] \<bullet> P', [(x, c)] \<bullet> [(x, c)] \<bullet> Q') \<in> Rel"
    by(rule eqvtRelI)
  hence "([(x, c)] \<bullet> P', Q') \<in> Rel" by simp
  ultimately show "\<exists>P'. P \<Longrightarrow>a<\<nu>x> \<prec> P' \<and> (P', Q') \<in> Rel"
    by blast
next
  fix \<alpha> Q'
  assume "Q \<longmapsto>\<alpha> \<prec> Q'"
  thus "\<exists>P'. P \<Longrightarrow>\<^sup>^\<alpha> \<prec> P' \<and> (P', Q') \<in> Rel"
    by(rule Free)
qed

lemma simCases[case_names Bound Free]:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi \<times> pi) set"
  and   C   :: "'a::fs_name"

  assumes "\<And>Q' a x. \<lbrakk>Q \<longmapsto> a<\<nu>x> \<prec> Q'; x \<sharp> P\<rbrakk> \<Longrightarrow> \<exists>P'. P \<Longrightarrow>a<\<nu>x> \<prec> P' \<and> (P', Q') \<in> Rel"
  and     "\<And>Q' \<alpha>. Q \<longmapsto> \<alpha> \<prec> Q' \<Longrightarrow> \<exists>P'. P \<Longrightarrow>\<^sup>^ \<alpha> \<prec> P' \<and> (P', Q') \<in> Rel"

  shows "P \<leadsto><Rel> Q"
using assms
by(auto simp add: weakSimulation_def)

lemma simE:
  fixes P   :: pi
  and   Rel :: "(pi \<times> pi) set"
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   Q'  :: pi

  assumes "P \<leadsto><Rel> Q"

  shows "Q \<longmapsto>a<\<nu>x> \<prec> Q' \<Longrightarrow> x \<sharp> P \<Longrightarrow> \<exists>P'. P \<Longrightarrow>a<\<nu>x> \<prec> P' \<and> (P', Q') \<in> Rel"
  and   "Q \<longmapsto>\<alpha> \<prec> Q' \<Longrightarrow> \<exists>P'. P \<Longrightarrow>\<^sup>^\<alpha> \<prec> P' \<and> (P', Q') \<in> Rel"
using assms by(simp add: weakSimulation_def)+

lemma weakSimTauChain:
  fixes P   :: pi
  and   Rel :: "(pi \<times> pi) set"
  and   Rel' :: "(pi \<times> pi) set"
  and   Q   :: pi
  and   Q'  :: pi

  assumes QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'"
  and     PRelQ: "(P, Q) \<in> Rel"
  and     PSimQ: "\<And>R S. (R, S) \<in> Rel \<Longrightarrow> R \<leadsto><Rel> S"

  shows "\<exists>P'. P \<Longrightarrow>\<^sub>\<tau> P' \<and> (P', Q') \<in> Rel"
proof -
  from QChain show ?thesis
  proof(induct rule: tauChainInduct)
    case id
    moreover have "P \<Longrightarrow>\<^sub>\<tau> P" by simp
    ultimately show ?case using PSimQ PRelQ by blast
  next
    case(ih Q' Q'')
    have "\<exists>P'. P \<Longrightarrow>\<^sub>\<tau> P' \<and> (P', Q') \<in> Rel" by fact
    then obtain P' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'" and P'Rel'Q': "(P', Q') \<in> Rel" by blast
    from P'Rel'Q' have "P' \<leadsto><Rel> Q'" by(rule PSimQ)
    moreover have Q'Trans: "Q' \<longmapsto>\<tau> \<prec> Q''" by fact
    ultimately obtain P'' where P'Trans: "P' \<Longrightarrow>\<^sup>^\<tau> \<prec> P''" and P''RelQ'': "(P'', Q'') \<in> Rel"
      by(blast dest: simE)
    from P'Trans have "P' \<Longrightarrow>\<^sub>\<tau> P''" by simp
    with PChain have "P \<Longrightarrow>\<^sub>\<tau> P''" by auto
    with P''RelQ'' show ?case by blast
  qed
qed

lemma simE2:
  fixes P   :: pi
  and   Rel :: "(pi \<times> pi) set"
  and   Q   :: pi
  and   a   :: name
  and   x   :: name
  and   Q'  :: pi

  assumes Sim: "\<And>R S. (R, S) \<in> Rel \<Longrightarrow> R \<leadsto><Rel> S"
  and     Eqvt: "eqvt Rel"
  and     PRelQ: "(P, Q) \<in> Rel"

  shows "Q \<Longrightarrow>a<\<nu>x> \<prec> Q' \<Longrightarrow> x \<sharp> P \<Longrightarrow> \<exists>P'. P \<Longrightarrow>a<\<nu>x> \<prec> P' \<and> (P', Q') \<in> Rel"
  and   "Q \<Longrightarrow>\<^sup>^\<alpha> \<prec> Q' \<Longrightarrow> \<exists>P'. P \<Longrightarrow>\<^sup>^\<alpha> \<prec> P' \<and> (P', Q') \<in> Rel"
proof -
  assume QTrans: "Q \<Longrightarrow>a<\<nu>x> \<prec> Q'" and "x \<sharp> P"
  from QTrans obtain Q'' Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q'''"
                                and Q'''Trans: "Q''' \<longmapsto>a<\<nu>x> \<prec> Q''"
                                and Q''Chain: "Q'' \<Longrightarrow>\<^sub>\<tau> Q'"
    by(blast dest: transitionE)

  from QChain PRelQ Sim obtain P''' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P'''" and P'''RelQ''': "(P''', Q''') \<in> Rel"
    by(blast dest: weakSimTauChain)

  from PChain `x \<sharp> P` have "x \<sharp> P'''" by(rule freshChain)

  from P'''RelQ''' have "P''' \<leadsto><Rel> Q'''" by(rule Sim)
  with Q'''Trans `x \<sharp> P'''` obtain P'' where P'''Trans: "P''' \<Longrightarrow>a<\<nu>x> \<prec> P''"
                                         and P''RelQ'': "(P'', Q'') \<in> Rel"
    by(blast dest: simE)

  from Q''Chain P''RelQ'' Sim obtain P' where P''Chain: "P'' \<Longrightarrow>\<^sub>\<tau> P'" and P'RelQ': "(P', Q') \<in> Rel"
    by(blast dest: weakSimTauChain)
  from PChain P'''Trans P''Chain  have "P \<Longrightarrow>a<\<nu>x> \<prec> P'"
    by(blast dest: Weak_Early_Step_Semantics.chainTransitionAppend)
  with P'RelQ' show "\<exists>P'. P \<Longrightarrow>a<\<nu>x> \<prec> P' \<and> (P', Q') \<in> Rel" by blast
next
  assume "Q \<Longrightarrow>\<^sup>^\<alpha> \<prec> Q'"
  thus "\<exists>P'. P \<Longrightarrow>\<^sup>^\<alpha> \<prec> P' \<and> (P', Q') \<in> Rel"
  proof(induct rule: transitionCases)
    case Step
    have "Q \<Longrightarrow>\<alpha> \<prec> Q'" by fact
    then obtain Q'' Q''' where QChain: "Q \<Longrightarrow>\<^sub>\<tau> Q''"
                           and Q''Trans: "Q'' \<longmapsto>\<alpha> \<prec> Q'''"
                           and Q'''Chain: "Q''' \<Longrightarrow>\<^sub>\<tau> Q'"
      by(blast dest: transitionE)

    from QChain PRelQ Sim have "\<exists>P''. P \<Longrightarrow>\<^sub>\<tau> P'' \<and> (P'', Q'') \<in> Rel"
      by(rule weakSimTauChain)
    then obtain P'' where PChain: "P \<Longrightarrow>\<^sub>\<tau> P''" and P''RelQ'': "(P'', Q'') \<in> Rel" by blast
    from P''RelQ'' have "P'' \<leadsto><Rel> Q''" by(rule Sim)
    with Q''Trans obtain P''' where P''Trans: "P'' \<Longrightarrow>\<^sup>^\<alpha> \<prec> P'''"
                                and P'''RelQ''': "(P''', Q''') \<in> Rel"
      by(blast dest: simE)

    have "\<exists>P'. P''' \<Longrightarrow>\<^sub>\<tau> P' \<and> (P', Q') \<in> Rel" using Q'''Chain P'''RelQ''' Sim
      by(rule weakSimTauChain)
    then obtain P' where P'''Chain: "P''' \<Longrightarrow>\<^sub>\<tau> P'" and P'RelQ': "(P', Q') \<in> Rel" by blast

    from PChain P''Trans P'''Chain have "P \<Longrightarrow>\<^sup>^\<alpha> \<prec> P'"
      by(blast dest: chainTransitionAppend)
    with P'RelQ' show ?case by blast
  next
    case Stay
    have "P \<Longrightarrow>\<^sup>^\<tau> \<prec> P" by simp
    thus ?case using PRelQ by blast
  qed
qed

lemma eqvtI:
  fixes P    :: pi
  and   Q    :: pi
  and   Rel  :: "(pi \<times> pi) set"
  and   perm :: "name prm"

  assumes PSimQ: "P \<leadsto><Rel> Q"
  and     RelRel': "Rel \<subseteq> Rel'"
  and     EqvtRel': "eqvt Rel'"

  shows "(perm \<bullet> P) \<leadsto><Rel'> (perm \<bullet> Q)"
proof(induct rule: simCases)
  case(Bound Q' a x)
  have xFreshP: "x \<sharp> perm \<bullet> P" by fact
  have QTrans: "(perm \<bullet> Q) \<longmapsto> a<\<nu>x> \<prec> Q'" by fact

  hence "(rev perm \<bullet> (perm \<bullet> Q)) \<longmapsto> rev perm \<bullet> (a<\<nu>x> \<prec> Q')" by(rule eqvts)
  hence "Q \<longmapsto> (rev perm \<bullet> a)<\<nu>(rev perm \<bullet> x)> \<prec> (rev perm \<bullet> Q')"
    by(simp add: name_rev_per)
  moreover from xFreshP have "(rev perm \<bullet> x) \<sharp> P" by(simp add: name_fresh_left)
  ultimately obtain P' where PTrans: "P \<Longrightarrow>(rev perm \<bullet> a)<\<nu>(rev perm \<bullet> x)> \<prec> P'"
                         and P'RelQ': "(P', rev perm \<bullet> Q') \<in> Rel" using PSimQ
    by(blast dest: simE)

  from PTrans have "(perm \<bullet> P) \<Longrightarrow>(perm \<bullet> rev perm \<bullet> a)<\<nu>(perm \<bullet> rev perm \<bullet> x)> \<prec> perm \<bullet> P'"
    by(rule eqvts)
  hence "(perm \<bullet> P) \<Longrightarrow>a<\<nu>x> \<prec> (perm \<bullet> P')" by(simp add: name_per_rev)
  moreover from P'RelQ' RelRel' have "(P', rev perm \<bullet> Q') \<in> Rel'" by blast
  with EqvtRel' have "(perm \<bullet> P', perm \<bullet> (rev perm \<bullet> Q')) \<in> Rel'"
    by(rule eqvtRelI)
  hence "(perm \<bullet> P', Q') \<in> Rel'" by(simp add: name_per_rev)
  ultimately show ?case by blast
next
  case(Free Q' \<alpha>)
  have QTrans: "(perm \<bullet> Q) \<longmapsto> \<alpha> \<prec> Q'" by fact

  hence "(rev perm \<bullet> (perm \<bullet> Q)) \<longmapsto> rev perm \<bullet> (\<alpha> \<prec> Q')" by(rule eqvts)
  hence "Q \<longmapsto> (rev perm \<bullet> \<alpha>) \<prec> (rev perm \<bullet> Q')"  by(simp add: name_rev_per)
  with PSimQ obtain P' where PTrans: "P \<Longrightarrow>\<^sup>^ (rev perm \<bullet> \<alpha>) \<prec> P'"
                         and PRel: "(P', (rev perm \<bullet> Q')) \<in> Rel"
    by(blast dest: simE)

  from PTrans have "(perm \<bullet> P) \<Longrightarrow>\<^sup>^ (perm \<bullet> rev perm \<bullet> \<alpha>) \<prec> perm \<bullet> P'"
    by(rule Weak_Early_Semantics.eqvtI)
  hence L1: "(perm \<bullet> P) \<Longrightarrow>\<^sup>^ \<alpha> \<prec> (perm \<bullet> P')" by(simp add: name_per_rev)
  from PRel EqvtRel' RelRel'  have "((perm \<bullet> P'), (perm \<bullet> (rev perm \<bullet> Q'))) \<in> Rel'"
    by(force intro: eqvtRelI)
  hence "((perm \<bullet> P'), Q') \<in> Rel'" by(simp add: name_per_rev)
  with L1 show ?case by blast
qed

(*****************Reflexivity and transitivity*********************)

lemma reflexive:
  fixes P   :: pi
  and   Rel :: "(pi \<times> pi) set"

  assumes "Id \<subseteq> Rel"

  shows "P \<leadsto><Rel> P"
using assms
by(auto intro: Weak_Early_Step_Semantics.singleActionChain
   simp add: weakSimulation_def weakFreeTransition_def)

  assumes QSimR: "Q \<leadsto><Rel'> R"
  and     Eqvt: "eqvt Rel"
  and     Eqvt'': "eqvt Rel''"
  and     Trans: "Rel O Rel' \<subseteq> Rel''"
  and     Sim: "\<And>S T. (S, T) \<in> Rel \<Longrightarrow> S \<leadsto><Rel> T"
  and     PRelQ: "(P, Q) \<in> Rel"

  shows "P \<leadsto><Rel''> R"
proof -
  from Eqvt'' show ?thesis
  proof(induct rule: simCasesCont[where C=Q])
    case(Bound a x R')
    have RTrans: "R \<longmapsto>a<\<nu>x> \<prec> R'" by fact
    from `x \<sharp> Q` QSimR RTrans obtain Q' where QTrans: "Q \<Longrightarrow>a<\<nu>x> \<prec> Q'"
                                          and Q'Rel'R': "(Q', R') \<in> Rel'"
      by(blast dest: simE)

    from Sim Eqvt PRelQ QTrans `x \<sharp> P`
    obtain P' where PTrans: "P \<Longrightarrow>a<\<nu>x> \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel"
      by(drule_tac simE2) auto
(*      by(blast dest: simE2)*)
    moreover from P'RelQ' Q'Rel'R' Trans have "(P', R') \<in> Rel''" by blast
    ultimately show ?case by blast
  next
    case(Free \<alpha> R')
    have RTrans: "R \<longmapsto> \<alpha> \<prec> R'" by fact
    with QSimR obtain Q' where QTrans: "Q \<Longrightarrow>\<^sup>^ \<alpha> \<prec> Q'" and Q'RelR': "(Q', R') \<in> Rel'"
      by(blast dest: simE)
    from Sim Eqvt PRelQ QTrans have "\<exists>P'. P \<Longrightarrow>\<^sup>^ \<alpha> \<prec> P' \<and> (P', Q') \<in> Rel"
      by(blast intro: simE2)
    then obtain P' where PTrans: "P \<Longrightarrow>\<^sup>^ \<alpha> \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel" by blast
    from P'RelQ' Q'RelR' Trans have "(P', R') \<in> Rel''" by blast
    with PTrans show ?case by blast
  qed
qed

lemma strongAppend:
  fixes P     :: pi
  and   Q     :: pi
  and   R     :: pi
  and   Rel   :: "(pi \<times> pi) set"
  and   Rel'  :: "(pi \<times> pi) set"
  and   Rel'' :: "(pi \<times> pi) set"

  assumes PSimQ: "P \<leadsto><Rel> Q"
  and     QSimR: "Q \<leadsto>[Rel'] R"
  and     Eqvt'': "eqvt Rel''"
  and     Trans: "Rel O Rel' \<subseteq> Rel''"

  shows "P \<leadsto><Rel''> R"
proof -
  from Eqvt'' show ?thesis
  proof(induct rule: simCasesCont[where C=Q])
    case(Bound a x R')
    have RTrans: "R \<longmapsto>a<\<nu>x> \<prec> R'" by fact
    from QSimR RTrans `x \<sharp> Q` obtain Q' where QTrans: "Q \<longmapsto>a<\<nu>x> \<prec> Q'"
                                          and Q'Rel'R': "(Q', R') \<in> Rel'"
      by(blast dest: Strong_Early_Sim.elim)

    with PSimQ QTrans `x \<sharp> P` obtain P' where PTrans: "P \<Longrightarrow>a<\<nu>x> \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel"
      by(blast dest: simE)
    moreover from P'RelQ' Q'Rel'R' Trans have "(P', R') \<in> Rel''" by blast
    ultimately show ?case by blast
  next
    case(Free \<alpha> R')
    have RTrans: "R \<longmapsto> \<alpha> \<prec> R'" by fact
    with QSimR obtain Q' where QTrans: "Q \<longmapsto>\<alpha> \<prec> Q'" and Q'RelR': "(Q', R') \<in> Rel'"
      by(blast dest: Strong_Early_Sim.elim)
    from PSimQ QTrans obtain P' where PTrans: "P \<Longrightarrow>\<^sup>^ \<alpha> \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel"
      by(blast dest: simE)
    from P'RelQ' Q'RelR' Trans have "(P', R') \<in> Rel''" by blast
    with PTrans show ?case by blast
  qed
qed

lemma strongSimWeakSim:
  fixes P   :: pi
  and   Q   :: pi
  and   Rel :: "(pi \<times> pi) set"

  assumes PSimQ: "P \<leadsto>[Rel] Q"

  shows "P \<leadsto><Rel> Q"
proof(induct rule: simCases)
  case(Bound Q' a x)
  have "Q \<longmapsto>a<\<nu>x> \<prec> Q'" by fact
  with PSimQ `x \<sharp> P` obtain P' where PTrans: "P \<longmapsto>a<\<nu>x> \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel"
    by(blast dest: Strong_Early_Sim.elim)
  from PTrans have "P \<Longrightarrow>a<\<nu>x> \<prec>  P'"
    by(force intro: Weak_Early_Step_Semantics.singleActionChain simp add: weakFreeTransition_def)
  with P'RelQ' show ?case by blast
next
  case(Free Q' \<alpha>)
  have "Q \<longmapsto>\<alpha> \<prec> Q'" by fact
  with PSimQ obtain P' where PTrans: "P \<longmapsto>\<alpha> \<prec> P'" and P'RelQ': "(P', Q') \<in> Rel"
    by(blast dest: Strong_Early_Sim.elim)
  from PTrans have "P \<Longrightarrow>\<^sup>^\<alpha> \<prec> P'" by(rule Weak_Early_Semantics.singleActionChain)
  with P'RelQ' show ?case by blast
qed

end


theory InferSound
  imports InferDef
begin

    (* ##### inference correctness lemma 1 *)

lemma ivl_const_main: "\<lbrakk> dir_sol_sat t_sub p_sub c_list; const_scheme x ds tau c_list ds'\<rbrakk> \<Longrightarrow> full_subst_type t_sub p_sub tau_n tau \<in> const_type x"
  apply (case_tac x)
              apply (auto)
              apply (simp_all add: full_subst_type_def)
              apply (simp_all add: pure_fun_s_def)
              apply (simp_all add: pure_fun_def)
              apply (simp_all add: unlim_def)
        apply (simp_all add: is_own_def)
      apply (auto)
  done

lemma ivl_op_main: "full_subst_type t_sub p_sub tau_n (op_scheme x) = op_type x"
  apply (case_tac x)
       apply (auto)
       apply (simp_all add: full_subst_type_def)
       apply (simp_all add: pure_fun_s_def)
       apply (simp_all add: pure_fun_def)
  done

lemma ivl_pair_ih: "\<lbrakk> \<And>env tau r_s r_x r_m c_list ds ds'.
           \<lbrakk>infer_type env ds e tau r_s r_x r_m c_list ds'; dir_sol_sat t_sub p_sub c_list\<rbrakk>
           \<Longrightarrow> well_typed (dir_subst_tenv (fill_tsub t_sub tau_n) env) (dir_subst_penv t_sub p_sub r_s) e (full_subst_type t_sub p_sub tau_n tau)
                (diff_use_env (dir_subst_penv t_sub p_sub r_s) (dir_subst_penv t_sub p_sub r_m))
                (diff_use_env (dir_subst_penv t_sub p_sub r_x) (dir_subst_penv t_sub p_sub r_m));
  infer_type env ds e tau r_s r_x r_m c_list ds'; dir_sol_sat t_sub p_sub c_list\<rbrakk> \<Longrightarrow>
  well_typed (dir_subst_tenv (fill_tsub t_sub tau_n) env) (dir_subst_penv t_sub p_sub r_s) e (full_subst_type t_sub p_sub tau_n tau)
                (diff_use_env (dir_subst_penv t_sub p_sub r_s) (dir_subst_penv t_sub p_sub r_m))
                (diff_use_env (dir_subst_penv t_sub p_sub r_x) (dir_subst_penv t_sub p_sub r_m))"
  apply (auto)
  done

lemma ivl_if_ih: "\<lbrakk> \<And>env tau r_s r_x r_m c_list ds ds'.
           \<lbrakk>infer_type env ds e tau r_s r_x r_m c_list ds'; dir_sol_sat t_sub p_sub c_list\<rbrakk>
           \<Longrightarrow> well_typed (dir_subst_tenv (fill_tsub t_sub tau_n) env) (dir_subst_penv t_sub p_sub r_s) e (full_subst_type t_sub p_sub tau_n tau)
                (diff_use_env (dir_subst_penv t_sub p_sub r_s) (dir_subst_penv t_sub p_sub r_m))
                (diff_use_env (dir_subst_penv t_sub p_sub r_x) (dir_subst_penv t_sub p_sub r_m));
  infer_type env ds e tau r_s r_x r_m c_list ds'; dir_sol_sat t_sub p_sub c_list \<rbrakk> \<Longrightarrow>
  well_typed (dir_subst_tenv (fill_tsub t_sub tau_n) env) (dir_subst_penv t_sub p_sub r_s) e (full_subst_type t_sub p_sub tau_n tau)
                (diff_use_env (dir_subst_penv t_sub p_sub r_s) (dir_subst_penv t_sub p_sub r_m))
                (diff_use_env (dir_subst_penv t_sub p_sub r_x) (dir_subst_penv t_sub p_sub r_m))"
  apply (auto)
  done

lemma ivl_lam_ih: "\<lbrakk> \<And>env tau r_s r_x r_m c_list ds ds'.
           \<lbrakk>infer_type env ds e tau r_s r_x r_m c_list ds'; dir_sol_sat t_sub p_sub c_list\<rbrakk>
           \<Longrightarrow> well_typed (dir_subst_tenv (fill_tsub t_sub tau_n) env) (dir_subst_penv t_sub p_sub r_s) e (full_subst_type t_sub p_sub tau_n tau)
                (diff_use_env (dir_subst_penv t_sub p_sub r_s) (dir_subst_penv t_sub p_sub r_m))
                (diff_use_env (dir_subst_penv t_sub p_sub r_x) (dir_subst_penv t_sub p_sub r_m));
   infer_type env ds e tau r_s r_x r_m c_list ds'; dir_sol_sat t_sub p_sub c_list \<rbrakk> \<Longrightarrow>
  well_typed (dir_subst_tenv (fill_tsub t_sub tau_n) env) (dir_subst_penv t_sub p_sub r_s) e (full_subst_type t_sub p_sub tau_n tau)
                (diff_use_env (dir_subst_penv t_sub p_sub r_s) (dir_subst_penv t_sub p_sub r_m))
                (diff_use_env (dir_subst_penv t_sub p_sub r_x) (dir_subst_penv t_sub p_sub r_m))"
  apply (auto)
  done

lemma ivl_app_ih: "\<lbrakk> \<And>env tau r_s r_x r_m c_list ds ds'.
           \<lbrakk>infer_type env ds e tau r_s r_x r_m c_list ds'; dir_sol_sat t_sub p_sub c_list\<rbrakk>
           \<Longrightarrow> well_typed (dir_subst_tenv (fill_tsub t_sub tau_n) env) (dir_subst_penv t_sub p_sub r_s) e (full_subst_type t_sub p_sub tau_n tau)
                (diff_use_env (dir_subst_penv t_sub p_sub r_s) (dir_subst_penv t_sub p_sub r_m))
                (diff_use_env (dir_subst_penv t_sub p_sub r_x) (dir_subst_penv t_sub p_sub r_m));
   infer_type env ds e tau r_s r_x r_m c_list ds'; dir_sol_sat t_sub p_sub c_list\<rbrakk> \<Longrightarrow>
  well_typed (dir_subst_tenv (fill_tsub t_sub tau_n) env) (dir_subst_penv t_sub p_sub r_s) e (full_subst_type t_sub p_sub tau_n tau)
                (diff_use_env (dir_subst_penv t_sub p_sub r_s) (dir_subst_penv t_sub p_sub r_m))
                (diff_use_env (dir_subst_penv t_sub p_sub r_x) (dir_subst_penv t_sub p_sub r_m))"
  apply (auto)
  done

lemma ivl_var_leq_perm: "\<lbrakk> req_type tau_n = Prim \<rbrakk> \<Longrightarrow>
  leq_perm (end_req_perm (full_subst_type t_sub p_sub tau_n (VarScheme b)))
      (dir_subst_penv t_sub p_sub (one_var_env (owner_name x) (XType b)) (owner_name x))"
  apply (simp add: full_subst_type_def)
  apply (simp add: end_req_perm_def)
  apply (simp add: dir_subst_penv_def)
  apply (simp add: one_var_env_def)
  apply (case_tac "t_sub b")
   apply (auto)
  apply (case_tac "req_type a")
    apply (auto)
  done

lemma dir_aff_leq: "\<lbrakk> dir_subst_type t_sub p_sub tau_v tau; aff_leq (req_type tau) r \<rbrakk> \<Longrightarrow>
  aff_leq (req_type (full_subst_type_f t_sub p_sub tau_n tau_v)) r"
  apply (induct tau_v)
         apply (auto)
  done

lemma dir_subst_type_eq: "\<lbrakk> dir_subst_type t_sub p_sub tau_v tau \<rbrakk> \<Longrightarrow> full_subst_type t_sub p_sub tau_n tau_v = tau"
  apply (induct tau_v arbitrary: tau)
         apply (auto)
         apply (simp_all add: full_subst_type_def)
  done

lemma mini_disj_lift_use_env_rev: "\<lbrakk> mini_disj_use_env r_x r_s \<rbrakk> \<Longrightarrow> mini_disj_use_env r_x (lift_use_env r_s r)"
  apply (case_tac r)
    apply (auto)
  apply (simp add: mini_disj_use_env_def)
  done

lemma infer_valid_left: "\<lbrakk> infer_type env ds e tau r_s r_x r_m c_list ds'; dir_sol_sat t_sub p_sub c_list; req_type tau_n = Prim \<rbrakk> \<Longrightarrow>
  well_typed (dir_subst_tenv (fill_tsub t_sub tau_n) env) (dir_subst_penv t_sub p_sub r_s) e (full_subst_type t_sub p_sub tau_n tau)
    (diff_use_env (dir_subst_penv t_sub p_sub r_s) (dir_subst_penv t_sub p_sub r_m)) (diff_use_env (dir_subst_penv t_sub p_sub r_x) (dir_subst_penv t_sub p_sub r_m))"
  apply (induct e arbitrary: env tau r_s r_x r_m c_list ds ds')
        apply (auto)
    (* const case *)
             apply (rule_tac ivl_const_main)
              apply (simp_all)
            apply (rule_tac self_diff_leq_use_env)
           apply (rule_tac id_leq_use_env)
    (* op case *)
          apply (rule_tac ivl_op_main)
         apply (rule_tac self_diff_leq_use_env)
        apply (rule_tac id_leq_use_env)
    (* var case *)
       apply (simp add: dir_subst_tenv_def)
       apply (simp add: fill_tsub_def)
       apply (case_tac "t_sub a")
        apply (auto)
        apply (simp add: full_subst_type_def)
       apply (simp add: full_subst_type_def)
      apply (simp add: fill_tsub_def)
      apply (cut_tac x="owner_name x" and tau="full_subst_type t_sub p_sub tau_n (VarScheme b)" and
        r_s="dir_subst_penv t_sub p_sub (one_var_env (owner_name x) (XType b))" in ereq_leq_use_envx)
       apply (rule_tac ivl_var_leq_perm)
       apply (auto)
      apply (rule_tac x="dir_subst_penv t_sub p_sub (one_var_env (owner_name x) (XType b))" in exI)
      apply (rule_tac x="full_subst_type t_sub p_sub tau_n (VarScheme b)" in exI)
      apply (simp add: full_subst_type_def)
      apply (simp add: dir_subst_tenv_def)
      apply (auto)
           apply (case_tac "t_sub b")
            apply (auto)
          apply (case_tac x)
           apply (auto)
         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 (simp_all)
       apply (rule_tac id_leq_use_env)
        apply (rule_tac id_leq_use_env)
       apply (rule_tac id_leq_use_env)
      apply (rule_tac dist_diff_leq_use_env_gen)
       apply (simp)
      apply (rule_tac self_comp_leq_use_env2)
    (* pair case. exepected type *)
    (* - prelim: solution satisfaction *)(*
     apply (cut_tac ?cl2.0="semi_disj_crn r_m2 (lift_var_env r_x1 (SVar p)) d @ semi_disj_crn r_m1 (comp_var_env r_s2 (lift_var_env r_x2 (SVar p))) d @ cl1 @ cl2" in sol_sat_append2)
      apply (auto)
     apply (cut_tac ?cl2.0="semi_disj_crn r_m1 (comp_var_env r_s2 (lift_var_env r_x2 (SVar p))) d @ cl1 @ cl2" in sol_sat_append2)
      apply (auto)*)
     apply (simp add: full_subst_type_def)
     apply (cut_tac ?cl2.0="semi_disj_crn r_m2 r_x1 d @ semi_disj_crn r_m1 r_s2 d @ cl1 @ cl2" in sol_sat_append2)
      apply (auto)
     apply (cut_tac ?cl2.0="semi_disj_crn r_m1 r_s2 d @ cl1 @ cl2" in sol_sat_append2)
      apply (auto)
     apply (cut_tac ?cl2.0="cl1 @ cl2" in sol_sat_append2)
      apply (auto)
    (* - prelim: initial disjointness statements *)
     apply (cut_tac r_x="r_m2" and r_s="r_x1" in sol_sat_mini_disj_use_env)
        apply (rule_tac sol_sat_append1)
        apply (auto)
       apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 (lift_var_env r_x1 (SVar p))) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
        apply (simp)
       apply (rule_tac comp_sub_dom2)
       apply (rule_tac comp_sub_dom1)
       apply (rule_tac infer_m_sub_dom)
       apply (simp)
      apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 (lift_var_env r_x1 (SVar p))) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
       apply (simp)
      apply (rule_tac comp_sub_dom1)
      apply (rule_tac comp_sub_dom2)
      apply (rule_tac lift_sub_dom2)
      apply (rule_tac id_sub_dom)
     apply (cut_tac r_x="r_m1" and r_s="r_s2" in sol_sat_mini_disj_use_env)
        apply (rule_tac sol_sat_append1)
        apply (auto)
       apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 (lift_var_env r_x1 (SVar p))) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
        apply (simp)
       apply (rule_tac comp_sub_dom1)
       apply (rule_tac comp_sub_dom1)
       apply (rule_tac infer_m_sub_dom)
       apply (simp)
      apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 (lift_var_env r_x1 (SVar p))) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
       apply (simp)
      apply (rule_tac comp_sub_dom2)
      apply (rule_tac comp_sub_dom1)
      apply (rule_tac id_sub_dom)
     apply (cut_tac r_x="lift_var_env r_x1 (SVar p)" and r_s="lift_var_env r_x2 (SVar p)" in sol_sat_disj_use_env)
        apply (rule_tac sol_sat_append1)
        apply (auto)
       apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 (lift_var_env r_x1 (SVar p))) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
        apply (simp)
       apply (rule_tac comp_sub_dom1)
       apply (rule_tac comp_sub_dom2)
       apply (rule_tac id_sub_dom)
      apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 (lift_var_env r_x1 (SVar p))) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
       apply (simp)
      apply (rule_tac comp_sub_dom2)
      apply (rule_tac comp_sub_dom2)
      apply (rule_tac id_sub_dom)
(*
     apply (cut_tac r_x="comp_var_env r_s1 (lift_var_env r_x1 (SVar p))" and r_s="comp_var_env r_s2 (lift_var_env r_x2 (SVar p))" and d="d" in sol_sat_disj_use_env)
        apply (rule_tac ?cl2.0="cl1 @ cl2" in sol_sat_append1)
        apply (simp)
       apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 (lift_var_env r_x1 (SVar p))) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
        apply (simp)
       apply (rule_tac comp_sub_dom1)
       apply (rule_tac id_sub_dom)
      apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 (lift_var_env r_x1 (SVar p))) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
       apply (simp)
      apply (rule_tac comp_sub_dom2)
      apply (rule_tac id_sub_dom)*)
    (* - expected permission environments *)
     apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub (comp_var_env (comp_var_env r_s1 (lift_var_env r_x1 (SVar p)))
        (comp_var_env r_s2 (lift_var_env r_x2 (SVar p))))) (dir_subst_penv t_sub p_sub r_m1)" in exI)
     apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub (comp_var_env (comp_var_env r_s1 (lift_var_env r_x1 (SVar p)))
        (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))))
        (dir_subst_penv t_sub p_sub (comp_var_env r_m1 r_m2))" in exI)
     apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub r_x1) (dir_subst_penv t_sub p_sub r_m1)" in exI)
     apply (auto)
    (* - induction for e1 *)
      apply (cut_tac env="env" and ds="ds" and e="e1" and tau="t1" and r_s="r_s1" and r_x="r_x1" and r_m="r_m1" and
        c_list="cl1" and ds'="ds2" and t_sub="t_sub" and p_sub="p_sub" and tau_n="tau_n" in ivl_pair_ih)
         apply (auto)
        apply (simp add: full_subst_type_def)
       apply (rule_tac sol_sat_append1)
       apply (simp)
    (* > remove [S2 + lift(X2, p)] using the precision lemma *)
      apply (simp add: comp_sol_subst_penv)
      apply (rule_tac well_typed_comp_perms_prec)
(*
    (* > get into form [(S1 + lift(X1, p)) - M1] + [(S2 + lift(X2, p)) - M1] *)
      apply (simp add: comp_sol_subst_penv)
      apply (rule_tac t="diff_use_env
              (comp_use_env (comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p))))
                (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p)))))
              (dir_subst_penv t_sub p_sub r_m1)" and
        s="comp_use_env (diff_use_env (comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p))))
              (dir_subst_penv t_sub p_sub r_m1))
                (diff_use_env (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))))
              (dir_subst_penv t_sub p_sub r_m1))" in subst)
       apply (rule_tac dist_diff_comp_use_env)
    (* > increase [(S2 + lift(X2, p)) - M1] to (S2 + lift(X2, p)) *)
      apply (rule_tac r_c="comp_use_env
              (diff_use_env (comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p))))
                (dir_subst_penv t_sub p_sub r_m1))
              (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))))" in well_typed_decr_end_perm)
    (* > remove (S2 + lift(X2, p)) from the start + end perms *)
        apply (rule_tac well_typed_comp_perms)*)
    (* > transform [(S1 + lift(X1, p)) - M1] into (S1 - M1) + lift(X1 - M1, p) *)
       apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p))" and
              s="lift_use_env (dir_subst_penv t_sub p_sub r_x1) (sol_subst_perm p_sub (SVar p))" in subst)
        apply (rule_tac lift_sol_subst_penv)
       apply (simp_all)
      apply (rule_tac t="diff_use_env (comp_use_env (dir_subst_penv t_sub p_sub r_s1) (lift_use_env (dir_subst_penv t_sub p_sub r_x1) (p_sub p))) (dir_subst_penv t_sub p_sub r_m1)"
          and s="comp_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub r_m1))
            (diff_use_env (lift_use_env (dir_subst_penv t_sub p_sub r_x1) (p_sub p)) (dir_subst_penv t_sub p_sub r_m1))" in subst)
       apply (rule_tac dist_diff_comp_use_env)
      apply (simp add: lift_diff_use_env)
    (* > remove lifts and cancel X1 *)
      apply (rule_tac well_typed_comp_lift_perms)
       apply (cut_tac r_s="dir_subst_penv t_sub p_sub r_s1" and r_x="dir_subst_penv t_sub p_sub r_x1" in cancel_comp_use_env2)
        apply (rule_tac env="env" and e="e1" and c_list="cl1" in infer_x_leq_use_env)
        apply (auto)
       apply (cut_tac r_s="diff_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub r_m1)" and
          r_x="diff_use_env (dir_subst_penv t_sub p_sub r_x1) (dir_subst_penv t_sub p_sub r_m1)" in cancel_comp_use_env2)
        apply (rule_tac dist_diff_leq_use_env)
        apply (rule_tac env="env" and e="e1" and c_list="cl1" in infer_x_leq_use_env)
        apply (auto)
    (* - proof of bound changes *)
       apply (simp add: full_subst_type_def)
      apply (rule_tac self_diff_leq_use_env)
(*
       apply (rule_tac dist_comp_leq_use_env)
        apply (rule_tac self_comp_leq_use_env1)
       apply (rule_tac comp_leq_use_env2)
       apply (rule_tac self_diff_leq_use_env)
      apply (rule_tac comp_leq_use_env1)
      apply (rule_tac dist_diff_leq_use_env)
      apply (rule_tac comp_leq_use_env2)
      apply (rule_tac lift_leq_var_env)
      apply (rule_tac id_leq_use_env)*)
    (* - induction for e2. *)
     apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub r_x2) (dir_subst_penv t_sub p_sub r_m2)" in exI)
     apply (cut_tac env="env" and ds="ds2" and e="e2" and tau="t2" and r_s="r_s2" and r_x="r_x2" and r_m="r_m2" and
        c_list="cl2" and ds'="ds3" and t_sub="t_sub" and p_sub="p_sub" and tau_n="tau_n" in ivl_pair_ih)
        apply (auto)
            apply (simp add: full_subst_type_def)
           apply (rule_tac sol_sat_append2)
           apply (simp)
          apply (simp add: comp_sol_subst_penv)
    (* > reduce end perms *)
          apply (rule_tac ?r_s2.0="diff_use_env (diff_use_env (comp_use_env
              (comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p))))
              (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))))) (dir_subst_penv t_sub p_sub r_m2))
              (dir_subst_penv t_sub p_sub r_m1)" and rx="diff_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_x2)
              (dir_subst_penv t_sub p_sub r_m2)) (dir_subst_penv t_sub p_sub r_m1)" in well_typed_simul_end_perm)
    (*
           apply (rule_tac ?r_s2.0="diff_use_env (comp_use_env (comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p))))
              (diff_use_env (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p)))) (dir_subst_penv t_sub p_sub r_m2)))
              (dir_subst_penv t_sub p_sub r_m1)" and rx="diff_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_x2)
              (dir_subst_penv t_sub p_sub r_m2)) (dir_subst_penv t_sub p_sub r_m1)" in well_typed_simul_end_perm)*)
             apply (rule_tac well_typed_diff_perms)
              apply (rule_tac well_typed_comp_perms_prec2)
    (* - unroll lifts *)
               apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))" and
                s="lift_use_env (dir_subst_penv t_sub p_sub r_x2) (sol_subst_perm p_sub (SVar p))" in subst)
                apply (rule_tac lift_sol_subst_penv)
               apply (rule_tac t="diff_use_env (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (lift_use_env (dir_subst_penv t_sub p_sub r_x2) (sol_subst_perm p_sub (SVar p))))
                (dir_subst_penv t_sub p_sub r_m2)" and s="comp_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub r_m2))
                (diff_use_env (lift_use_env (dir_subst_penv t_sub p_sub r_x2) (sol_subst_perm p_sub (SVar p))) (dir_subst_penv t_sub p_sub r_m2))" in subst)
                apply (rule_tac dist_diff_comp_use_env)
               apply (simp add: lift_diff_use_env)
               apply (rule_tac well_typed_comp_lift_perms)
    (* - cancellations *)
                apply (cut_tac r_s="dir_subst_penv t_sub p_sub r_s2" and r_x="dir_subst_penv t_sub p_sub r_x2" in cancel_comp_use_env2)
                 apply (rule_tac env="env" and e="e2" and c_list="cl2" in infer_x_leq_use_env)
                 apply (auto)
                apply (cut_tac r_s="diff_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub r_m2)" and
                    r_x="diff_use_env (dir_subst_penv t_sub p_sub r_x2) (dir_subst_penv t_sub p_sub r_m2)" in cancel_comp_use_env2)
                 apply (rule_tac dist_diff_leq_use_env)
                 apply (rule_tac env="env" and e="e2" and c_list="cl2" in infer_x_leq_use_env)
                apply (auto)
               apply (simp add: full_subst_type_def)
               apply (rule_tac self_diff_leq_use_env)
    (* - disjointness used to remove r_s1 *)(*
              apply (rule_tac comm_disj_use_env)
              apply (simp)*)
    (* - proving that r_m1 can be subtracted out *)
             apply (simp add: own_env_vars_def)
             apply (case_tac "dir_subst_penv t_sub p_sub r_s2 x = NoPerm")
              apply (cut_tac e="e2" and ?r_s1.0="dir_subst_penv t_sub p_sub r_s2" and x="x" in well_typed_no_npv_use)
                apply (auto)(*
             apply (case_tac "dir_subst_penv t_sub p_sub r_s1 x \<noteq> OwnPerm")
              apply (cut_tac r_x="dir_subst_penv t_sub p_sub r_m1" and r_s="dir_subst_penv t_sub p_sub r_s1" and x="x" in leq_use_no_own)
                apply (simp)
               apply (rule_tac c_list="cl1" in infer_m_leq_use_env)
               apply (auto)
             apply (cut_tac r_x="dir_subst_penv t_sub p_sub r_s1" and r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p)))"
                and r_ex="dir_subst_penv t_sub p_sub r_s2" in disj_leq_use_env1)
               apply (rule_tac r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p)))" in disj_leq_use_env2)
                apply (simp)
               apply (rule_tac self_comp_leq_use_env1)
              apply (rule_tac self_comp_leq_use_env1)
             apply (simp add: disj_use_env_def)*)
             apply (simp add: mini_disj_use_env_def)
    (* - end perm bounds correctness *)
            apply (rule_tac lhs_flip_use_env)
            apply (rule_tac lhs_unroll_dcl_use_env)
            apply (rule_tac id_leq_use_env)
    (*
            apply (rule_tac dist_diff_leq_use_env)
            apply (rule_tac dist_diff_leq_use_env)
            apply (rule_tac lhs_dist_dcl_use_env)
            apply (rule_tac dist_comp_leq_use_env)
    apply (rule_tac self_diff_leq_use_env)
             apply (rule_tac comp_leq_use_env1)
             apply (rule_tac self_diff_leq_use_env)
            apply (rule_tac self_comp_leq_use_env2)*)
           apply (rule_tac rhs_unroll_dcl_use_env)
           apply (rule_tac dist_diff_leq_use_env)
           apply (rule_tac mini_disj_diff_leq_use_env2)
            apply (rule_tac comp_leq_use_env2)
            apply (rule_tac comp_leq_use_env2)
            apply (rule_tac lift_leq_var_env)
            apply (rule_tac id_leq_use_env)
           apply (rule_tac r_s="dir_subst_penv t_sub p_sub r_s2" in mini_disj_leq_use_env2)
            apply (simp)
           apply (rule_tac infer_x_leq_use_env)
           apply (simp)(*
            apply (rule_tac r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p)))" in disj_leq_use_env1)
             apply (rule_tac r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p)))" in disj_leq_use_env2)
              apply (simp)
             apply (rule_tac comp_leq_use_env2)
             apply (rule_tac lift_leq_var_env)
             apply (rule_tac id_leq_use_env)
            apply (rule_tac comp_leq_use_env1)
            apply (rule_tac e="e1" and c_list="cl1" in infer_m_leq_use_env)
            apply (simp)
           apply (rule_tac comp_leq_use_env2)
           apply (rule_tac comp_leq_use_env2)
           apply (rule_tac lift_leq_var_env)
           apply (rule_tac id_leq_use_env)*)
          apply (rule_tac self_diff_leq_use_env)
      (* - native permission bound constraint e1 *)
         apply (rule_tac t="lift_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_x1) (dir_subst_penv t_sub p_sub r_m1)) (p_sub p)" and
          s="diff_use_env (lift_use_env (dir_subst_penv t_sub p_sub r_x1) (p_sub p)) (dir_subst_penv t_sub p_sub r_m1)" in subst)
          apply (rule_tac lift_diff_use_env)
         apply (simp add: comp_sol_subst_penv)
         apply (rule_tac rhs_unroll_dcl_use_env)
         apply (rule_tac mini_disj_diff_leq_use_env2)
          apply (simp add: lift_sol_subst_penvx)
          apply (rule_tac dist_diff_leq_use_env)
          apply (rule_tac comp_leq_use_env1)
          apply (rule_tac self_comp_leq_use_env2)
         apply (rule_tac r_s="lift_use_env (dir_subst_penv t_sub p_sub r_x1) (p_sub p)" in mini_disj_leq_use_env2)
          apply (rule_tac mini_disj_lift_use_env_rev)
          apply (simp)
         apply (rule_tac self_diff_leq_use_env)(*
          apply (rule_tac r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p)))" in disj_leq_use_env1)
           apply (rule_tac r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p)))" in disj_leq_use_env2)
            apply (rule_tac comm_disj_use_env)
            apply (simp)
           apply (simp add: lift_sol_subst_penvx)
           apply (rule_tac diff_leq_use_env)
           apply (rule_tac self_comp_leq_use_env2)
          apply (rule_tac comp_leq_use_env1)
          apply (rule_tac c_list="cl2" in infer_m_leq_use_env)
          apply (simp)
         apply (rule_tac dist_diff_leq_use_env)
         apply (simp add: lift_sol_subst_penvx)
         apply (rule_tac comp_leq_use_env1)
         apply (rule_tac self_comp_leq_use_env2)*)
      (* - native permission bound constraint e2 *)
        apply (rule_tac t="lift_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_x2) (dir_subst_penv t_sub p_sub r_m2)) (p_sub p)" and
          s="diff_use_env (lift_use_env (dir_subst_penv t_sub p_sub r_x2) (p_sub p)) (dir_subst_penv t_sub p_sub r_m2)" in subst)
         apply (rule_tac lift_diff_use_env)
        apply (simp add: comp_sol_subst_penv)
        apply (rule_tac rhs_unroll_dcl_use_env)
        apply (rule_tac dist_diff_leq_use_env)
        apply (rule_tac mini_disj_diff_leq_use_env2)
         apply (simp add: lift_sol_subst_penvx)
         apply (rule_tac comp_leq_use_env2)
         apply (rule_tac self_comp_leq_use_env2)
        apply (rule_tac mini_disj_lift_use_env_rev)
        apply (rule_tac r_s="dir_subst_penv t_sub p_sub r_s2" in mini_disj_leq_use_env2)
         apply (simp)
        apply (rule_tac infer_x_leq_use_env)
        apply (simp)(*
         apply (rule_tac r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p)))" in disj_leq_use_env2)
          apply (rule_tac r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p)))" in disj_leq_use_env1)
           apply (simp)
          apply (rule_tac comp_leq_use_env1)
          apply (rule_tac c_list="cl1" in infer_m_leq_use_env)
          apply (simp)
         apply (simp add: lift_sol_subst_penvx)
         apply (rule_tac self_comp_leq_use_env2)
        apply (rule_tac comp_leq_use_env2)
        apply (simp add: lift_sol_subst_penvx)
        apply (rule_tac self_comp_leq_use_env2)*)
    (* - affinity requirements *)
       apply (rule_tac max_aff_leq)
        apply (rule_tac dir_aff_leq)
         apply (simp_all)
       apply (rule_tac tau="tau_xa" in dir_aff_leq)
        apply (simp_all)
    (* - disjointness requirement *)
      apply (rule_tac r_s="dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))" in disj_leq_use_env2)
       apply (rule_tac r_s="dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p))" in disj_leq_use_env1)
        apply (simp)
       apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p))" and
          s="lift_use_env (dir_subst_penv t_sub p_sub r_x1) (p_sub p)" in subst)
        apply (rule_tac lift_sol_subst_penvx)
       apply (rule_tac dist_lift_leq_use_env)
       apply (rule_tac self_diff_leq_use_env)
      apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))" and
          s="lift_use_env (dir_subst_penv t_sub p_sub r_x2) (p_sub p)" in subst)
       apply (rule_tac lift_sol_subst_penvx)
      apply (rule_tac dist_lift_leq_use_env)
      apply (rule_tac self_diff_leq_use_env)
(*
      apply (rule_tac r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p)))" in disj_leq_use_env2)
       apply (rule_tac r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p)))" in disj_leq_use_env1)
        apply (simp add: comp_sol_subst_penv)
       apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p))" and
          s="lift_use_env (dir_subst_penv t_sub p_sub r_x1) (p_sub p)" in subst)
        apply (rule_tac lift_sol_subst_penvx)
       apply (rule_tac comp_leq_use_env2)
       apply (rule_tac dist_lift_leq_use_env)
       apply (rule_tac self_diff_leq_use_env)
      apply (rule_tac comp_leq_use_env2)
      apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))" and
          s="lift_use_env (dir_subst_penv t_sub p_sub r_x2) (p_sub p)" in subst)
       apply (rule_tac lift_sol_subst_penvx)
      apply (rule_tac dist_lift_leq_use_env)
      apply (rule_tac self_diff_leq_use_env)*)
    (* - final existential *)
     apply (rule_tac x="dir_subst_penv t_sub p_sub (comp_var_env r_m1 r_m2)" in exI)
     apply (auto)
        apply (rule_tac rhs_diff_leq_use_env)
        apply (rule_tac id_leq_use_env)
       apply (rule_tac dist_diff_leq_use_env)
       apply (rule_tac if_zero_leq_var_env)
       apply (rule_tac dist_comp_leq_var_env)
        apply (rule_tac comp_leq_var_env1)
        apply (rule_tac comp_leq_var_env2)
        apply (rule_tac id_leq_use_env)
       apply (rule_tac comp_leq_var_env2)
       apply (rule_tac comp_leq_var_env2)
       apply (rule_tac id_leq_use_env)
      apply (rule_tac dist_comp_leq_var_env)
       apply (rule_tac comp_leq_var_env1)
       apply (rule_tac comp_leq_var_env1)
       apply (rule_tac c_list="cl1" in infer_m_leq_use_env)
       apply (auto)
      apply (rule_tac comp_leq_var_env2)
      apply (rule_tac comp_leq_var_env1)
      apply (rule_tac c_list="cl2" in infer_m_leq_use_env)
      apply (simp)
     apply (simp add: pair_req_def)
     apply (auto)
      apply (rule_tac leq_empty_use_env)
     apply (case_tac "sol_subst_perm p_sub (SVar p) = NoPerm")
      apply (simp)
     apply (simp add: if_zero_pos_var_env)
     apply (rule_tac dist_diff_leq_use_env)
     apply (simp add: comp_sol_subst_penv)
     apply (rule_tac dist_comp_leq_use_env)
      apply (rule_tac comp_leq_use_env1)
      apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x1 (SVar p))" and
        s="lift_use_env (dir_subst_penv t_sub p_sub r_x1) (p_sub p)" in subst)
       apply (rule_tac lift_sol_subst_penvx)
      apply (rule_tac dist_lift_leq_use_env)
      apply (rule_tac self_diff_leq_use_env)
     apply (rule_tac comp_leq_use_env2)
     apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))" and
        s="lift_use_env (dir_subst_penv t_sub p_sub r_x2) (p_sub p)" in subst)
      apply (rule_tac lift_sol_subst_penvx)
     apply (rule_tac dist_lift_leq_use_env)
     apply (rule_tac self_diff_leq_use_env)
    (* if case. prelim: satisfiability sub-constraints *)
    apply (cut_tac p_sub="p_sub" and ?cl2.0="cl1 @ cl2 @ cl3" in sol_sat_append2)
     apply (simp)
    apply (cut_tac p_sub="p_sub" and ?cl2.0="cl2 @ cl3" in sol_sat_append2)
     apply (simp)
    (* - prelim: disjointness constraints *)
    apply (cut_tac p_sub="p_sub" and r_x="r_m1" and r_s="comp_var_env r_s2 r_s3" in sol_sat_mini_disj_use_env)
       apply (rule_tac sol_sat_append1)
       apply (simp)
      apply (rule_tac r_s="comp_var_env r_s1 (comp_var_env r_s2 r_s3)" in finite_sub_dom)
       apply (simp)
      apply (rule_tac comp_sub_dom1)
      apply (rule_tac infer_m_sub_dom)
      apply (auto)
     apply (rule_tac r_s="comp_var_env r_s1 (comp_var_env r_s2 r_s3)" in finite_sub_dom)
      apply (simp)
     apply (rule_tac comp_sub_dom2)
     apply (rule_tac id_sub_dom)
    (* - induction on e1 *)
    apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub r_x1) (dir_subst_penv t_sub p_sub r_m1)" in exI)
    apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub (comp_var_env r_s1 (comp_var_env r_s2 r_s3))) (dir_subst_penv t_sub p_sub r_m1)" in exI)
    apply (auto)
     apply (rule_tac t="dir_subst_penv t_sub p_sub (comp_var_env r_s1 (comp_var_env r_s2 r_s3))"
      and s="comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub (comp_var_env r_s2 r_s3))" in subst)
      apply (simp add: comp_sol_subst_penv)
    apply (cut_tac env="env" and ds="ds" and e="e1" and tau="t1" and r_s="r_s1" and r_x="r_x1" and r_m="r_m1" and
        c_list="cl1" and ds'="ds2" and t_sub="t_sub" and p_sub="p_sub" and tau_n="tau_n" in ivl_if_ih)
        apply (auto)
      apply (rule_tac sol_sat_append1)
      apply (simp)
     apply (rule_tac well_typed_comp_perms_prec)
     apply (case_tac t1)
            apply (auto)
      apply (simp add: full_subst_type_def)
     apply (simp add: full_subst_type_def)
    (* - induction on e2 *)
    apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub r_x2) (dir_subst_penv t_sub p_sub (comp_var_env r_m1 (comp_var_env r_m2 r_m3)))" in exI)
    apply (auto)
     apply (simp add: comp_sol_subst_penv)
     apply (cut_tac env="env" and ds="ds2" and e="e2" and tau="t2" and r_s="r_s2" and r_x="r_x2" and r_m="r_m2" and
        c_list="cl2" and ds'="ds3" and t_sub="t_sub" and p_sub="p_sub" and tau_n="tau_n" in ivl_if_ih)
        apply (auto)
      apply (rule_tac sol_sat_append1)
      apply (simp)
     apply (rule_tac ?r_s2.0="diff_use_env (diff_use_env (comp_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_s1)
        (dir_subst_penv t_sub p_sub r_m1)) (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub r_s3)))
        (dir_subst_penv t_sub p_sub r_m2)) (dir_subst_penv t_sub p_sub r_m3)" and rx="diff_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_x2)
        (dir_subst_penv t_sub p_sub r_m2)) (dir_subst_penv t_sub p_sub r_m3)" in well_typed_simul_end_perm)
        apply (rule_tac ?r_s1.0="comp_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub r_m1))
          (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub r_s3))" in well_typed_incr_start_perm)
         apply (rule_tac well_typed_diff_end_perm)
          apply (rule_tac well_typed_comp_perms_prec2)
          apply (rule_tac well_typed_comp_perms_prec)
          apply (simp_all)
         apply (rule_tac comp_leq_use_env2)
         apply (rule_tac comp_leq_use_env2)
         apply (rule_tac infer_m_leq_use_env)
         apply (auto)
        apply (rule_tac dist_comp_leq_use_env)
         apply (rule_tac dist_diff_leq_use_env)
         apply (rule_tac self_comp_leq_use_env1)
        apply (rule_tac rhs_dist_dcl_use_env)
        apply (rule_tac comp_leq_use_env2)
        apply (rule_tac mini_disj_diff_leq_use_env2)
         apply (rule_tac id_leq_use_env)
        apply (simp)
       apply (rule_tac lhs_dist_dcl_use_env)
       apply (rule_tac rhs_fold_dcl_use_env)
       apply (rule_tac dist_comp_leq_use_env)
        apply (rule_tac lhs_unroll_dcl_use_env)
        apply (rule_tac dist_diff_leq_use_env)
        apply (rule_tac self_comp_leq_use_env1)
       apply (rule_tac dist_diff_leq_use_env_gen)
        apply (rule_tac self_comp_leq_use_env2)
       apply (rule_tac self_comp_leq_use_env2)
      apply (rule_tac dist_diff_leq_use_env)
      apply (rule_tac comp_leq_use_env2)
      apply (rule_tac comp_leq_use_env1)
      apply (rule_tac c_list="cl2" in infer_x_leq_use_env)
      apply (simp)
     apply (rule_tac lhs_fold_dcl_use_env)
     apply (rule_tac rhs_unroll_dcl_use_env)
     apply (rule_tac dist_diff_leq_use_env)
     apply (rule_tac mini_disj_diff_leq_use_env2)
      apply (rule_tac id_leq_use_env)
     apply (rule_tac r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub r_s3)" in mini_disj_leq_use_env2)
      apply (simp)
     apply (rule_tac comp_leq_use_env1)
     apply (rule_tac c_list="cl2" in infer_x_leq_use_env)
     apply (simp)
      (* - induction on e3 *)
    apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub r_x3) (dir_subst_penv t_sub p_sub (comp_var_env r_m1 (comp_var_env r_m2 r_m3)))" in exI)
    apply (auto)
     apply (simp add: comp_sol_subst_penv)
     apply (cut_tac env="env" and ds="ds3" and e="e3" and tau="t3" and r_s="r_s3" and r_x="r_x3" and r_m="r_m3" and
        c_list="cl3" and ds'="ds'" and t_sub="t_sub" and p_sub="p_sub" and tau_n="tau_n" in ivl_if_ih)
        apply (auto)
      apply (rule_tac sol_sat_append2)
      apply (simp)
     apply (rule_tac ?r_s2.0="diff_use_env (diff_use_env (comp_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_s1)
        (dir_subst_penv t_sub p_sub r_m1)) (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub r_s3)))
        (dir_subst_penv t_sub p_sub r_m3)) (dir_subst_penv t_sub p_sub r_m2)" and rx="diff_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_x3)
        (dir_subst_penv t_sub p_sub r_m3)) (dir_subst_penv t_sub p_sub r_m2)" in well_typed_simul_end_perm)
        apply (rule_tac ?r_s1.0="comp_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub r_m1))
          (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub r_s3))" in well_typed_incr_start_perm)
         apply (rule_tac well_typed_diff_end_perm)
          apply (rule_tac well_typed_comp_perms_prec2)
          apply (rule_tac well_typed_comp_perms_prec2)
          apply (simp add: dir_subst_type_eq)
         apply (rule_tac comp_leq_use_env2)
         apply (rule_tac comp_leq_use_env1)
         apply (rule_tac infer_m_leq_use_env)
         apply (auto)
        apply (rule_tac dist_comp_leq_use_env)
         apply (rule_tac dist_diff_leq_use_env)
         apply (rule_tac self_comp_leq_use_env1)
        apply (rule_tac mini_disj_diff_leq_use_env2)
         apply (rule_tac self_comp_leq_use_env2)
        apply (simp)
       apply (rule_tac lhs_dist_dcl_use_env)
       apply (rule_tac rhs_fold_dcl_use_env)
       apply (rule_tac dist_comp_leq_use_env)
        apply (rule_tac lhs_unroll_dcl_use_env)
        apply (rule_tac dist_diff_leq_use_env_gen)
         apply (rule_tac self_comp_leq_use_env1)
        apply (simp add: comm_comp_use_env)
        apply (rule_tac id_leq_use_env)
       apply (rule_tac dist_diff_leq_use_env_gen)
        apply (rule_tac self_comp_leq_use_env2)
       apply (simp add: comm_comp_use_env)
       apply (rule_tac self_comp_leq_use_env2)
      apply (rule_tac dist_diff_leq_use_env)
      apply (rule_tac comp_leq_use_env2)
      apply (rule_tac comp_leq_use_env2)
      apply (rule_tac infer_x_leq_use_env)
      apply (auto)
     apply (rule_tac lhs_fold_dcl_use_env)
     apply (simp add: comm_comp_use_env)
     apply (rule_tac rhs_unroll_dcl_use_env)
     apply (rule_tac dist_diff_leq_use_env_gen)
      apply (rule_tac mini_disj_diff_leq_use_env2)
       apply (rule_tac id_leq_use_env)
      apply (rule_tac r_s="comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub r_s3)" in mini_disj_leq_use_env2)
       apply (simp)
      apply (rule_tac comp_leq_use_env2)
      apply (rule_tac infer_x_leq_use_env)
      apply (auto)
     apply (rule_tac id_leq_use_env)
    apply (simp add: dist_diff_comp_use_env)
    apply (simp add: comp_sol_subst_penv)
    (* lam case *)
   apply (simp add: full_subst_type_def)
   apply (rule_tac x="dir_subst_penv t_sub p_sub (rem_var_env r_s' (Var x1a))" in exI)
   apply (auto)
    (* - induction on e *)
      apply (cut_tac env="add_env env (Var x1a) a" and ds="insert a ds" and e="e" and tau="t2" and r_s="r_s'" and r_x="r_x'" and r_m="r_m'" and
        c_list="cl" and ds'="ds2" and t_sub="t_sub" and p_sub="p_sub" and tau_n="tau_n" in ivl_lam_ih)
         apply (auto)
        apply (simp add: full_subst_type_def)
       apply (rule_tac sol_sat_append2)
       apply (simp)
      apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub r_x') (dir_subst_penv t_sub p_sub r_m')" in exI)
      apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub r_s') (dir_subst_penv t_sub p_sub r_m')" in exI)
      apply (simp add: rem_sol_subst_penv)
      apply (rule_tac ?r_s1.0="add_use_env (rem_use_env (dir_subst_penv t_sub p_sub r_s') (Var x1a)) (Var x1a)
        (dir_subst_permx t_sub p_sub (r_s' (Var x1a)))" in well_typed_incr_start_perm)
       apply (case_tac "dir_subst_permx t_sub p_sub (r_s' (Var x1a)) \<noteq> (dir_subst_penv t_sub p_sub r_s') (Var x1a)")
        apply (simp add: dir_subst_penv_def)
       apply (simp add: add_rem_use_env)
       apply (cut_tac t_sub="t_sub" and tau_n="tau_n" and x="x1a" and env="env" and a="a" and p_sub="p_sub" in add_sol_subst_tenv)
       apply (simp add: full_subst_type_def)
      apply (rule_tac dist_add_leq_use_env_gen)
       apply (rule_tac id_leq_use_env)
      apply (simp)
     apply (rule_tac sol_sat_aff_use_envx)
      apply (rule_tac sol_sat_append1)
      apply (simp_all)
    apply (rule_tac id_leq_use_env)
   apply (rule_tac x="empty_use_env" in exI)
   apply (auto)
      apply (simp add: subst_empty_var_env)
      apply (rule_tac id_leq_use_env)
     apply (rule_tac id_leq_use_env)
    apply (rule_tac leq_empty_use_env)
   apply (simp add: subst_empty_var_env)
   apply (rule_tac id_leq_use_env)
    (* app case. prelim: satisfiability constraints *)
  apply (cut_tac p_sub="p_sub" and ?cl2.0="semi_disj_crn r_m2 r_x1 d @ semi_disj_crn r_m1 r_s2 d @ cl1 @ cl2" in sol_sat_append2)
   apply (simp)
  apply (cut_tac p_sub="p_sub" and ?cl2.0="semi_disj_crn r_m1 r_s2 d @ cl1 @ cl2" in sol_sat_append2)
   apply (simp)
  apply (cut_tac p_sub="p_sub" and ?cl2.0="cl1 @ cl2" in sol_sat_append2)
   apply (simp)
    (* - prelim: disjointness constraints *)
  apply (cut_tac p_sub="p_sub" in sol_sat_disj_use_env)
     apply (rule_tac sol_sat_append1)
     apply (simp)
    apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 r_x1) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
     apply (simp)
    apply (rule_tac comp_sub_dom1)
    apply (rule_tac comp_sub_dom2)
    apply (rule_tac id_sub_dom)
   apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 r_x1) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
    apply (simp)
   apply (rule_tac comp_sub_dom2)
   apply (rule_tac comp_sub_dom2)
   apply (rule_tac id_sub_dom)
    (* - prelim: semi-disjointness constraint 1 *)
  apply (cut_tac r_x="r_m2" and r_s="r_x1" and p_sub="p_sub" in sol_sat_mini_disj_use_env)
     apply (rule_tac sol_sat_append1)
     apply (simp)
      apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 r_x1) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
       apply (simp)
      apply (rule_tac comp_sub_dom2)
      apply (rule_tac comp_sub_dom1)
      apply (rule_tac infer_m_sub_dom)
      apply (simp)
     apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 r_x1) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
      apply (simp)
     apply (rule_tac comp_sub_dom1)
     apply (rule_tac comp_sub_dom2)
     apply (rule_tac id_sub_dom)
    (* - prelim: semi-disjointness constraint 2 *)
  apply (cut_tac r_x="r_m1" and r_s="r_s2" and p_sub="p_sub" in sol_sat_mini_disj_use_env)
     apply (rule_tac sol_sat_append1)
     apply (simp)
      apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 r_x1) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
       apply (simp)
      apply (rule_tac comp_sub_dom1)
      apply (rule_tac comp_sub_dom1)
      apply (rule_tac infer_m_sub_dom)
      apply (simp)
     apply (rule_tac r_s="comp_var_env (comp_var_env r_s1 r_x1) (comp_var_env r_s2 (lift_var_env r_x2 (SVar p)))" in finite_sub_dom)
      apply (simp)
     apply (rule_tac comp_sub_dom2)
     apply (rule_tac comp_sub_dom1)
     apply (rule_tac id_sub_dom)
    (* - prelim: inequalities *)(*
  apply (cut_tac c_list="cl1" and r_m="r_m1" and r_s="r_s1" and t_sub="t_sub" and p_sub="p_sub" in infer_m_leq_use_env)
   apply (simp)
  apply (cut_tac r_x="r_m2" and r_s="r_s2" and r="SVar p" and t_sub="t_sub" and p_sub="p_sub" in lift_leq_var_env)
   apply (rule_tac c_list="cl2" in infer_m_leq_use_env)
   apply (simp)*)
  apply (cut_tac c_list="cl1" and r_x="r_x1" and r_s="r_s1" and t_sub="t_sub" and p_sub="p_sub" in infer_x_leq_use_env)
   apply (simp)
  apply (cut_tac c_list="cl2" and r_x="r_x2" and r_s="r_s2" and t_sub="t_sub" and p_sub="p_sub" in infer_x_leq_use_env)
   apply (simp)
  apply (cut_tac r_x="r_x2" and r_s="r_s2" and r="SVar p" in lift_leq_var_env)
    apply (simp)
    (* - existentials *)
  apply (rule_tac x="full_subst_type t_sub p_sub tau_n t1" in exI)
  apply (rule_tac x="sol_subst_perm p_sub (SVar p)" in exI)
  apply (rule_tac x="sol_subst_aff p_sub (AffVar q)" in exI)
  apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub (comp_var_env (comp_var_env r_s1 r_x1)
      (comp_var_env r_s2 (lift_var_env r_x2 (SVar p))))) (dir_subst_penv t_sub p_sub r_m1)" in exI)
  apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub r_x1) (dir_subst_penv t_sub p_sub r_m1)" in exI)
  apply (auto)
    (* - induction for e1. *)
  apply (simp add: comp_sol_subst_penv)
   apply (cut_tac env="env" and ds="ds" and e="e1" and tau="tau_f" and r_s="r_s1" and r_x="r_x1" and r_m="r_m1" and
        c_list="cl1" and ds'="ds2" and t_sub="t_sub" and p_sub="p_sub" and tau_n="tau_n" in ivl_app_ih)
      apply (auto)
    apply (rule_tac sol_sat_append1)
    apply (simp)
   apply (rule_tac well_typed_comp_perms_prec)
   apply (rule_tac well_typed_comp_perms_prec)
   apply (simp add: dir_subst_type_eq)
    (* - induction for e2. *)
  apply (rule_tac x="diff_use_env (dir_subst_penv t_sub p_sub r_x2) (dir_subst_penv t_sub p_sub r_m2)" in exI)
  apply (rule_tac x="diff_use_env (diff_use_env (dir_subst_penv t_sub p_sub (comp_var_env (comp_var_env r_s1 r_x1)
      (comp_var_env r_s2 (lift_var_env r_x2 (SVar p))))) (dir_subst_penv t_sub p_sub r_m1)) (dir_subst_penv t_sub p_sub r_m2)" in exI)
  apply (auto)
   apply (simp add: comp_sol_subst_penv)
   apply (cut_tac env="env" and ds="ds2" and e="e2" and tau="t1" and r_s="r_s2" and r_x="r_x2" and r_m="r_m2" and
        c_list="cl2" and ds'="ds3" and t_sub="t_sub" and p_sub="p_sub" and tau_n="tau_n" in ivl_app_ih)
      apply (auto)
    apply (rule_tac sol_sat_append2)
    apply (simp)
   apply (rule_tac r_c="diff_use_env (comp_use_env (diff_use_env (comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub r_x1))
      (dir_subst_penv t_sub p_sub r_m1)) (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p)))))
                (dir_subst_penv t_sub p_sub r_m2)" in well_typed_decr_end_perm)
     apply (rule_tac ?r_s1.0="comp_use_env (diff_use_env (comp_use_env (dir_subst_penv t_sub p_sub r_s1) (dir_subst_penv t_sub p_sub r_x1))
      (dir_subst_penv t_sub p_sub r_m1)) (comp_use_env (dir_subst_penv t_sub p_sub r_s2) (dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))))" in well_typed_incr_start_perm)
      apply (rule_tac well_typed_comp_perms_prec2)
      apply (rule_tac well_typed_comp_perms_prec)
      apply (simp)
     apply (rule_tac rhs_dist_dcl_use_env)
     apply (rule_tac dist_comp_leq_use_env)
      apply (rule_tac self_comp_leq_use_env1)
     apply (rule_tac comp_leq_use_env2)
     apply (rule_tac mini_disj_diff_leq_use_env)
      apply (rule_tac id_leq_use_env)
     apply (rule_tac mini_disj_comp_use_env_alt)
      apply (simp)
     apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))" and
        s="lift_use_env (dir_subst_penv t_sub p_sub r_x2) (sol_subst_perm p_sub (SVar p))" in subst)
      apply (rule_tac lift_sol_subst_penv)
     apply (rule_tac mini_disj_lift_use_env_rev)
     apply (rule_tac r_s="dir_subst_penv t_sub p_sub r_s2" in mini_disj_leq_use_env2)
      apply (simp_all)
    apply (rule_tac dist_diff_leq_use_env)
    apply (rule_tac lhs_dist_dcl_use_env)
    apply (rule_tac dist_comp_leq_use_env)
     apply (rule_tac self_comp_leq_use_env1)
    apply (rule_tac comp_leq_use_env2)
    apply (rule_tac self_diff_leq_use_env)
   apply (rule_tac dist_diff_leq_use_env)
   apply (rule_tac mini_disj_diff_leq_use_env2)
    apply (rule_tac comp_leq_use_env2)
    apply (rule_tac comp_leq_use_env2)
    apply (rule_tac lift_leq_var_env)
    apply (rule_tac id_leq_use_env)
   apply (rule_tac r_s="dir_subst_penv t_sub p_sub r_s2" in mini_disj_leq_use_env2)
    apply (simp_all)
    (* - final existentials. *)
  apply (rule_tac x="dir_subst_penv t_sub p_sub (comp_var_env (comp_var_env r_m1 r_x1) (comp_var_env r_m2 (lift_var_env r_x2 (SVar p))))" in exI)
  apply (simp add: comp_sol_subst_penv)
  apply (auto)
    (* - end permission bound *)
       apply (rule_tac rhs_fold_dcl_use_env)
       apply (rule_tac rhs_fold_dcl_use_env)
       apply (rule_tac dist_diff_leq_use_env_gen)
        apply (rule_tac id_leq_use_env)
       apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))" and
        s="lift_use_env (dir_subst_penv t_sub p_sub r_x2) (sol_subst_perm p_sub (SVar p))" in subst)
        apply (rule_tac lift_sol_subst_penv)
       apply (rule_tac dist_comp_leq_use_env)
        apply (rule_tac comp_leq_use_env1)
        apply (rule_tac self_comp_leq_use_env1)
       apply (rule_tac dist_comp_leq_use_env)
        apply (rule_tac comp_leq_use_env2)
        apply (rule_tac self_comp_leq_use_env1)
       apply (rule_tac dist_comp_leq_use_env)
        apply (rule_tac dist_comp_leq_use_env)
         apply (rule_tac comp_leq_use_env1)
         apply (rule_tac comp_leq_use_env2)
         apply (rule_tac self_diff_leq_use_env)
        apply (rule_tac comp_leq_use_env2)
        apply (rule_tac comp_leq_use_env2)
        apply (auto)
        apply (rule_tac dist_lift_leq_use_env)
        apply (rule_tac self_diff_leq_use_env)
       apply (rule_tac id_leq_use_env)
    (* - subtractability bound *)
      apply (rule_tac dist_comp_leq_use_env)
       apply (rule_tac mini_disj_diff_leq_use_env2)
        apply (rule_tac dist_diff_leq_use_env)
        apply (rule_tac comp_leq_use_env1)
        apply (rule_tac self_comp_leq_use_env2)
       apply (rule_tac r_s="dir_subst_penv t_sub p_sub r_x1" in mini_disj_leq_use_env2)
        apply (simp)
       apply (rule_tac self_diff_leq_use_env)
      apply (rule_tac t="lift_use_env (diff_use_env (dir_subst_penv t_sub p_sub r_x2) (dir_subst_penv t_sub p_sub r_m2)) (p_sub p)"
        and s="diff_use_env (lift_use_env (dir_subst_penv t_sub p_sub r_x2) (p_sub p)) (dir_subst_penv t_sub p_sub r_m2)" in subst)
       apply (rule_tac lift_diff_use_env)
      apply (rule_tac dist_diff_leq_use_env)
       apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))" and
        s="lift_use_env (dir_subst_penv t_sub p_sub r_x2) (sol_subst_perm p_sub (SVar p))" in subst)
       apply (rule_tac lift_sol_subst_penv)
      apply (auto)
      apply (rule_tac mini_disj_diff_leq_use_env2)
       apply (rule_tac comp_leq_use_env2)
       apply (rule_tac self_comp_leq_use_env2)
      apply (rule_tac mini_disj_lift_use_env_rev)
      apply (rule_tac r_s="dir_subst_penv t_sub p_sub r_s2" in mini_disj_leq_use_env2)
       apply (simp)
      apply (rule_tac infer_x_leq_use_env)
      apply (simp)
    (* - disjointness *)
     apply (rule_tac r_s="dir_subst_penv t_sub p_sub r_x1" in disj_leq_use_env1)
      apply (rule_tac r_s="dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))" in disj_leq_use_env2)
       apply (simp)
      apply (rule_tac t="dir_subst_penv t_sub p_sub (lift_var_env r_x2 (SVar p))" and
        s="lift_use_env (dir_subst_penv t_sub p_sub r_x2) (sol_subst_perm p_sub (SVar p))" in subst)
       apply (rule_tac lift_sol_subst_penv)
      apply (auto)
      apply (rule_tac dist_lift_leq_use_env)
      apply (rule_tac self_diff_leq_use_env)
     apply (rule_tac self_diff_leq_use_env)
    (* - relative bound *)
    apply (rule_tac dist_diff_leq_use_env)
    apply (rule_tac if_zero_leq_var_env)
    apply (simp add: comp_sol_subst_penv)
    apply (rule_tac dist_comp_leq_use_env)
     apply (rule_tac comp_leq_use_env1)
     apply (rule_tac self_comp_leq_use_env2)
    apply (rule_tac comp_leq_use_env2)
    apply (rule_tac self_comp_leq_use_env2)
    (* - subtractant bound *)
   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 comp_leq_use_env1)
     apply (rule_tac c_list="cl1" in infer_m_leq_use_env)
     apply (auto)
    apply (rule_tac self_comp_leq_use_env2)
   apply (rule_tac dist_comp_leq_use_env)
    apply (rule_tac comp_leq_use_env2)
    apply (rule_tac comp_leq_use_env1)
    apply (rule_tac c_list="cl2" in infer_m_leq_use_env)
    apply (auto)
   apply (rule_tac comp_leq_use_env2)
   apply (rule_tac self_comp_leq_use_env2)
    (* - requirements bound *)
  apply (simp add: app_req_def)
  apply (auto)
   apply (rule_tac leq_empty_use_env)
  apply (rule_tac dist_diff_leq_use_env_gen)
   apply (case_tac "dir_subst_permx t_sub p_sub (XType a) = NoPerm")
    apply (case_tac "req_type (full_subst_type t_sub p_sub tau_n (VarScheme a))")
      apply (auto)
     apply (simp add: full_subst_type_def)
    apply (simp add: full_subst_type_def)
   apply (simp add: if_zero_pos_var_env)
   apply (simp add: comp_sol_subst_penv)
   apply (rule_tac dist_comp_leq_use_env)
    apply (rule_tac comp_leq_use_env1)
    apply (rule_tac self_diff_leq_use_env)
   apply (rule_tac comp_leq_use_env2)
   apply (rule_tac diff_leq_use_env)
   apply (rule_tac lift_leq_var_env)
   apply (rule_tac id_leq_use_env)
  apply (rule_tac self_comp_leq_use_env2)
  done

end